git.iko.soy/typeable/dom-parser
on master help sign in
Add Scientific parser, minor style changes
commitc45a80922e5e1000d2cb0866e0897b1f135ef179 authorDenis Redozubov <denis.redozubov@gmail.com> dateMon 26 Dec 2016, 19:43 (10 years ago) parent413d8d3
4 files changed+27−18
dom-parser.cabal+2−1 src/Text/XML/DOM/Parser/Class.hs+15−8 src/Text/XML/DOM/Parser/Combinators.hs+6−5 test/Main.hs+4−4
dom-parser.cabal+2−1
@@ -47,7 +47,8 @@ library
4747 , containers
4848 , lens
4949 , mtl
50− , open-union
50+ , open-union >= 0.2
51+ , scientific
5152 , semigroups
5253 , text
5354 , transformers
src/Text/XML/DOM/Parser/Class.hs+15−8
@@ -17,6 +17,7 @@ module Text.XML.DOM.Parser.Class
1717 , readBool
1818 , unitFromDom
1919 , voidFromDom
20+ , scientificFromDom
2021 ) where
2122
2223import Control.Applicative
@@ -24,6 +25,7 @@ import Control.Lens
2425import Data.Fixed
2526import Data.Monoid
2627import Data.OpenUnion
28+import Data.Scientific
2729import Data.Text (Text)
2830import qualified Data.Text as T
2931import Data.Typeable
@@ -77,12 +79,13 @@ instance FromDom Bool where
7779instance FromDom (Union '[]) where
7880 fromDom = empty
7981
80−instance ( Typeable a, FromDom a, FromDom (Union as)
81− , SubList as (a ': as) )
82− => FromDom (Union (a ': as)) where
82+instance
83+ ( Typeable a, FromDom a, FromDom (Union as)
84+ , SubList as (a ': as) )
85+ => FromDom (Union (a ': as)) where
8386 -- fromDom :: forall m. (DomParserMonad m) => m a
8487 fromDom = (liftUnion <$> (proxyFromDom (Proxy :: Proxy a)))
85− <|> (reUnion <$> (proxyFromDom (Proxy :: Proxy (Union as))))
88+ <|> (reUnion <$> (proxyFromDom (Proxy :: Proxy (Union as))))
8689
8790instance FromDom Element where
8891 fromDom = elementFromDom
@@ -127,6 +130,9 @@ fixedFromDom
127130 => DomParserT Identity m (Fixed a)
128131fixedFromDom = parseContent readContent
129132
133+scientificFromDom :: Monad m => DomParserT Identity m Scientific
134+scientificFromDom = parseContent readContent
135+
130136-- | Expects content to be y, yes, t, true or 1 for True value. n, no,
131137-- f, false or 0 for False value. Case is not significant, blank
132138-- characters are striped.
@@ -140,10 +146,11 @@ readBool t =
140146 lowt = T.toLower $ T.strip t
141147 tvals = ["y", "yes", "t", "true", "1"]
142148 fvals = ["n", "no", "f", "false", "0"]
143− in if | lowt `elem` tvals -> Right True
144− | lowt `elem` fvals -> Right False
145− | otherwise ->
146− Left $ "Could not read " <> t <> " as Bool"
149+ in if
150+ | lowt `elem` tvals -> Right True
151+ | lowt `elem` fvals -> Right False
152+ | otherwise ->
153+ Left $ "Could not read " <> t <> " as Bool"
147154
148155-- | Always successfully parses any DOM to @()@
149156unitFromDom :: (Monad m) => DomParserT Identity m ()
src/Text/XML/DOM/Parser/Combinators.hs+6−5
@@ -60,11 +60,12 @@ traverseElems trav parser = do
6060 pd <- ask
6161 inner <- trav $ pd ^.. pdElements . folded
6262 for inner $ \(subpath, e) -> do
63− let newpd = ParserData
64− { _pdElements = Identity e
65− , _pdPath = pd ^. pdPath <> subpath }
66− magnify (to $ const newpd) parser -- type of reader is changed, so
67− -- local does not work
63+ let
64+ newpd = ParserData
65+ { _pdElements = Identity e
66+ , _pdPath = pd ^. pdPath <> subpath }
67+ -- type of reader has been changed, local won't work here
68+ magnify (to $ const newpd) parser
6869
6970-- | Takes function filtering
7071inFilteredTrav
test/Main.hs+4−4
@@ -156,7 +156,7 @@ specParser
156156 :: String -- ^ Name of spec
157157 -> Document -- ^ Document to parse
158158 -> (a -> Maybe String) -- ^ Value checker, Nothing if all ok
159− -> DomParser Identity a -- ^ Parser itself
159+ -> DomParser Identity a -- ^ Parser itself
160160 -> Spec
161161specParser name doc check parser = it name $ do
162162 result <- either throwIO return $ runDomParser doc parser
@@ -166,9 +166,9 @@ specParser name doc check parser = it name $ do
166166
167167specParserEq
168168 :: (Eq a, Show a)
169− => String -- ^ Name of spec
170− -> Document -- ^ Document to parse
171− -> a -- ^ Value parser should return
169+ => String -- ^ Name of spec
170+ -> Document -- ^ Document to parse
171+ -> a -- ^ Value parser should return
172172 -> DomParser Identity a -- ^ Parser itself
173173 -> Spec
174174specParserEq name doc a parser = specParser name doc check parser