49 lines
1.4 KiB
Haskell
49 lines
1.4 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 Control.Concurrent.MVar
|
|
import Control.Concurrent
|
|
import WaiApp
|
|
import Data.Maybe(fromJust)
|
|
import Data.Coerce
|
|
|
|
|
|
-- 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 -> IO ()) -> TomlCodec [a] -> FilePath -> IO [MVar ()]
|
|
forkWithConfigs f = withConfigs (forkBackend . f)
|
|
|
|
withConfigs :: (a -> IO (MVar ())) -> TomlCodec [a] -> FilePath -> IO [MVar ()]
|
|
withConfigs f codec configFile = do
|
|
parseResult <- Toml.decodeFileEither codec configFile
|
|
either
|
|
(error "Logging not implemented")
|
|
(mapM f)
|
|
parseResult
|
|
|
|
-- Note for later:
|
|
-- TODO this may need logging if f dies with an exception
|
|
forkBackend :: IO () -> IO (MVar ())
|
|
forkBackend f = do
|
|
mVar <- newEmptyMVar
|
|
forkFinally f (const $ putMVar mVar ())
|
|
return mVar
|