51 lines
1.5 KiB
Haskell
51 lines
1.5 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
module Config(forkBackend,withConfigs,forkWithConfigs,ConfigM,configM,getConfigM,setConfigM) where
|
|
|
|
import Data.Semigroup
|
|
|
|
|
|
import Toml (TomlCodec, (.=))
|
|
import qualified Toml
|
|
import System.IO
|
|
import qualified Data.Text as T
|
|
import UnliftIO.MVar
|
|
import UnliftIO.Concurrent
|
|
import WaiApp
|
|
import Data.Maybe(fromJust)
|
|
import Data.Coerce
|
|
import Environment
|
|
import Colog.Message
|
|
|
|
|
|
-- This Type is here to replace Toml.Codec.Monoid.First as the First Monoid
|
|
-- will be replaced with Maybe First with the First Semigroup
|
|
type ConfigM a = Maybe (First a)
|
|
|
|
-- WARNING this function IS NOT total be sure the option is given!
|
|
getConfigM :: ConfigM a -> a
|
|
getConfigM = coerce . fromJust
|
|
|
|
setConfigM :: a -> ConfigM a
|
|
setConfigM = Just . coerce
|
|
|
|
configM :: (Toml.Key -> TomlCodec a) -> Toml.Key -> TomlCodec (ConfigM a)
|
|
configM codec = Toml.diwrap . Toml.dioptional . codec
|
|
|
|
forkWithConfigs :: (a -> EnvM ()) -> TomlCodec [a] -> FilePath -> EnvM [MVar ()]
|
|
forkWithConfigs f = withConfigs (forkBackend . f)
|
|
|
|
withConfigs :: (a -> EnvM b) -> TomlCodec [a] -> FilePath -> EnvM [b]
|
|
withConfigs f codec configFile = do
|
|
parseResult <- Toml.decodeFileEither codec configFile
|
|
either
|
|
(\x -> (logError . T.pack . show) x >> return [])
|
|
(mapM f)
|
|
parseResult
|
|
|
|
-- Note for later:
|
|
-- TODO this may need logging if f dies with an exception
|
|
forkBackend :: EnvM () -> EnvM (MVar ())
|
|
forkBackend f = do
|
|
mVar <- newEmptyMVar
|
|
forkFinally f (const $ putMVar mVar ())
|
|
return mVar
|