{-# LANGUAGE CPP #-}
module Data.Tini.Parser (parseIni) where
import Control.Applicative (Alternative, (<|>))
import Control.Monad ((<=<))
#if !MIN_VERSION_base(4, 11, 0)
import Data.Monoid
#endif
#if !MIN_VERSION_base(4, 13, 0)
import Prelude hiding (fail)
import Control.Monad.Fail (MonadFail, fail)
#endif
import Data.Char (isSpace)
import Data.Function (on)
import Data.List (intercalate, sortBy, groupBy)
import Data.Tini.Types
import Data.Tini.Utils (trim, ltrim)
parseIni :: (Alternative m, MonadFail m) => String -> m Ini
parseIni = fmap Ini . undupe "sections" <=< parseSections "" . filterWS . lines
where filterWS = filter (not . null) . map ltrim
undupe :: (Show k, Ord k, MonadFail m) => String -> [(k, v)] -> m [(k, v)]
undupe what ss =
case map (fst . head) $ filter duplicate (dupeGroups ss) of
[] -> return ss
ds -> fail $ "duplicate " <> what <> ": " <> intercalate ", " (map show ds)
where
duplicate (_:_:_) = True
duplicate _ = False
dupeGroups = groupBy ((==) `on` fst) . sortBy (compare `on` fst)
parseSections :: (Alternative m, MonadFail m) => String -> [String] -> m [Section]
parseSections name lns =
case break isSectionHead lns of
([], []) -> return []
(section, []) -> do
props <- parseProps section
return [(SN name, props)]
(section, s:ss) -> do
name' <- parseSectionHead s
props <- parseProps section
sections <- parseSections name' ss
if null section
then return sections
else return ((SN name, props):sections)
parseProps :: (Alternative m, MonadFail m) => [String] -> m [Property]
parseProps = undupe "keys" <=< mapM (\s -> parseComment s <|> parseProp s)
isSectionHead :: String -> Bool
isSectionHead ('[':_) = True
isSectionHead _ = False
parseSectionHead :: MonadFail m => String -> m String
parseSectionHead ('[':s) =
case break (== ']') s of
(name, ']':suffix)
| all isSpace suffix -> return name
| otherwise -> fail $ "section head '" <> name <> "' has trailing garbage"
_ -> fail $ "unclosed section head '" <> s <> "'"
parseSectionHead s =
fail $ "expected section head, but got '" <> s <> "'"
parseProp :: MonadFail m => String -> m Property
parseProp s =
case break (== '=') s of
(k@(_:_), '=':v) -> return (KeyPart (trim k), trim v)
_ -> fail $ "expected 'key = value', but got '" <> s <> "'"
parseComment :: MonadFail m => String -> m Property
parseComment (';':s) = return (Comment ";", s)
parseComment ('#':s) = return (Comment "#", s)
parseComment s = fail $ "expected comment, but got '" <> s <> "'"