@@ -1,28 +1,22 @@
11module Text.XML.DOM.Parser.Content
2− ( -- * Content readers
3− readBool
4− , readChar
5− -- ** Reader constructors
6− , maybeReadContent
7− , readContent
2+ (
3+ -- * Parsing element's content
4+ parseContent
85 -- * Getting current element's properties
96 , getCurrentName
107 , getCurrentContent
11− , getCurrentAttributes
12− , getCurrentAttribute
138 , checkCurrentName
14− -- * Parsing element's content
15− , parseContent
16− -- * Parsing attributes
17− , parseAttribute
18− , parseAttributeMaybe
9+ -- * Internal
10+ , maybeReadContent
11+ , readContent
12+ , readBool
13+ , readChar
1914 ) where
2015
2116import Control.Lens
2217import Control.Monad
2318import Control.Monad.Except
2419import Data.List as L
25−import Data.Map.Strict as M
2620import Data.Monoid
2721import Data.Text as T
2822import Data.Typeable
@@ -31,54 +25,19 @@ import Text.XML.DOM.Parser.Types
3125import Text.XML.Lens
3226
3327
34−-- | @since 1.0.0
35−readBool :: Text -> Either Text Bool
36−readBool t =
37− let
38− lowt = T.toLower $ T.strip t
39− tvals = ["y", "yes", "t", "true", "1"]
40− fvals = ["n", "no", "f", "false", "0"]
41− in if
42− | lowt `elem` tvals -> Right True
43− | lowt `elem` fvals -> Right False
44− | otherwise ->
45− Left $ "Could not read " <> t <> " as Bool"
46−
47−-- | Expects text to be single character
48−--
49−-- @since 1.0.0
50−readChar :: Text -> Either Text Char
51−readChar t = case T.unpack $ T.strip t of
52− [c] -> Right c
53− _ -> Left "Should have exactly one non-blank character"
54−
55−-- | If reader returns 'Nothing' then resulting function returns 'Left
56−-- "error message"'. 'Typeable' is used for generating usefull error
57−-- message.
58−--
59−-- @since 1.0.0
60−maybeReadContent
61− :: forall a
62− . (Typeable a)
63− => (Text -> Maybe a)
64− -- ^ Content or attribute reader
65− -> Text
66− -- ^ Content or attribute value
67− -> Either Text a
68−maybeReadContent f t = maybe (Left msg) Right $ f t
69− where
70− msg = "Not readable " <> n <> ": " <> t
71− n = T.pack $ show $ typeRep (Proxy :: Proxy a)
72−
28+-- | Parses content inside current tag. It expects current element set
29+-- consists of exactly ONE element.
30+parseContent
31+ :: (Monad m)
32+ => (Text -> Either Text a)
33+ -- ^ Content parser, return error msg if value is not parsed
34+ -> DomParserT Identity m a
35+parseContent parse = getCurrentContent >>= \case
36+ Nothing -> throwParserError PEContentNotFound
37+ Just c -> case parse c of
38+ Left e -> throwParserError $ PEWrongFormat e
39+ Right a -> return a
7340
74−-- | Tries to read given text to value using 'Read'. Useful to use
75−-- with 'parseContent' and 'parseAttribute'. Content is stripped
76−-- before reading.
77−readContent
78− :: (Read a, Typeable a)
79− => Text
80− -> Either Text a
81−readContent = maybeReadContent $ readMaybe . T.unpack . T.strip
8241
8342-- | Returns name of current element.
8443--
@@ -118,67 +77,52 @@ getCurrentContent = do
11877 | L.null conts -> Nothing
11978 | otherwise -> Just $ mconcat conts
12079
121−-- | Parses content inside current tag. It expects current element set
122−-- consists of exactly ONE element.
123−parseContent
124− :: (Monad m)
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
132− Right a -> return a
133−
134−-- | Retuns map of attributes of current element
80+-- | If reader returns 'Nothing' then resulting function returns 'Left
81+-- "error message"'. 'Typeable' is used for generating usefull error
82+-- message.
13583--
13684-- @since 1.0.0
137−getCurrentAttributes
138− :: (Monad m)
139− => DomParserT Identity m (M.Map Name Text)
140−getCurrentAttributes = view $ pdElements . to runIdentity . attrs
85+maybeReadContent
86+ :: forall a
87+ . (Typeable a)
88+ => (Text -> Maybe a)
89+ -- ^ Content or attribute reader
90+ -> Text
91+ -- ^ Content or attribute value
92+ -> Either Text a
93+maybeReadContent f t = maybe (Left msg) Right $ f t
94+ where
95+ msg = "Not readable " <> n <> ": " <> t
96+ n = T.pack $ show $ typeRep (Proxy :: Proxy a)
14197
142−-- | Returns element with given name or 'Nothing'
143−--
144−-- @since 1.0.0
145−getCurrentAttribute
146− :: (Monad m)
147− => NameMatcher
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
15298
153−-- | Parses attribute with given name, throws error if attribute is not found.
154−--
155−-- @since 1.0.0
156−parseAttribute
157− :: (Monad m)
158− => NameMatcher
159− -- ^ Attribute name
160− -> (Text -> Either Text a)
161− -- ^ Attribute content parser
162− -> DomParserT Identity m a
163−parseAttribute attrName parser =
164− parseAttributeMaybe attrName parser >>= \case
165− Nothing -> throwParserError $ PEAttributeNotFound attrName
166− Just a -> return a
99+-- | Tries to read given text to value using 'Read'. Useful to use
100+-- with 'parseContent' and 'parseAttribute'. Content is stripped
101+-- before reading.
102+readContent
103+ :: (Read a, Typeable a)
104+ => Text
105+ -> Either Text a
106+readContent = maybeReadContent $ readMaybe . T.unpack . T.strip
107+
167108
168−-- | Parses attribute with given name. Returns Nothing if attribute is
169−-- not found.
109+-- | @since 1.0.0
110+readBool :: Text -> Either Text Bool
111+readBool t =
112+ let
113+ lowt = T.toLower $ T.strip t
114+ tvals = ["y", "yes", "t", "true", "1"]
115+ fvals = ["n", "no", "f", "false", "0"]
116+ in if
117+ | lowt `elem` tvals -> Right True
118+ | lowt `elem` fvals -> Right False
119+ | otherwise ->
120+ Left $ "Could not read " <> t <> " as Bool"
121+
122+-- | Expects text to be single character
170123--
171124-- @since 1.0.0
172−parseAttributeMaybe
173− :: (Monad m)
174− => NameMatcher
175− -- ^ Attribute name
176− -> (Text -> Either Text a)
177− -- ^ Attribute content parser
178− -> DomParserT Identity m (Maybe a)
179−parseAttributeMaybe attrName parser =
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
125+readChar :: Text -> Either Text Char
126+readChar t = case T.unpack $ T.strip t of
127+ [c] -> Right c
128+ _ -> Left "Should have exactly one non-blank character"