081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder{- |
e9458b1a7a19a63aa4c179f9ab20f4d50681c168Jens ElknerModule : ./Common/SAX.hs
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederDescription : A few helper functions to work with the sax parser
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederCopyright : (c) Jonathan von Schroeder, DFKI GmbH 2010
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederLicense : GPLv2 or higher, see LICENSE.txt
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederMaintainer : jonathan.von_schroeder@dfki.de
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederStability : experimental
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederPortability : portable
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder-}
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroedermodule Common.SAX where
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroederimport Control.Monad
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroederimport Common.Lib.Maybe
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroederimport Common.Lib.State
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroederimport Text.XML.Expat.SAX
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroederimport qualified Data.ByteString.Lazy as L
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroederimport Data.Char
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederfoldCatchLeft :: Monad m => (a -> MaybeT m a) -> a -> MaybeT m a
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederfoldCatchLeft fn def = MaybeT $ do
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder v <- runMaybeT $ fn def
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder case v of
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder Just res -> runMaybeT (foldCatchLeft fn res)
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder _ -> return (Just def)
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederwhileM :: Monad m => MaybeT m a -> MaybeT m [a]
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederwhileM fn = liftM reverse $ foldCatchLeft (\ l -> liftM (: l) fn) []
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroedertype SaxEvL = [SAXEvent String String]
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroedertype DbgData = (Maybe [String], Bool)
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroedertype MSaxState a = MaybeT (State (SaxEvL, DbgData)) a
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroedergetM :: MSaxState (SaxEvL, DbgData)
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroedergetM = liftToMaybeT get
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederputM :: (SaxEvL, DbgData) -> MSaxState ()
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederputM = liftToMaybeT . put
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederdebugS' :: String -> State (SaxEvL, DbgData) (Maybe a)
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederdebugS' s = do
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder (evl, (dbg, do_dbg)) <- get
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder if do_dbg then do
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder maybe (put (evl, (Just [s], do_dbg)))
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder (\ msg -> put (evl, (Just $ s : msg, do_dbg)))
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder dbg
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder return Nothing
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder else return Nothing
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederdebugS :: String -> MSaxState a
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederdebugS s = MaybeT $ debugS' s
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederrunMSaxState :: MSaxState a -> SaxEvL -> Bool
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder -> (Maybe a, (SaxEvL, DbgData))
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederrunMSaxState f evl b = runState (runMaybeT f) (evl, (Nothing, b))
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroedergetD :: MSaxState SaxEvL
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroedergetD = liftM fst getM
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederputD :: SaxEvL -> MSaxState ()
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederputD evl = do
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder (_, dbg) <- getM
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder putM (evl, dbg)
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroederparsexml :: L.ByteString -> SaxEvL
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroederparsexml = parse defaultParseOptions
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederdropSpaces :: MSaxState ()
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederdropSpaces = do
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder evl <- getD
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder putD $ dropWhile
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder (\ e ->
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder case e of
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder CharacterData d -> all isSpace d
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder _ -> False
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder ) evl
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroedertag :: MSaxState (Bool, String)
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroedertag = do
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder dropSpaces
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder d <- getD
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder case d of
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder [] -> error "Common.SAX.tag"
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder h : xs -> do
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder putD xs
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder case h of
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder StartElement s _ -> return (True, s)
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder EndElement s -> return (False, s)
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder _ -> debugS $ "Expected a tag - instead got: " ++ show h
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederexpectTag :: Bool -> String -> MSaxState String
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederexpectTag st s = do
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder d <- getM
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder MaybeT $ do
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder v <- runMaybeT tag
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder case v of
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder Just p -> let p2 = (st, s) in if p2 /= p
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder then do
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder put d
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder debugS' $ "Expected tag " ++ show p2
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder ++ " but instead got: " ++ show p
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder else return $ Just s
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder Nothing -> do
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder put d
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder debugS' "Expected a tag, but didn't find one - see previous message!"
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederreadWithTag :: MSaxState a -> String -> MSaxState a
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederreadWithTag fn tagName = do
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder expectTag True tagName
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder d <- fn
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder expectTag False tagName
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder return d
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederreadL :: Show a => MSaxState a -> String -> MSaxState [a]
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederreadL fn = readWithTag (whileM fn)
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederfoldS :: Show a => (a -> MSaxState a) -> a -> String -> MSaxState a
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederfoldS fn def = readWithTag (foldCatchLeft fn def)