You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 

115 lines
4.1 KiB

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
module Conf
( Group(..)
, Config(..)
, readConfig
) where
import Control.Monad ( mzero )
import qualified Data.HashMap.Strict as H
import qualified Data.Map.Strict as Map
import Data.Maybe ( fromMaybe )
import qualified Data.Text as T
import Data.Yaml ( (.:)
, FromJSON
, Object
, Parser
, Value(Number, Object, String)
, decodeFileThrow
, parseJSON
, parseMaybe
, withObject
)
import qualified Discord.Types as D
import Data.Either ( fromRight )
import Data.Scientific ( Scientific
, floatingOrInteger
)
import Data.Word ( Word64 )
data Group = Group
{ groupChannel :: D.Snowflake
, groupRole :: D.Snowflake
, groupAde :: T.Text
}
deriving (Show, Eq, Read)
hmToGroup :: H.HashMap T.Text Value -> Group
hmToGroup hm = Group
{ groupChannel = scitosno
. valueNum "channel"
. errorRequired "channel"
$ H.lookup "channel" hm
, groupRole = scitosno . valueNum "role" . errorRequired "role" $ H.lookup
"role"
hm
, groupAde = valueText "edturl" . errorRequired "edturl" $ H.lookup
"edturl"
hm
}
data Config = Config
{ configServer :: D.Snowflake
, configGroups :: Map.Map T.Text Group
, configAutoEDTCronDay :: T.Text
, configAutoEDTCronWeek :: T.Text
}
deriving (Show, Eq, Read)
readConfig :: FilePath -> IO Config
readConfig fp = do
conf_yml <- decodeFileThrow fp :: IO Object
-- print conf_yml
return $ ymlToConf conf_yml
ymlToConf :: Object -> Config
ymlToConf v = Config { configServer = server
, configGroups = groups
, configAutoEDTCronDay = autoEdtCronDay
, configAutoEDTCronWeek = autoEdtCronWeek
}
where
server' = errorRequired "server" $ H.lookup "server" v
server = scitosno $ valueNum "server" server'
groups = parseGroups groupsObject
groupsObject = H.lookup "groups" v
parseGroups (Just (Object o)) =
let groupList' :: H.HashMap T.Text Group
groupList' = fmap
( hmToGroup
. (\case
Object u -> u
_ -> error "groups are objects"
)
)
o
in Map.fromList $ H.toList groupList'
parseGroups _ = error "Wrong format for groups"
autoEdtCronDay =
valueText "autoEdtCronDay" $ fromMaybe "0 15 * * 0-4" $ H.lookup
"autoEdtCronDay"
v
autoEdtCronWeek =
valueText "autoEdtCronWeek" $ fromMaybe "30 9 * * 0" $ H.lookup
"autoEdtCronWeek"
v
errorRequired :: [Char] -> Maybe a -> a
errorRequired name = fromMaybe (error $ "required field: " ++ name)
valueText :: [Char] -> Value -> T.Text
valueText _ (String t) = t
valueText name _ = error $ name ++ " should be a string"
valueNum :: [Char] -> Value -> Scientific
valueNum _ (Number n) = n
valueNum name _ = error $ name ++ " should be an integer"
scitosno :: Scientific -> D.Snowflake
scitosno =
D.Snowflake
. (fromInteger :: Integer -> Word64)
. fromRight (error "Cant read that as an int")
. floatingOrInteger