module Text.XML.Plist.Read (
readPlistFromFile,
plistToObject,
xmlToObject
) where
import Text.XML.Plist.PlObject
import Text.XML.HXT.Arrow
import Codec.Binary.Base64
import Data.Maybe
readPlistFromFile :: String -> IO PlObject
readPlistFromFile fileName =
do
res <- runX (
readDocument [] fileName >>>
plistToObject
)
if null res
then fail $ "can't parse " ++ fileName
else return $ head res
plistToObject :: ArrowXml a => a XmlTree PlObject
plistToObject =
deep (hasName "plist") >>>
getChildren >>>
xmlToObject
xmlToObject :: ArrowXml a => a XmlTree PlObject
xmlToObject = choiceA [
hasName "string" :-> (innerText >>> arr PlString),
hasName "true" :-> constA (PlBool True),
hasName "false" :-> constA (PlBool False),
hasName "integer" :-> (innerText >>> arr (PlInteger . read)),
hasName "real" :-> (innerText >>> arr (PlReal . read)),
hasName "array" :-> (listA readArray >>> arr PlArray),
hasName "dict" :-> (readDict >>> arr PlDict),
hasName "data" :-> (
innerText >>>
arr (decode . unchop . lines) >>>
isA isJust >>>
arr fromJust >>>
arr PlData
),
hasName "date" :-> (innerText >>> arr PlDate)
]
readDict :: ArrowXml a => a XmlTree [(String, PlObject)]
readDict = listA $
readDict' $< listA (getChildren >>> isElem)
readDict' :: ArrowXml a => [XmlTree] -> a b (String, PlObject)
readDict' [] = none
readDict' [_] = none
readDict' (key : val : xs) =
((constA key >>> hasName "key" >>> innerText) &&&
(constA val >>> xmlToObject)) <+>
readDict' xs
readArray :: ArrowXml a => a XmlTree PlObject
readArray =
getChildren >>>
xmlToObject
innerText :: ArrowXml a => a XmlTree String
innerText = withDefault (single (
getChildren >>>
isText >>>
getText
)) ""