XmlPickler.hs revision 0cfd05a6fc2205cd57dcabaeb86acedf645188b1
463a7b70ba0f1427008025026375cd28be7bc86fChristian Maeder{-# LANGUAGE TypeSynonymInstances #-}
463a7b70ba0f1427008025026375cd28be7bc86fChristian MaederModule : $Header$
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
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian MaederpuString :: PU String String
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian Maeder { pickle = id
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian Maeder , unpickle = return . id
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
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian MaederxpString = puWrap xpCData puString
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
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian Maeder-- | attribute pickler
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian Maederxa :: PU a (b, [Attr]) -> PU b Element -> PU a Element
463a7b70ba0f1427008025026375cd28be7bc86fChristian Maederxa au pub = PU
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian Maeder { pickle = \ a ->
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian Maeder let (b, attrs) = pickle au a
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian Maeder in add_attrs attrs $ pickle pub b
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian Maeder , unpickle = \ e -> do
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian Maeder b <- unpickle pub e
0cfd05a6fc2205cd57dcabaeb86acedf645188b1Christian Maeder unpickle au (b, elAttribs e)