1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
|
{-# 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
|
