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 SchroederMaintainer : jonathan.von_schroeder@dfki.de
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederStability : experimental
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederPortability : portable
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroederimport qualified Data.ByteString.Lazy as L
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 Just res -> runMaybeT (foldCatchLeft fn res)
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder _ -> return (Just def)
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederwhileM :: Monad m => MaybeT m a -> MaybeT m [a]
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederwhileM fn = liftM reverse $ foldCatchLeft (\ l -> liftM (: l) fn) []
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 SchroedergetM :: MSaxState (SaxEvL, DbgData)
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroedergetM = liftToMaybeT get
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederputM :: (SaxEvL, DbgData) -> MSaxState ()
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederputM = liftToMaybeT . put
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederdebugS' :: String -> State (SaxEvL, DbgData) (Maybe a)
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 else return Nothing
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederdebugS :: String -> MSaxState a
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederdebugS s = MaybeT $ debugS' s
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 SchroedergetD :: MSaxState SaxEvL
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroedergetD = liftM fst getM
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederputD :: SaxEvL -> MSaxState ()
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder (_, dbg) <- getM
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder putM (evl, dbg)
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroederparsexml :: L.ByteString -> SaxEvL
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroederparsexml = parse defaultParseOptions
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederdropSpaces :: MSaxState ()
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder putD $ dropWhile
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder CharacterData d -> all isSpace d
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroedertag :: MSaxState (Bool, String)
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 SchroederexpectTag :: Bool -> String -> MSaxState String
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederexpectTag st s = do
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder v <- runMaybeT tag
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder Just p -> let p2 = (st, s) in if p2 /= p
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 debugS' "Expected a tag, but didn't find one - see previous message!"
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederreadWithTag :: MSaxState a -> String -> MSaxState a
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederreadWithTag fn tagName = do
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder expectTag True tagName
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von Schroeder expectTag False tagName
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederreadL :: Show a => MSaxState a -> String -> MSaxState [a]
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederreadL fn = readWithTag (whileM fn)
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederfoldS :: Show a => (a -> MSaxState a) -> a -> String -> MSaxState a
081559cfba7150d19604bdeafdc2d9983f7216b3Jonathan von SchroederfoldS fn def = readWithTag (foldCatchLeft fn def)