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