ndwarshuis
/
pwncash
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

ENH don't use subs

This commit is contained in:
Nathan Dwarshuis 2022-12-15 23:03:07 -05:00
parent c94422345e
commit 1450124e90
1 changed files with 53 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

107
lib/Internal/Config.hs
View File

@ -1,73 +1,72 @@
{-# LANGUAGE OverloadedStrings #-}
module Internal.Config module Internal.Config
( readConfig ( readConfig
, readYaml , readYaml
) where ) where
import Control.Exception import Control.Exception
import Control.Lens -- import Control.Lens
import Data.Maybe -- import Data.Maybe
import qualified Data.Text as T -- import qualified Data.Text as T
import Data.Typeable -- import Data.Typeable
import Data.Void -- import Data.Void
import Data.Yaml import Data.Yaml
import Dhall hiding (record) import Dhall hiding (record)
import qualified Dhall.Core as DC -- import qualified Dhall.Core as DC
import qualified Dhall.Map as DM -- import qualified Dhall.Map as DM
import Dhall.Src -- import Dhall.Src
import Internal.Types import Internal.Types
readConfig :: FilePath -> IO Config readConfig :: FilePath -> IO Config
readConfig confpath = do readConfig confpath = do
let subs = DM.fromList typeSubs -- let subs = DM.fromList typeSubs
let settings = over substitutions (DM.union subs) defaultEvaluateSettings -- let settings = over substitutions (DM.union subs) defaultEvaluateSettings
unfix <$> inputFileWithSettings settings auto confpath -- unfix <$> inputFileWithSettings settings auto confpath
unfix <$> inputFile auto confpath
typeSubs :: [(T.Text, DC.Expr Src Void)] -- typeSubs :: [(T.Text, DC.Expr Src Void)]
typeSubs = firstOrder ++ higherOrder -- typeSubs = firstOrder ++ higherOrder
where -- where
toVar a = fmap (\n -> (T.pack $ show n, maximum $ expected a)) -- toVar a = fmap (\n -> (T.pack $ show n, maximum $ expected a))
$ listToMaybe $ snd $ splitTyConApp $ typeOf a -- $ listToMaybe $ snd $ splitTyConApp $ typeOf a
higherOrder = -- higherOrder =
[ ("ExpSplit", maximum $ expected (auto :: Decoder ExpSplit)) -- [ ("ExpSplit", maximum $ expected (auto :: Decoder ExpSplit))
, ("ExpTx", maximum $ expected (auto :: Decoder ExpTx)) -- , ("ExpTx", maximum $ expected (auto :: Decoder ExpTx))
, ("SplitCur", maximum $ expected (auto :: Decoder SplitCur)) -- , ("SplitCur", maximum $ expected (auto :: Decoder SplitCur))
, ("SplitAcnt", maximum $ expected (auto :: Decoder SplitAcnt)) -- , ("SplitAcnt", maximum $ expected (auto :: Decoder SplitAcnt))
, ("CurID", maximum $ expected (auto :: Decoder CurID)) -- , ("CurID", maximum $ expected (auto :: Decoder CurID))
, ("AcntID", maximum $ expected (auto :: Decoder AcntID)) -- , ("AcntID", maximum $ expected (auto :: Decoder AcntID))
] -- ]
firstOrder = catMaybes -- firstOrder = catMaybes
[ toVar (auto :: Decoder TimeUnit) -- [ toVar (auto :: Decoder TimeUnit)
, toVar (auto :: Decoder WeekdayPat) -- , toVar (auto :: Decoder WeekdayPat)
, toVar (auto :: Decoder MDYPat) -- , toVar (auto :: Decoder MDYPat)
, toVar (auto :: Decoder Gregorian) -- , toVar (auto :: Decoder Gregorian)
, toVar (auto :: Decoder GregorianM) -- , toVar (auto :: Decoder GregorianM)
, toVar (auto :: Decoder ModPat) -- , toVar (auto :: Decoder ModPat)
, toVar (auto :: Decoder CronPat) -- , toVar (auto :: Decoder CronPat)
, toVar (auto :: Decoder DatePat) -- , toVar (auto :: Decoder DatePat)
, toVar (auto :: Decoder Income) -- , toVar (auto :: Decoder Income)
, toVar (auto :: Decoder Tax) -- , toVar (auto :: Decoder Tax)
, toVar (auto :: Decoder Bucket) -- , toVar (auto :: Decoder Bucket)
, toVar (auto :: Decoder TimeAmount) -- , toVar (auto :: Decoder TimeAmount)
, toVar (auto :: Decoder Expense) -- , toVar (auto :: Decoder Expense)
, toVar (auto :: Decoder Decimal) -- , toVar (auto :: Decoder Decimal)
, toVar (auto :: Decoder Statement) -- , toVar (auto :: Decoder Statement)
, toVar (auto :: Decoder Manual) -- , toVar (auto :: Decoder Manual)
, toVar (auto :: Decoder TxOpts) -- , toVar (auto :: Decoder TxOpts)
, toVar (auto :: Decoder ToTx) -- , toVar (auto :: Decoder ToTx)
, toVar (auto :: Decoder Match) -- , toVar (auto :: Decoder Match)
, toVar (auto :: Decoder MatchYMD) -- , toVar (auto :: Decoder MatchYMD)
, toVar (auto :: Decoder MatchVal) -- , toVar (auto :: Decoder MatchVal)
, toVar (auto :: Decoder MatchDate) -- , toVar (auto :: Decoder MatchDate)
, toVar (auto :: Decoder SplitNum) -- , toVar (auto :: Decoder SplitNum)
, toVar (auto :: Decoder MatchDesc) -- , toVar (auto :: Decoder MatchDesc)
, toVar (auto :: Decoder MatchOther) -- , toVar (auto :: Decoder MatchOther)
, toVar (auto :: Decoder SqlConfig) -- , toVar (auto :: Decoder SqlConfig)
] -- ]
readYaml :: FromJSON a => FilePath -> IO a readYaml :: FromJSON a => FilePath -> IO a
readYaml p = do readYaml p = do