module Support.IniParse(parseIniFiles) where
import Control.Monad.State
import Data.Char
import Data.List
import GenUtil
import qualified Data.Foldable as Seq
import qualified Data.Map as Map
import qualified Data.Sequence as Seq
type St = (Int,FilePath,String)
newtype P a = P (State St a)
deriving(Monad,MonadState St)
third (_,_,x) = x
look :: P String
look = gets third
discard :: Int -> P ()
discard n = do
(fl,fp,s) <- get
let (x,y) = splitAt n s
put (fl + length (filter (== '\n') x),fp, y)
abort :: String -> P a
abort msg = do
(l,fp,_) <- get
fail $ fp ++ ":" ++ show l ++ ": " ++ msg
dropSpace = do
x <- look
case x of
';':_ -> pdropWhile ('\n' /=) >> dropSpace
c:_ | isSpace c -> pdropWhile isSpace >> dropSpace
_ -> return ()
pdropWhile f = do
x <- look
case x of
c:_ | f c -> discard 1 >> pdropWhile f
_ -> return ()
ptakeWhile f = do
x <- look
let ts = takeWhile f x
discard (length ts)
return ts
pThings ch rs zs = ans where
ans = look >>= \x -> case x of
'[':_ -> do
hv <- pHeader
dropSpace
pThings hv Seq.empty (zs Seq.|> (ch,rs))
_:_ -> do
v <- pValue
dropSpace
pThings ch (rs Seq.|> v) zs
[] -> return (zs Seq.|> (ch,rs))
trim = rbdropWhile isSpace
expect w = do
cs <- look
if w `isPrefixOf` cs then discard (length w) else abort ("expected " ++ show w)
pValue = do
n <- ptakeWhile (`notElem` ['\n','='])
expect "="
rs <- ptakeWhile (/= '\n')
return (trim n, trim rs)
pHeader = do
expect "["
n <- ptakeWhile (`notElem` "]\n")
expect "]"
return (trim n)
processIni :: Seq.Seq (String,Seq.Seq (String,String)) -> Map.Map String (Seq.Seq (String,String))
processIni iniRaw = iniMap' where
iniMap,iniMap' :: Map.Map String (Seq.Seq (String,String))
iniMap = Map.fromListWith (flip (Seq.><)) (Seq.toList iniRaw)
iniMap' = Map.map expandChains iniMap
expandChains x = join (fmap ecp x)
ecp :: (String,String) -> Seq.Seq (String,String)
ecp ("merge",v) = Map.findWithDefault Seq.empty v iniMap'
ecp x = Seq.singleton x
parseIniFile :: FilePath -> IO (Seq.Seq (String,Seq.Seq (String,String)))
parseIniFile fp = readFile fp >>= parseIniRaw fp
parseIniRaw :: String -> String -> IO (Seq.Seq (String,Seq.Seq (String,String)))
parseIniRaw fp c = do
let P act = dropSpace >> pThings "default" Seq.empty Seq.empty
return $ evalState act (0,fp,c)
parseIniFiles
:: Bool
-> String
-> [FilePath]
-> [String]
-> IO (Map.Map String String)
parseIniFiles verbose raw fs ss = do
let rf fn = iocatch (do c <- parseIniFile fn; pverb ("reading " ++ fn); return c) (\_ -> return Seq.empty)
pverb s = if verbose then putErrLn s else return ()
rawp <- parseIniRaw "(builtin targets.ini)" raw
fsc <- mapM rf fs
let pini = processIni (foldr (Seq.><) Seq.empty (rawp:fsc))
f (x:xs) cm = case span (/= '=') x of
(be,'=':re) -> f xs (res cm (be,re))
~(be,[]) -> f xs (Seq.foldl res cm (Map.findWithDefault Seq.empty be pini))
f [] cm = cm
res mp (k,v) | Just r <- getPrefix "+" (reverse k) = Map.insertWith f (reverse $ dropWhile isSpace r) v mp where
f y x = x ++ " " ++ y
res mp (k,v) = Map.insert k v mp
return (f ss Map.empty)