From: Greg Burri Date: Mon, 4 May 2009 20:22:44 +0000 (+0200) Subject: ADD Begining of a new XML parser. Inspired by the book 'Real World Haskell' (chap... X-Git-Url: http://git.euphorik.ch/index.cgi?a=commitdiff_plain;h=798b376bb1bb5c6c7b4088da5f8397a348e039b9;p=pompage.git ADD Begining of a new XML parser. Inspired by the book 'Real World Haskell' (chap 10). (Not yet finished) --- diff --git a/src/Pompage.hs b/src/Pompage.hs index 2316f3f..a60f324 100644 --- a/src/Pompage.hs +++ b/src/Pompage.hs @@ -116,6 +116,56 @@ readXMLFile file = do [] (elChildren root) + +type ParseState = C.Cursor +newtype Parse alpha = Parse { + runParse :: ParseState -> Either String (alpha, ParseState) + } +identity :: alpha -> Parse alpha +identity a = Parse (\s -> Right (a, s)) + +parseNextSibilingContent :: Parse String +parseNextSibilingContent = + getState ==> \initState -> + case nextSibilingElement initState of + Nothing -> + bail "no more sibiling slement" + Just (elem, cursor) -> + putState cursor ==> \_ -> + identity (strContent elem) + +getState :: Parse ParseState +getState = Parse (\s -> Right (s, s)) + +-- Remplace the current state by a new one. +putState :: ParseState -> Parse () +putState s = Parse (\_ -> Right ((), s)) + +-- Construct a parser which return a string error. +bail :: String -> Parse alpha +bail err = Parse $ \s -> + Left $ + err ++ "\nFail at " ++ + case C.current s of + Elem elem -> "element '" ++ qName (elName elem) ++ "'" ++ showLine (elLine elem) + Text txt -> "text '" ++ cdData txt ++ "'" ++ showLine (cdLine txt) + CRef cref -> "cref '" ++ cref + where + showLine line = + case line of + Just l -> " (line " ++ show l ++ ")" + Nothing -> "" + +(==>) :: Parse alpha -> (alpha -> Parse beta) -> Parse beta +firstParser ==> secondParser = Parse chainedParser + where + chainedParser initState = + case runParse firstParser initState of + Left errMessage -> + Left errMessage + Right (firstResult, newState) -> + runParse (secondParser firstResult) newState + elementXMLToMovie :: Element -> Maybe Movie elementXMLToMovie elem = Just (emptyMovie, C.fromElement elem) >>?