{-# 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