78 lines
2.5 KiB
Haskell
78 lines
2.5 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Internal.Config
|
|
( readConfig
|
|
, readYaml
|
|
) where
|
|
|
|
import Control.Exception
|
|
import Control.Lens
|
|
|
|
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 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
|
|
|
|
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
|
|
r <- decodeFileEither p
|
|
case r of
|
|
Right a -> return a
|
|
Left e -> throw e
|