-- | Config.hs -- A module which parse config file and contain Config structure for -- further usage. module Config ( Config, readConfig, getCF, setCF ) where import Buffers import Data.ConfigFile import qualified Data.Map as M import System.Directory import Control.Monad.Error import Control.OldException import Data.List type Config = M.Map OptionSpec String -- | Default config. If no value in config file, then default value -- will be used. defaultConfig = [ ("client", "matsuri") , ("version", "unknown") , ("OS", "unknown") , ("roster_width", "30") , ("show_roster", "1") ] -- | Reading "main" and "account_*" sections of config file. readConfig :: FilePath -> IO (Config, Buffers) readConfig filePath = do home <- getHomeDirectory fileCnt <- handle (\_ -> return "[main]") (readFile (home++"/"++filePath)) let def_conf = M.fromList defaultConfig confs <- runErrorT $ do conf <- readstring emptyCP fileCnt -- reading and updating main options mainOptions <- items conf "main" let config = foldr updateValue def_conf mainOptions -- reading account_* sections let sects = filter (\acc -> take 8 acc == "account_") (sections conf) accountsList <- forM sects $ \account -> do accountItems <- items conf account return (drop 8 account, accountItems) let start = M.singleton "help" (BufHelp []) accounts = foldr updateAccount start accountsList return (config, accounts) case confs of Left _ -> error "can't parse config file (wrong format)" Right conf -> return conf -- | Update option's value or exit with error if no such option. updateValue :: (OptionSpec, String) -> Config -> Config updateValue (option, value) config = let (value', config') = M.updateLookupWithKey (\_ _ -> Just value) option config in case value' of Just _ -> config' Nothing -> error $ "can't parse config file\ \ (unknown \"" ++ option ++ "\" option)" -- | Update account in HashTable or exit with error if wrong options. updateAccount :: (String, [(OptionSpec, String)]) -> Buffers -> Buffers updateAccount (accountName, accountItems) = M.insert accountName (BufAccount Account { accName = accountName , username = findItem "username" , server = findItem "server" , password = findItem "password" , resource = findItem "resource" , defaultNick = findItem "nick" , connection = NoConnection , accCollapsed = False }) where findItem itemName = case find (\(name, _) -> name == itemName) accountItems of Just value -> snd value _ -> error $ "can't parse config file\ \ (wrong \"" ++ accountName ++ "\" account options)" getCF :: String -> Config -> String getCF k = maybe "" id . M.lookup k setCF :: String -> String -> Config -> Config setCF k v = M.adjust (const v) k