module Text.NSPlist.Parsec (
pNSPlist
) where
import Data.Word (Word8)
import Numeric (readHex)
import Control.Applicative ((<$>), (<*), (*>), (<*>), pure, (<|>), empty)
import Text.Parsec (Parsec)
import Text.Parsec.Char (char, spaces, alphaNum, string, anyChar, oneOf, digit)
import Text.Parsec.Prim (getInput, setInput, try, many)
import Text.Parsec.Combinator (many1, sepEndBy, endBy, between, option)
import Text.NSPlist.Types (NSPlistValue(..))
pNSPlist :: Parsec String u NSPlistValue
pNSPlist = pNonContent *> pNSPlistValue
pNSPlistValue :: Parsec String u NSPlistValue
pNSPlistValue = pArray <|> pDictionary <|> pBinary <|> (NSString <$> pString)
pCharNonContent :: Char -> Parsec String u Char
pCharNonContent c = char c <* pNonContent
pNonContent :: Parsec String u ()
pNonContent = spaces <* (pComment *> pNonContent <|> pure ())
pComment :: Parsec String u String
pComment = (try pBlockComment <|> try pLineComment) <* spaces
pBlockComment :: Parsec String u String
pBlockComment = const <$> string "/*" <*> recBlockComment <* spaces
where
recBlockComment = try (const "" <$> string "*/")
<|> ((:) <$> anyChar <*> recBlockComment)
pLineComment :: Parsec String u String
pLineComment = const <$> string "//" <*> recLineComment <* spaces
where
recLineComment = try (const "" <$> char '\n')
<|> ((:) <$> anyChar <*> recLineComment)
pArray :: Parsec String u NSPlistValue
pArray =
between (pCharNonContent '(')
(pCharNonContent ')')
(NSArray <$> sepEndBy pNSPlistValue (pCharNonContent ','))
pDictionary :: Parsec String u NSPlistValue
pDictionary =
between (pCharNonContent '{')
(pCharNonContent '}')
(NSDictionary <$> endBy pKeyValue (pCharNonContent ';'))
pKeyValue :: Parsec String u (String, NSPlistValue)
pKeyValue = (,) <$> pString <* pCharNonContent '=' <*> pNSPlistValue
pString :: Parsec String u String
pString = (pQuotedString <|> pNonQuotedString) <* pNonContent
pNonQuotedString :: Parsec String u String
pNonQuotedString = many1 (oneOf "._/" <|> alphaNum)
pQuotedString :: Parsec String u String
pQuotedString = do
input <- getInput
case reads input of
((str, rest):_) -> const str <$> setInput rest
_ -> empty
pBinary :: Parsec String u NSPlistValue
pBinary =
between (pCharNonContent '<') (pCharNonContent '>') (NSData <$> many pHexWord)
pHexWord :: Parsec String u Word8
pHexWord = (\cs -> readHex' . (cs++)) <$> pHexChar <*> option [] pHexChar
where
readHex' str = fst (head (readHex str))
pHexChar :: Parsec String u String
pHexChar = (:[]) <$> (digit <|> oneOf ['a'..'f'] <|> oneOf ['A'..'F']) <* spaces