{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeData #-} {-# LANGUAGE TypeFamilies #-} module Config ( Config, Config'(..), ConfigStage(..), IfFull, Channel(..), readConfig, enrichConfig, ) where import Data.Char (isSpace) import Data.List (foldl') import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map import Data.Text (Text) import Data.Text qualified as T import Text.Read (readMaybe) import Util -- Example config file: -- -- ``` -- port 8080 -- logs /var/lib/znc/users/ircbrowse/moddata/log -- channel freenode #haskell fn-haskell -- channel liberachat #haskell haskell -- channel liberachat #xmonad xmonad -- ``` -- -- Lines starting with '#' are ignored. type Config = Config' Full -- | Whether a 'Config' is straight from the 'User', or enriched with more -- information ('Full'). type data ConfigStage = User | Full data Config' (stage :: ConfigStage) = Config { uconfChannels :: IfUser stage (Snoc (Text, Text, Text)) -- ^ (network, channel, alias); channel includes '#'. Alias is used for -- URLs and must be globally unique. , confLogsDir :: FilePath , confPort :: Int -- ^ Port at which to host the HTTP server , econfChannels :: IfFull stage [Channel] -- ^ Network-channel pairs, in user-specified order , econfChan2Alias :: IfFull stage (Map Channel Text) -- ^ The URL alias of a network-channel pair , econfAlias2Chan :: IfFull stage (Map Text Channel) -- ^ The network-channel pair corresponding to each alias } deriving instance Show (Config' User) deriving instance Show (Config' Full) type family IfUser stage a where IfUser User a = a IfUser Full a = () type family IfFull stage a where IfFull User a = () IfFull Full a = a -- | network, channelname data Channel = Channel { chanNetwork :: Text, chanChannel :: Text } deriving (Show, Eq, Ord) readConfig :: FilePath -> IO (Config' User) readConfig path = foldl' parseLine initConfig . lines <$> readFile path enrichConfig :: Config' User -> Config enrichConfig conf = conf { uconfChannels = () , econfChannels = [Channel nw ch | (nw, ch, _) <- uchannels] , econfChan2Alias = Map.fromList [(Channel nw ch, alias) | (nw, ch, alias) <- uchannels] , econfAlias2Chan = Map.fromList [(alias, Channel nw ch) | (nw, ch, alias) <- uchannels] } where uchannels = toList (uconfChannels conf) initConfig :: Config' User initConfig = Config { uconfChannels = SnocNil , confLogsDir = error "config: Log directory not set with 'logs'" , confPort = 8000 , econfChannels = () , econfChan2Alias = () , econfAlias2Chan = () } parseLine :: Config' User -> String -> Config' User parseLine conf line -- skip empty lines and comments | case dropWhile isSpace line of [] -> True '#':_ -> True _ -> False = conf parseLine conf line = let (cmd, rest) = break (== ' ') line in case cmd of "port" -> case readMaybe (trim rest) of Just port | 0 <= port, port < 65536 -> conf { confPort = port } _ -> error "config: Invalid port number" "logs" -> let dir = dropWhile isSpace rest in if null dir then error "config: Empty 'logs' directory" else conf { confLogsDir = dropWhile isSpace rest } "channel" -> case words (trim rest) of [network, chan, alias] | all (not . null) [network, chan, alias] -> conf { uconfChannels = uconfChannels conf `Snoc` (T.pack network, T.pack chan, T.pack alias) } _ -> error $ "config: Invalid channel spec: " ++ trim rest _ -> error $ "config: Invalid line with command '" ++ cmd ++ "'" where trim :: String -> String trim = dropWhile isSpace . reverse . dropWhile isSpace . reverse