{-# LANGUAGE OverloadedStrings #-}
module Data.Git.Config
( Config(..)
, Section(..)
, readConfig
, readGlobalConfig
, listSections
, get
) where
import Data.Git.Path
import Data.Git.Imports
import Data.Git.OS
import Data.List (find)
import qualified Data.Set as S
newtype Config = Config [Section]
deriving (Show,Eq)
data Section = Section
{ sectionName :: String
, sectionKVs :: [(String, String)]
} deriving (Show,Eq)
parseConfig :: String -> Config
parseConfig = Config . reverse . toSections . foldl accSections ([], Nothing) . lines
where toSections (l,Nothing) = l
toSections (l,Just s) = s : l
accSections (sections, mcurrent) ('[':sectNameE)
| last sectNameE == ']' =
let sectName = take (length sectNameE - 1) sectNameE
in case mcurrent of
Nothing -> (sections, Just $ Section sectName [])
Just current -> (sectionFinalize current : sections, Just $ Section sectName [])
| otherwise =
(sections, mcurrent)
accSections acc@(_, Nothing) _ = acc
accSections (sections, Just current) kvLine =
case break (== '=') kvLine of
(k,'=':v) -> (sections, Just $ sectionAppend current (strip k, strip v))
(_,_) -> (sections, Just current)
sectionAppend (Section n l) kv = Section n (kv:l)
sectionFinalize (Section n l) = Section n $ reverse l
strip s = dropSpaces $ reverse $ dropSpaces $ reverse s
where dropSpaces = dropWhile (\c -> c == ' ' || c == '\t')
readConfigPath :: LocalPath -> IO Config
readConfigPath filepath = parseConfig <$> readTextFile filepath
readConfig :: LocalPath -> IO Config
readConfig gitRepo = readConfigPath (configPath gitRepo)
readGlobalConfig :: IO Config
readGlobalConfig = getHomeDirectory >>= readConfigPath . (\homeDir -> homeDir </> ".gitconfig")
listSections :: [Config] -> [String]
listSections = S.toList . foldr accSections S.empty
where accSections (Config sections) set = foldr S.insert set (map sectionName sections)
get :: [Config]
-> String
-> String
-> Maybe String
get [] _ _ = Nothing
get (Config c:cs) section key = findOne `mplus` get cs section key
where findOne = find (\s -> sectionName s == section) c >>= lookup key . sectionKVs