{-# LANGUAGE GADTs #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
module Salak.Load.Toml where
import Control.Monad (foldM, (>=>))
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.State
import qualified Data.HashMap.Strict as HM
import qualified Data.List.NonEmpty as N
import qualified Data.Text.IO as IO
import Data.Time
import Salak
import Salak.Load
import Toml hiding (TOML)
import qualified Toml as T
data TOML = TOML
instance HasLoad TOML where
loaders _ = (, loadToml) <$> ["toml", "tml"]
toSs :: Key -> [Selector]
toSs (Key ps) = toS <$> N.toList ps
toS :: Piece -> Selector
toS = SStr . unPiece
loadTOML :: Reload -> T.TOML -> SourcePack -> SourcePack
loadTOML name v sp = loadFile name sp $ go v
where
go T.TOML{..} i s = HM.foldlWithKey' (g1 i) (return s) tomlPairs
>>= h2 i tomlTables
g1 i ms k v' = ms >>= updateSources (toSs k) (f1 i v')
g2 i ms _ v' = ms >>= f2 i v'
f1 :: Monad m => Priority -> AnyValue -> Source -> m Source
f1 i (AnyValue (Array b)) = \s -> foldM (\s' (ix,x) -> updateSource (SNum ix) (f1 i $ AnyValue x) s') s $ zip [0..] b
f1 i (AnyValue (Bool b)) = return . insertSource (VBool i b)
f1 i (AnyValue (Integer b)) = return . insertSource (VNum i $ fromIntegral b)
f1 i (AnyValue (Double b)) = return . insertSource (VNum i $ realToFrac b)
f1 i (AnyValue (Text b)) = return . insertSource (VStr i b)
f1 i (AnyValue (Local b)) = return . insertSource (VLTime i b)
f1 i (AnyValue (Day b)) = return . insertSource (VDay i b)
f1 i (AnyValue (Hours b)) = return . insertSource (VHour i b)
f1 i (AnyValue (Zoned (ZonedTime a b))) = return . insertSource (VZTime i b a)
f2 :: Monad m => Priority -> PrefixTree T.TOML -> Source -> m Source
f2 i (Leaf k toml) = updateSources (toSs k) (go toml i)
f2 i (Branch k v' tomap) = updateSources (toSs k) (h1 i v' >=> h2 i tomap)
h1 :: Monad m => Priority -> Maybe T.TOML -> Source -> m Source
h1 i (Just t) = go t i
h1 _ _ = return
h2 :: Monad m => Priority -> PrefixMap T.TOML -> Source -> m Source
h2 i m s = HM.foldlWithKey' (g2 i) (return s) m
loadToml :: MonadIO m => FilePath -> SourcePackT m ()
loadToml file = do
re <- liftIO $ parse <$> IO.readFile file
modify $ \sp ->case re of
Left e -> addErr' (show e) sp
Right a -> loadTOML (defReload file $ loadToml file) a sp