ENH don't use subs
This commit is contained in:
parent
c94422345e
commit
1450124e90
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue