module Text.XML.DOM.Parser.Types
(
ParserError(..)
, pePath
, peDetails
, ParserErrors(..)
, _ParserErrors
, ParserData(..)
, pdElements
, pdPath
, DomParserT
, DomParser
, runDomParserT
, runDomParser
, DomTraversable(..)
, throwParserError
, throwWrongFormat
) where
import Control.Exception
import Control.Lens
import Control.Monad.Except
import Control.Monad.Reader
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NE
import Data.Maybe
import Data.Text (Text)
import GHC.Generics (Generic)
import Text.XML
import Text.XML.Lens
data ParserError
= PENotFound
{ _pePath :: [Text]
}
| PEWrongFormat
{ _peDetails :: Text
, _pePath :: [Text]
}
| PEContentNotFound
{ _pePath :: [Text]
}
| PEOther
{ _peDetails :: Text
, _pePath :: [Text]
} deriving (Eq, Ord, Show, Generic)
makeLenses ''ParserError
instance Exception ParserError
newtype ParserErrors = ParserErrors
{ unParserErrors :: [ParserError]
} deriving (Ord, Eq, Show, Monoid, Generic)
makePrisms ''ParserErrors
instance Exception ParserErrors
data ParserData f = ParserData
{ _pdElements :: f Element
, _pdPath :: [Text]
}
makeLenses ''ParserData
type DomParserT f m = ReaderT (ParserData f) (ExceptT ParserErrors m)
type DomParser f = DomParserT f Identity
runDomParserT
:: (Monad m)
=> Document
-> DomParserT Identity m a
-> m (Either ParserErrors a)
runDomParserT doc par =
let pd = ParserData
{ _pdElements = doc ^. root . to pure
, _pdPath = [doc ^. root . localName]
}
in runExceptT $ runReaderT par pd
runDomParser
:: Document
-> DomParser Identity a
-> Either ParserErrors a
runDomParser doc par = runIdentity $ runDomParserT doc par
class Traversable f => DomTraversable f where
buildDomTraversable :: [a] -> Maybe (f a)
instance DomTraversable Identity where
buildDomTraversable = fmap Identity . listToMaybe
instance DomTraversable [] where
buildDomTraversable = Just
instance DomTraversable Maybe where
buildDomTraversable = Just . listToMaybe
instance DomTraversable NonEmpty where
buildDomTraversable = NE.nonEmpty
throwParserError
:: (MonadError ParserErrors m, MonadReader (ParserData f) m)
=> ([Text] -> ParserError)
-> m a
throwParserError mkerr = do
path <- view pdPath
throwError $ ParserErrors [mkerr path]
throwWrongFormat
:: (MonadError ParserErrors m, MonadReader (ParserData f) m)
=> Text
-> m a
throwWrongFormat err = throwParserError $ PEWrongFormat err