aboutsummaryrefslogtreecommitdiff
path: root/src/Config.hs
blob: e06739ceb67245b6130ae668222e6bac456af570 (plain)
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
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell   #-}
module Config
    ( Config
    , getConfigConfigFile
    , getConfigDatabase
    , getConfigFeedInfos
    , getConfigAddressFrom
    , getConfigAddressTo
    , getConfigTopicLength
    , getConfigLogLevel
    , getConfig
    ) where

import           Path
import           System.Environment    ( lookupEnv )
import           Data.Maybe            ( fromMaybe )
import           Control.Monad         ( when )
import           System.Directory      ( doesFileExist
                                       , doesDirectoryExist
                                       , createDirectoryIfMissing
                                       , getHomeDirectory
                                       )
import           System.Posix.User
import qualified Data.Text             as T
import           Types
import           Config.CmdConfig
import           Config.FileConfig
import           Config.InternalConfig
import           Filter


data Config = Config
    { configFile        :: !(Path Abs File)
    , configDatabase    :: !(Path Abs File)
    , configFeedInfos   :: ![FeedInfo]
    , configAddressFrom :: !ConfigAddress
    , configAddressTo   :: !ConfigAddress
    , configTopicLength :: !Int
    , configLogLevel    :: !LogLevel
    }

getConfigConfigFile :: Config -> Path Abs File
getConfigConfigFile = configFile

getConfigDatabase :: Config -> Path Abs File
getConfigDatabase = configDatabase

getConfigFeedInfos :: Config -> [FeedInfo]
getConfigFeedInfos = configFeedInfos

getConfigAddressFrom :: Config -> ConfigAddress
getConfigAddressFrom = configAddressFrom

getConfigAddressTo :: Config -> ConfigAddress
getConfigAddressTo = configAddressTo

getConfigTopicLength :: Config -> Int
getConfigTopicLength = configTopicLength

getConfigLogLevel :: Config -> LogLevel
getConfigLogLevel = configLogLevel

defaultTopicLength :: Int
defaultTopicLength = 20

defaultLogLevel :: LogLevel
defaultLogLevel = LevelError

homeDir :: IO (Path Abs Dir)
homeDir = getHomeDirectory >>= parseAbsDir

baseDir :: Path Rel Dir
baseDir = $(mkRelDir "perfeed")

defaultDataDir :: IO (Path Abs Dir)
defaultDataDir = do
    xdgData <- lookupEnv "XDG_DATA_HOME"
    case xdgData of
        Nothing -> do
            home <- homeDir
            return $ home </> $(mkRelDir ".local/share")
        Just dir -> parseAbsDir dir

defaultConfigDir :: IO (Path Abs Dir)
defaultConfigDir = do
    xdgConfig <- lookupEnv "XDG_CONFIG_HOME"
    case xdgConfig of
        Nothing -> do
            home <- homeDir
            return $ home </> $(mkRelDir ".config")
        Just dir -> parseAbsDir dir

defaultConfigFile :: IO (Path Abs File)
defaultConfigFile = do
    dir <- defaultConfigDir
    return $ dir </> baseDir </> $(mkRelFile "perfeed.yaml")

defaultDBFile :: IO (Path Abs File)
defaultDBFile = do
    dir <- defaultDataDir
    return $ dir </> baseDir </> $(mkRelFile "perfeed.db")

defaultInfos :: [FeedInfo]
defaultInfos = []

defaultAddressFrom :: IO ConfigAddress
defaultAddressFrom = do
    uid <- getRealUserID
    uentry <- getUserEntryForID uid
    return $ ConfigAddress Nothing $ T.pack $ userName uentry ++ "@localhost"

defaultAddressTo :: IO ConfigAddress
defaultAddressTo = defaultAddressFrom

getConfig :: IO Config
getConfig = do
    cmdCfg <- parseCmdLine
    defaultCfgFile <- defaultConfigFile
    let cfgFile = fromMaybe defaultCfgFile $ getConfigFile cmdCfg
    initConfigFile cfgFile
    fileCfg <- parseConfigFile cfgFile
    internalConfigToConfig $ cmdCfg `mappend` fileCfg

initConfigFile :: Path Abs File -> IO ()
initConfigFile pconfigfile = do
    not <$> doesDirectoryExist configdir >>= flip createDirectoryIfMissing configdir
    defaultCfg <- defaultConfig
    not <$> doesFileExist configfile >>= flip when (writeInternalConfig pconfigfile $ configToInternalConfig defaultCfg)
  where
    configfile = toFilePath pconfigfile
    configdir = toFilePath $ parent pconfigfile

internalConfigToConfig :: InternalConfig -> IO Config
internalConfigToConfig ic = do
    defaultCfg <- defaultConfig
    let cfile   = fromMaybe (getConfigConfigFile defaultCfg) (getConfigFile ic)
        db      = fromMaybe (getConfigDatabase defaultCfg) (getDatabase ic)
        infos   = fromMaybe (getConfigFeedInfos defaultCfg) (getFeedInfos ic)
        afrom   = fromMaybe (getConfigAddressFrom defaultCfg) (getAddressFrom ic)
        ato     = fromMaybe (getConfigAddressTo defaultCfg) (getAddressTo ic)
        tlength = fromMaybe (getConfigTopicLength defaultCfg) (getTopicLength ic)
        level   = fromMaybe (getConfigLogLevel defaultCfg) (getLogLevel ic)
    return $ Config cfile db infos afrom ato tlength level

defaultConfig :: IO Config
defaultConfig = do
    cfile <- defaultConfigFile
    db <- defaultDBFile
    afrom <- defaultAddressFrom
    ato <- defaultAddressTo
    return $ Config cfile db infos afrom ato tlength level
  where
    infos = defaultInfos
    tlength = defaultTopicLength
    level = defaultLogLevel

configToInternalConfig :: Config -> InternalConfig
configToInternalConfig (Config cfile db infos afrom ato tlength level) =
      setLogLevel (Just level)
    $ setTopicLength (Just tlength)
    $ setAddressTo (Just ato)
    $ setAddressFrom (Just afrom)
    $ setFeedInfos (Just infos)
    $ setDatabase (Just db)
    $ setConfigFile (Just cfile)
    mkInternalConfig