@@ -1,28 +1,22 @@
1module Text.XML.DOM.Parser.Content
1module Text.XML.DOM.Parser.Content
2− ( -- * Content readers
2+ (
3− readBool
3+ -- * Parsing element's content
4− , readChar
4+ parseContent
5− -- ** Reader constructors
8 -- * Getting current element's properties
5 -- * Getting current element's properties
9 , getCurrentName
6 , getCurrentName
10 , getCurrentContent
7 , getCurrentContent
11− , getCurrentAttributes
12− , getCurrentAttribute
13 , checkCurrentName
8 , checkCurrentName
14− -- * Parsing element's content
9+ -- * Internal
15− , parseContent
10+ , maybeReadContent
16− -- * Parsing attributes
11+ , readContent
17− , parseAttribute
12+ , readBool
18− , parseAttributeMaybe
13+ , readChar
21import Control.Lens
16import Control.Lens
22import Control.Monad
17import Control.Monad
23import Control.Monad.Except
18import Control.Monad.Except
24import Data.List as L
19import Data.List as L
25−import Data.Map.Strict as M
26import Data.Monoid
20import Data.Monoid
27import Data.Text as T
21import Data.Text as T
28import Data.Typeable
22import Data.Typeable
@@ -31,54 +25,19 @@ import Text.XML.DOM.Parser.Types
31import Text.XML.Lens
25import Text.XML.Lens
34−-- | @since 1.0.0
28+-- | Parses content inside current tag. It expects current element set
35−readBool :: Text -> Either Text Bool
29+-- consists of exactly ONE element.
36−readBool t =
30+parseContent
38− lowt = T.toLower $ T.strip t
39− tvals = ["y", "yes", "t", "true", "1"]
40− fvals = ["n", "no", "f", "false", "0"]
42− | lowt `elem` tvals -> Right True
43− | lowt `elem` fvals -> Right False
45− Left $ "Could not read " <> t <> " as Bool"
47−-- | Expects text to be single character
50−readChar :: Text -> Either Text Char
51−readChar t = case T.unpack $ T.strip t of
53− _ -> Left "Should have exactly one non-blank character"
55−-- | If reader returns 'Nothing' then resulting function returns 'Left
56−-- "error message"'. 'Typeable' is used for generating usefull error
63− => (Text -> Maybe a)
32+ => (Text -> Either Text a)
64− -- ^ Content or attribute reader
33+ -- ^ Content parser, return error msg if value is not parsed
65− -> Text
34+ -> DomParserT Identity m a
66− -- ^ Content or attribute value
35+parseContent parse = getCurrentContent >>= \case
67− -> Either Text a
36+ Nothing -> throwParserError PEContentNotFound
68−maybeReadContent f t = maybe (Left msg) Right $ f t
37+ Just c -> case parse c of
69− where
38+ Left e -> throwParserError $ PEWrongFormat e
70− msg = "Not readable " <> n <> ": " <> t
39+ Right a -> return a
71− n = T.pack $ show $ typeRep (Proxy :: Proxy a)
74−-- | Tries to read given text to value using 'Read'. Useful to use
75−-- with 'parseContent' and 'parseAttribute'. Content is stripped
78− :: (Read a, Typeable a)
81−readContent = maybeReadContent $ readMaybe . T.unpack . T.strip
83-- | Returns name of current element.
42-- | Returns name of current element.
@@ -118,67 +77,52 @@ getCurrentContent = do
118 | L.null conts -> Nothing
77 | L.null conts -> Nothing
119 | otherwise -> Just $ mconcat conts
78 | otherwise -> Just $ mconcat conts
121−-- | Parses content inside current tag. It expects current element set
80+-- | If reader returns 'Nothing' then resulting function returns 'Left
122−-- consists of exactly ONE element.
81+-- "error message"'. 'Typeable' is used for generating usefull error
123−parseContent
82+-- message.
125− => (Text -> Either Text a)
126− -- ^ Content parser, return error msg if value is not parsed
127− -> DomParserT Identity m a
128−parseContent parse = getCurrentContent >>= \case
129− Nothing -> throwParserError PEContentNotFound
130− Just c -> case parse c of
131− Left e -> throwParserError $ PEWrongFormat e
134−-- | Retuns map of attributes of current element
136-- @since 1.0.0
84-- @since 1.0.0
137−getCurrentAttributes
85+maybeReadContent
138− :: (Monad m)
86+ :: forall a
139− => DomParserT Identity m (M.Map Name Text)
87+ . (Typeable a)
140−getCurrentAttributes = view $ pdElements . to runIdentity . attrs
88+ => (Text -> Maybe a)
89+ -- ^ Content or attribute reader
91+ -- ^ Content or attribute value
93+maybeReadContent f t = maybe (Left msg) Right $ f t
95+ msg = "Not readable " <> n <> ": " <> t
96+ n = T.pack $ show $ typeRep (Proxy :: Proxy a)
142−-- | Returns element with given name or 'Nothing'
148− -> DomParserT Identity m (Maybe Text)
149−getCurrentAttribute attrName
150− = preview $ pdElements . to runIdentity . attrs . to M.toList
151− . traversed . filtered (views _1 (attrName ^. nmMatch)) . _2
153−-- | Parses attribute with given name, throws error if attribute is not found.
99+-- | Tries to read given text to value using 'Read'. Useful to use
154−--
100+-- with 'parseContent' and 'parseAttribute'. Content is stripped
155−-- @since 1.0.0
101+-- before reading.
156−parseAttribute
102+readContent
157− :: (Monad m)
103+ :: (Read a, Typeable a)
158− => NameMatcher
104+ => Text
160− -> (Text -> Either Text a)
105+ -> Either Text a
161− -- ^ Attribute content parser
106+readContent = maybeReadContent $ readMaybe . T.unpack . T.strip
162− -> DomParserT Identity m a
107+
163−parseAttribute attrName parser =
164− parseAttributeMaybe attrName parser >>= \case
165− Nothing -> throwParserError $ PEAttributeNotFound attrName
168−-- | Parses attribute with given name. Returns Nothing if attribute is
109+-- | @since 1.0.0
169−-- not found.
110+readBool :: Text -> Either Text Bool
113+ lowt = T.toLower $ T.strip t
114+ tvals = ["y", "yes", "t", "true", "1"]
115+ fvals = ["n", "no", "f", "false", "0"]
117+ | lowt `elem` tvals -> Right True
118+ | lowt `elem` fvals -> Right False
120+ Left $ "Could not read " <> t <> " as Bool"
122+-- | Expects text to be single character
171-- @since 1.0.0
124-- @since 1.0.0
176− -> (Text -> Either Text a)
125+readChar :: Text -> Either Text Char
177− -- ^ Attribute content parser
126+readChar t = case T.unpack $ T.strip t of
178− -> DomParserT Identity m (Maybe a)
127+ [c] -> Right c
179−parseAttributeMaybe attrName parser =
128+ _ -> Left "Should have exactly one non-blank character"
180− getCurrentAttribute attrName >>= \case
181− Nothing -> return Nothing
182− Just aval -> case parser aval of
183− Left err -> throwParserError $ PEAttributeWrongFormat attrName err
184− Right a -> return $ Just a