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