module Darcs.Helpers.Parse where
import Control.Monad.Error
import Text.XML.HaXml
import Text.XML.HaXml.Parse
import Text.XML.HaXml.Posn
import Text.ParserCombinators.Parsec
import qualified Text.ParserCombinators.Parsec.XML as ParseX
import Safe
prsPatches = many prsPatch
prsPatch :: ParseX.XMLParser Patch
prsPatch = do
(attrs,[name]) <- ParseX.namedElementWithAttrs "patch"
auth <- get1Attr "author" attrs
date <- get1Attr "date" attrs
ldate <- get1Attr "local_date" attrs
boolInverted <- maybe (fail "prsPatch, boolInverted") return . readMay =<< ( get1Attr "inverted" $ attrs )
hash <- get1Attr "hash" attrs
patchDesc <- either (const $ fail "prsPatch, patchname")
return
. parse (ParseX.stringElement "name") "patchname" $ [name]
let ptch = Patch (PatchAuthor auth) (PatchDate date) (PatchLocalDate ldate) (PatchInverted boolInverted)
(PatchHash hash) (PatchContents patchDesc )
return ptch
where
get1Attr :: Monad m => String -> [(String, AttValue)] -> m String
get1Attr k attrs = do
(AttValue [etVal]) <- maybe (fail $ "getPatch, no val for" ++ k) return . lookup k $ attrs
case etVal of
Left val -> return val
Right err -> fail $ "getAttr, k: " ++ k
data Patch = Patch { patchAuthor :: PatchAuthor
, patchDate :: PatchDate
, patchLocalDate :: PatchLocalDate
, patchInverted :: PatchInverted
, patchHash :: PatchHash
, patchMessage :: PatchContents }
deriving (Read,Show,Eq)
newtype PatchAuthor = PatchAuthor String
deriving (Read,Show,Eq)
newtype PatchDate = PatchDate String
deriving (Read,Show,Eq)
newtype PatchLocalDate = PatchLocalDate String
deriving (Read,Show,Eq)
newtype PatchInverted = PatchInverted Bool
deriving (Read,Show,Eq)
newtype PatchHash = PatchHash String
deriving (Read,Show,Eq)
newtype PatchContents = PatchContents String
deriving (Read,Show,Eq)
xmlParseTidy :: [Char] -> Either String (Document Posn)
xmlParseTidy xmlString = xmlParse' "xmlParseErrors.out" . clean $ xmlString
where clean xs = filter ( \c -> (c/='\n') && (c/='\t')) xs