matsuri-0.0.1: Config.hs

-- | 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