-- | Config.hs -- Config file reading; functions for working with config structure. module Config ( Config, readConfig, getCF, setCF ) where import Buffers import Help 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", "0.0.x") , ("OS", "LEENOOPS OS") , ("roster_width", "20") , ("show_roster", "1") , ("default_group", "other") , ("conferences_group", "conferences") ] -- | Reading "main" and "account_*" sections of config file. readConfig :: FilePath -> IO (Config, Buffers) readConfig filePath = do home <- getHomeDirectory fileCnt <- handle (\_ -> error help_noconfig) (readFile (home++"/"++filePath)) confs <- runErrorT $ do conf <- readstring emptyCP fileCnt -- reading and updating main options mainOptions <- items conf "main" let def_conf = M.fromList defaultConfig config = foldr updateValue def_conf mainOptions -- reading account_* sections let sects' = filter ("account_" `isPrefixOf`) (sections conf) sects | length sects' == 0 = configError "no accounts" | otherwise = sects' readAcc acc = liftM2 (,) (return $ drop 8 acc) (items conf acc) liftM2 (,) (return config) (mapM readAcc sects >>= return . foldr doAccount M.empty) case confs of Left _ -> configError "wrong format" Right conf -> return conf -- | Update option's value or exit with error if find unknown 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 -> if "alias " `isPrefixOf` option then M.insert option value config else configError ("unknown `"++option++"' option") -- | Insert new account in buffer or exit with error if wrong options. doAccount :: (String, [(OptionSpec, String)]) -> Buffers -> Buffers doAccount (accountName, accountOpts) = M.insert accountName (BufAccount Account { accName = accountName , username = username' , server = findOpt "server" , password = findOpt "password" , resource = resource' , priority = priority' , defaultNick = defaultNick' , connection = NoConnection , accCollapsed = False , accContents = [] }) where username' = findOpt "username" resource' = maybe "matsuri" snd $ findOpt' "resource" priority' = maybe 0 (read . snd) $ findOpt' "priority" defaultNick' = maybe username' snd $ findOpt' "nick" findOpt opt = maybe (noOpt opt) snd $ findOpt' opt findOpt' optName = find (\(name, _) -> name == optName) accountOpts noOpt opt = configError ("can't find `'"++opt++"' option\ \ for `"++accountName++"' account") configError err = error ("can't read config file ("++err++")") getCF :: String -> Config -> String getCF k = maybe "" id . M.lookup k setCF :: String -> String -> Config -> Config setCF k v = M.adjust (const v) k