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.
106 lines
3.6 KiB
106 lines
3.6 KiB
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE LambdaCase #-}
|
|
|
|
module Conf ( Group(..) , Config(..) , readConfig ) where
|
|
|
|
import qualified Data.Text as T
|
|
import qualified Discord.Types as D
|
|
import Data.Yaml ( Object
|
|
, decodeFileThrow
|
|
, (.:)
|
|
, parseMaybe
|
|
, Parser
|
|
, withObject
|
|
, FromJSON
|
|
, Value (Object, Number, String)
|
|
, parseJSON
|
|
)
|
|
import qualified Data.HashMap.Strict as H
|
|
import qualified Data.Map.Strict as Map
|
|
import Data.Maybe (fromMaybe)
|
|
import Control.Monad (mzero)
|
|
|
|
import Data.Word (Word64)
|
|
import Data.Scientific (Scientific, floatingOrInteger)
|
|
import Data.Either (fromRight)
|
|
|
|
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
|