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

View File

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