ParsePlist.hs

module ParsePlist ( Xexpr(..)
                  , plistParser
                  , plistParserWithHeaderAndFooter
                  , defaultHeader
                  , defaultFooter
                  , parseXexpr
                  )where

import Control.Monad
import Text.Parsec         (spaces, (<|>), manyTill, many, noneOf,
                            anyChar, char, eof, try, lookAhead, string)
import Text.Parsec.String  (Parser)

import XExpression -- Xexpr data type
import Utils               (trimSpaces)

-----------------------------  API

plistParser :: Parser Xexpr
plistParser = defaultHeader *> parseXexpr <* defaultFooter

plistParserWithHeaderAndFooter :: Parser a -> Parser b -> Parser Xexpr
plistParserWithHeaderAndFooter h f = h *> parseXexpr <* f


defaultHeader :: Parser ()
defaultHeader = void $ manyTill anyChar (try (lookAhead (string "<dict>")))

defaultFooter :: Parser ()
defaultFooter = string "</plist>" *> spaces <|> eof

parseXexpr :: Parser Xexpr
parseXexpr = do
  xmark <- parseXmark
  cont  <- parseSubs xmark <|> parseLit xmark
  _ <- eof <|>  spaces
  return $ Xmark xmark cont


----------------------------- PRIVATE

parseXmark :: Parser String
parseXmark = trimSpaces <$>
             (char '<' *> spaces
              *> (many $ noneOf ">") <*
             char '>' <* spaces)


parseLit :: String -> Parser Xexpr
parseLit endMark = (Lit . trimSpaces) <$> (spaces *>
                   manyTill anyChar
                            (try (string $ "</" ++ endMark ++ ">")))


parseSubs :: String -> Parser Xexpr
parseSubs endMark = Subs <$>
                    manyTill (parseXexpr <* spaces)
                             (try (string $ "</" ++ endMark ++ ">"))