git.iko.soy/typeable/dom-parser
on master help sign in
Merge pull request #1 from typeable/attribute-class
65a7be4Vladislav Zavialov
src/Text/XML/DOM/Parser/Class.hs+39−14
compare with master
unifiedsplit
@@ -18,22 +18,23 @@ module Text.XML.DOM.Parser.Class
18 , unitFromDom
18 , unitFromDom
19 , voidFromDom
19 , voidFromDom
20 , scientificFromDom
20 , scientificFromDom
21+ -- * FromAttribute
22+ , FromAttribute(..)
21 ) where
23 ) where
22
24
23−import Control.Applicative
25+import Control.Applicative
24−import Control.Lens
26+import Control.Lens
25−import Data.Fixed
27+import Data.Fixed
26−import Data.Monoid
28+import Data.Monoid
27−import Data.OpenUnion
29+import Data.OpenUnion
28−import Data.Scientific
30+import Data.Scientific
29−import Data.Text (Text)
30−import qualified Data.Text as T
31+import Data.Text as T hiding (empty)
31−import Data.Typeable
32+import Data.Typeable
32−import Data.Void
33+import Data.Void
33−import Text.XML
34+import Text.XML
34−import Text.XML.DOM.Parser.Combinators
35+import Text.XML.DOM.Parser.Combinators
35−import Text.XML.DOM.Parser.Types
36+import Text.XML.DOM.Parser.Types
36−import TypeFun.Data.List hiding (Union)
37+import TypeFun.Data.List hiding (Union)
37
38
38proxyFromDom
39proxyFromDom
39 :: forall proxy m a
40 :: forall proxy m a
@@ -162,3 +163,27 @@ unitFromDom = pure ()
162-- | Never parses successfully. It is just 'mzero'
163-- | Never parses successfully. It is just 'mzero'
163voidFromDom :: (Monad m) => DomParserT Identity m Void
164voidFromDom :: (Monad m) => DomParserT Identity m Void
164voidFromDom = empty
165voidFromDom = empty
166+
167+class FromAttribute a where
168+ fromAttribute :: Text -> Either Text a
169+
170+instance FromAttribute () where
171+ fromAttribute _ = Right ()
172+
173+instance FromAttribute Text where
174+ fromAttribute = Right
175+
176+instance FromAttribute Char where
177+ fromAttribute = readChar
178+
179+instance FromAttribute Int where
180+ fromAttribute = readContent
181+
182+instance FromAttribute Integer where
183+ fromAttribute = readContent
184+
185+instance (Typeable a, HasResolution a) => FromAttribute (Fixed a) where
186+ fromAttribute = readContent
187+
188+instance FromAttribute Scientific where
189+ fromAttribute = readContent
src/Text/XML/DOM/Parser/Combinators.hs+22−5
@@ -28,6 +28,7 @@ module Text.XML.DOM.Parser.Combinators
28 , maybeReadContent
28 , maybeReadContent
29 -- * Parsing attributes
29 -- * Parsing attributes
30 , parseAttribute
30 , parseAttribute
31+ , parseAttributeMaybe
31 ) where
32 ) where
32
33
33import Control.Lens
34import Control.Lens
@@ -309,8 +310,24 @@ parseAttribute
309 -> (Text -> Either Text a)
310 -> (Text -> Either Text a)
310 -- ^ Attribute content parser
311 -- ^ Attribute content parser
311 -> DomParserT Identity m a
312 -> DomParserT Identity m a
313+parseAttribute attrName parser =
314+ parseAttributeMaybe attrName parser >>= \case
315+ Nothing -> throwParserError $ PEAttributeNotFound attrName
316+ Just a -> return a
317+
318+-- | Parses attribute with given name.
319+--
320+-- @since 1.0.0
321+parseAttributeMaybe
322+ :: (Monad m)
323+ => Text
324+ -- ^ Attribute name
325+ -> (Text -> Either Text a)
326+ -- ^ Attribute content parser
327+ -> DomParserT Identity m (Maybe a)
328+parseAttributeMaybe attrName parser =
312−parseAttribute attrName parser = getCurrentAttribute attrName >>= \case
329+ getCurrentAttribute attrName >>= \case
313− Nothing -> throwParserError $ PEAttributeNotFound attrName
330+ Nothing -> return Nothing
314− Just aval -> case parser aval of
331+ Just aval -> case parser aval of
315− Left err -> throwParserError $ PEAttributeWrongFormat attrName err
332+ Left err -> throwParserError $ PEAttributeWrongFormat attrName err
316− Right a -> return a
333+ Right a -> return $ Just a