pwncash/lib/Internal/Config.hs

77 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)
]
readYaml :: FromJSON a => FilePath -> IO a
readYaml p = do
r <- decodeFileEither p
case r of
Right a -> return a
Left e -> throw e