463a7b70ba0f1427008025026375cd28be7bc86fChristian Maeder{-# LANGUAGE TypeSynonymInstances #-}
463a7b70ba0f1427008025026375cd28be7bc86fChristian MaederDescription : xml pickler
463a7b70ba0f1427008025026375cd28be7bc86fChristian MaederCopyright : (c) Christian Maeder, DFKI GmbH 2010
463a7b70ba0f1427008025026375cd28be7bc86fChristian MaederLicense : GPLv2 or higher, see LICENSE.txt
463a7b70ba0f1427008025026375cd28be7bc86fChristian MaederMaintainer : Christian.Maeder@dfki.de
463a7b70ba0f1427008025026375cd28be7bc86fChristian MaederStability : provisional
463a7b70ba0f1427008025026375cd28be7bc86fChristian MaederPortability : portable
463a7b70ba0f1427008025026375cd28be7bc86fChristian Maederxml pickler on top of the xml light package
463a7b70ba0f1427008025026375cd28be7bc86fChristian Maeder-- | the pickler data type (without a state)
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian Maederdata PU a b = PU
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian Maeder { pickle :: a -> b
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian Maeder , unpickle :: b -> Result a }
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian MaederpuPrim :: (Show a, Read a) => PU a String
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian Maeder { pickle = show
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian Maeder , unpickle = \ s -> case readMaybe s of
463a7b70ba0f1427008025026375cd28be7bc86fChristian Maeder Nothing -> fail $ "unexpected text: " ++ s
463a7b70ba0f1427008025026375cd28be7bc86fChristian Maeder Just a -> return a
bdbb3bac25bfea5dad00e66e78f0708ac984e373Christian MaederpuId :: PU String String
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian Maeder { pickle = id
bdbb3bac25bfea5dad00e66e78f0708ac984e373Christian Maeder , unpickle = return
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian MaederpuWrap :: PU b c -> PU a b -> PU a c
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian MaederpuWrap pbc pab = PU
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian Maeder { pickle = pickle pbc . pickle pab
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian Maeder , unpickle = \ c ->
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian Maeder unpickle pbc c >>= unpickle pab
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian MaederxpCData :: PU String Content
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian Maeder { pickle = mkText
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian Maeder , unpickle = \ c -> case c of
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian Maeder Text d -> return $ cdData d
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian Maeder _ -> fail $ "expected text instead of:\n" ++ ppContent c
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian MaederxpString :: PU String Content
bdbb3bac25bfea5dad00e66e78f0708ac984e373Christian MaederxpString = puWrap xpCData puId
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian MaederxpPrim :: (Show a, Read a) => PU a Content
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian MaederxpPrim = puWrap xpCData puPrim
463a7b70ba0f1427008025026375cd28be7bc86fChristian Maederclass XmlPickler a where
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian Maeder xmlPickler :: PU a Content
463a7b70ba0f1427008025026375cd28be7bc86fChristian Maederinstance XmlPickler String where
463a7b70ba0f1427008025026375cd28be7bc86fChristian Maeder xmlPickler = xpString
463a7b70ba0f1427008025026375cd28be7bc86fChristian Maederinstance XmlPickler Int where
463a7b70ba0f1427008025026375cd28be7bc86fChristian Maeder xmlPickler = xpPrim
463a7b70ba0f1427008025026375cd28be7bc86fChristian Maederinstance XmlPickler Integer where
463a7b70ba0f1427008025026375cd28be7bc86fChristian Maeder xmlPickler = xpPrim
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian MaederpuPair :: PU a b -> PU c d -> PU (a, c) (b, d)
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian MaederpuPair pab pcd = PU
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian Maeder { pickle = \ (a, c) -> (pickle pab a, pickle pcd c)
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian Maeder , unpickle = \ (b, d) -> joinResultWith (,) (unpickle pab b) $ unpickle pcd d
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian MaedertagContentList :: String -> PU [Content] Element
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian MaedertagContentList tag = PU
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian Maeder { pickle = unode tag
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian Maeder , unpickle = \ e -> if qName (elName e) == tag then return $ elContent e
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian Maeder else fail $ "expected <" ++ tag ++ "> element"
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian MaederelemToContent :: PU Element Content
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian MaederelemToContent = PU
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian Maeder { pickle = Elem
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian Maeder , unpickle = \ c -> case c of
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian Maeder Elem e -> return e
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian Maeder _ -> fail $ "expected element instead of:\n" ++ ppContent c
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian MaederpairToList :: PU (a, a) [a]
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian MaederpairToList = PU
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian Maeder { pickle = \ (a, b) -> [a, b]
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian Maeder , unpickle = \ l -> case l of
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian Maeder [a, b] -> return (a, b)
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian Maeder _ -> fail "expected two elements"
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian MaederxpPair :: String -> PU a Content -> PU b Content -> PU (a, b) Element
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian MaederxpPair tag pua =
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian Maeder puWrap (tagContentList tag) . puWrap pairToList . puPair pua
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian Maeder-- | unpickles last element first
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian MaederpuList :: PU a b -> PU [a] [b]
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian MaederpuList pab = PU
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian Maeder { pickle = map (pickle pab)
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian Maeder , unpickle = foldr (joinResultWith (:) . unpickle pab) $ return []
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian MaederxpList :: String -> PU a Content -> PU [a] Element
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian MaederxpList tag = puWrap (tagContentList tag) . puList
bdbb3bac25bfea5dad00e66e78f0708ac984e373Christian MaederxpAttrs :: PU (Element, [Attr]) Element
bdbb3bac25bfea5dad00e66e78f0708ac984e373Christian Maeder { pickle = \ (e, attrs) -> add_attrs attrs e
bdbb3bac25bfea5dad00e66e78f0708ac984e373Christian Maeder , unpickle = \ e -> return (e, elAttribs e)
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian Maeder-- | attribute pickler
bdbb3bac25bfea5dad00e66e78f0708ac984e373Christian Maederxa :: PU a (b, c) -> PU c [Attr] -> PU b Element -> PU a Element
bdbb3bac25bfea5dad00e66e78f0708ac984e373Christian Maederxa split pua pub = puWrap xpAttrs $ puWrap (puPair pub pua) split
bdbb3bac25bfea5dad00e66e78f0708ac984e373Christian MaedertagAttr :: String -> PU String Attr
bdbb3bac25bfea5dad00e66e78f0708ac984e373Christian MaedertagAttr tag = PU
bdbb3bac25bfea5dad00e66e78f0708ac984e373Christian Maeder { pickle = mkAttr tag
bdbb3bac25bfea5dad00e66e78f0708ac984e373Christian Maeder , unpickle = \ a -> if qName (attrKey a) == tag then return $ attrVal a else
bdbb3bac25bfea5dad00e66e78f0708ac984e373Christian Maeder fail $ "expected attribute key: " ++ tag
bdbb3bac25bfea5dad00e66e78f0708ac984e373Christian MaedertagAttrs :: String -> PU String [Attr]
bdbb3bac25bfea5dad00e66e78f0708ac984e373Christian MaedertagAttrs tag = PU
bdbb3bac25bfea5dad00e66e78f0708ac984e373Christian Maeder { pickle = \ s -> if null s then [] else [mkAttr tag s]
bdbb3bac25bfea5dad00e66e78f0708ac984e373Christian Maeder , unpickle = return . fromMaybe "" . lookupAttrBy ((== tag) . qName)