Read a plist file and convert it into Yaml

PlistToYaml.hs

-- Reads a plist file and converts it into Yaml
-- it might not support all plist elements
-- it supports 'dict', 'array', 'integer' and 'string'

-- dependencies: 
--   - base
--   - aeson
--   - xml
--   - yaml
--   - unordered-containers
--   - text

import           Control.Monad
import qualified Data.HashMap.Strict as HM
import           Data.Maybe
import qualified Data.Text           as T
import           Data.Yaml
import           System.Environment  (getArgs)
import           System.IO
import           Text.Read           (readMaybe)
import           Text.XML.Light



selectElems :: Content -> Maybe Element
selectElems (Elem e) = Just e
selectElems _        = Nothing

filterElems :: [Content] -> [Element]
filterElems = mapMaybe selectElems

getName :: Element -> String
getName Element{elName=QName{qName=n}} = n

fromString :: [Content] -> Maybe String
fromString [Text (CData{cdVerbatim=CDataText, cdData=str})] = Just str
fromString _                                                = Nothing

transform :: Element -> Either String Value
transform Element{elName=QName{qName="dict"}, elContent=ct} = Object . HM.fromList <$> (toAssocList =<< mapM toKV (filterElems ct))
  where
    toKV (Element{elName=QName{qName="key"}, elContent=keyContent}) = maybe (Left $ "Unparseable key " ++ show keyContent) (Right . Left) $ fromString keyContent
    toKV el = Right <$> transform el
    toAssocList = foldM f (Nothing, []) >=> noTrailingKey
      where
        f (Nothing, l) (Left key)   = return (Just key, l)
        f (Just key, l) (Right val) = return (Nothing, (T.pack key,val):l)
        f _ _                       = Left "Expect key after value"

        noTrailingKey (Nothing, l)  = return l
        noTrailingKey (Just key, _) = Left $ "Trailing key " ++ show key
transform Element{elName=QName{qName="array"}, elContent=ct} = toJSON <$> mapM transform (filterElems ct)
transform Element{elName=QName{qName="string"}, elContent=ct} = toJSON <$> maybe (Left $ "expected string, got " ++ show ct) Right (fromString ct)
transform Element{elName=QName{qName="integer"}, elContent=ct} = Number . realToFrac <$> maybe (Left $ "expected integer, got " ++ show ct) Right (fromString ct >>= readMaybe :: Maybe Integer)
transform Element{elName=QName{qName=n}} = Left $ "Expected array, string, integer or dict, got " ++ n


fromPlist :: Element -> Either String Value
fromPlist Element{elName=QName{qName="plist"}, elContent=ct} =
    case filterElems ct of
        [e] -> transform e
        _   -> Left "expected element"
fromPlist _ = Left "Expect plist"


main :: IO ()
main = do
    [sourceFile, targetFile] <- getArgs
    source <- readFile sourceFile

    either (hPutStrLn stderr) (encodeFile targetFile) $ fromPlist =<< maybe (Left "XML unparseable") return (parseXMLDoc source)