git.iko.soy/typeable/dom-parser
on master help sign in
Merge pull request #2 from typeable/scientific
9289a1cDenis Redozubov
dom-parser.cabal+2−1
compare with master
unifiedsplit
@@ -47,7 +47,8 @@ library
47 , containers
47 , containers
48 , lens
48 , lens
49 , mtl
49 , mtl
50− , open-union
50+ , open-union >= 0.2
51+ , scientific
51 , semigroups
52 , semigroups
52 , text
53 , text
53 , transformers
54 , transformers
src/Text/XML/DOM/Parser/Class.hs+15−8
@@ -17,6 +17,7 @@ module Text.XML.DOM.Parser.Class
17 , readBool
17 , readBool
18 , unitFromDom
18 , unitFromDom
19 , voidFromDom
19 , voidFromDom
20+ , scientificFromDom
20 ) where
21 ) where
21
22
22import Control.Applicative
23import Control.Applicative
@@ -24,6 +25,7 @@ import Control.Lens
24import Data.Fixed
25import Data.Fixed
25import Data.Monoid
26import Data.Monoid
26import Data.OpenUnion
27import Data.OpenUnion
28+import Data.Scientific
27import Data.Text (Text)
29import Data.Text (Text)
28import qualified Data.Text as T
30import qualified Data.Text as T
29import Data.Typeable
31import Data.Typeable
@@ -77,12 +79,13 @@ instance FromDom Bool where
77instance FromDom (Union '[]) where
79instance FromDom (Union '[]) where
78 fromDom = empty
80 fromDom = empty
79
81
82+instance
80−instance ( Typeable a, FromDom a, FromDom (Union as)
83+ ( Typeable a, FromDom a, FromDom (Union as)
81− , SubList as (a ': as) )
84+ , SubList as (a ': as) )
82− => FromDom (Union (a ': as)) where
85+ => FromDom (Union (a ': as)) where
83 -- fromDom :: forall m. (DomParserMonad m) => m a
86 -- fromDom :: forall m. (DomParserMonad m) => m a
84 fromDom = (liftUnion <$> (proxyFromDom (Proxy :: Proxy a)))
87 fromDom = (liftUnion <$> (proxyFromDom (Proxy :: Proxy a)))
85− <|> (reUnion <$> (proxyFromDom (Proxy :: Proxy (Union as))))
88+ <|> (reUnion <$> (proxyFromDom (Proxy :: Proxy (Union as))))
86
89
87instance FromDom Element where
90instance FromDom Element where
88 fromDom = elementFromDom
91 fromDom = elementFromDom
@@ -127,6 +130,9 @@ fixedFromDom
127 => DomParserT Identity m (Fixed a)
130 => DomParserT Identity m (Fixed a)
128fixedFromDom = parseContent readContent
131fixedFromDom = parseContent readContent
129
132
133+scientificFromDom :: Monad m => DomParserT Identity m Scientific
134+scientificFromDom = parseContent readContent
135+
130-- | Expects content to be y, yes, t, true or 1 for True value. n, no,
136-- | Expects content to be y, yes, t, true or 1 for True value. n, no,
131-- f, false or 0 for False value. Case is not significant, blank
137-- f, false or 0 for False value. Case is not significant, blank
132-- characters are striped.
138-- characters are striped.
@@ -140,10 +146,11 @@ readBool t =
140 lowt = T.toLower $ T.strip t
146 lowt = T.toLower $ T.strip t
141 tvals = ["y", "yes", "t", "true", "1"]
147 tvals = ["y", "yes", "t", "true", "1"]
142 fvals = ["n", "no", "f", "false", "0"]
148 fvals = ["n", "no", "f", "false", "0"]
149+ in if
143− in if | lowt `elem` tvals -> Right True
150+ | lowt `elem` tvals -> Right True
144− | lowt `elem` fvals -> Right False
151+ | lowt `elem` fvals -> Right False
145− | otherwise ->
152+ | otherwise ->
146− Left $ "Could not read " <> t <> " as Bool"
153+ Left $ "Could not read " <> t <> " as Bool"
147
154
148-- | Always successfully parses any DOM to @()@
155-- | Always successfully parses any DOM to @()@
149unitFromDom :: (Monad m) => DomParserT Identity m ()
156unitFromDom :: (Monad m) => DomParserT Identity m ()
src/Text/XML/DOM/Parser/Combinators.hs+6−5
@@ -60,11 +60,12 @@ traverseElems trav parser = do
60 pd <- ask
60 pd <- ask
61 inner <- trav $ pd ^.. pdElements . folded
61 inner <- trav $ pd ^.. pdElements . folded
62 for inner $ \(subpath, e) -> do
62 for inner $ \(subpath, e) -> do
63+ let
63− let newpd = ParserData
64+ newpd = ParserData
64− { _pdElements = Identity e
65+ { _pdElements = Identity e
65− , _pdPath = pd ^. pdPath <> subpath }
66+ , _pdPath = pd ^. pdPath <> subpath }
67+ -- type of reader has been changed, local won't work here
66− magnify (to $ const newpd) parser -- type of reader is changed, so
68+ magnify (to $ const newpd) parser
67− -- local does not work
68
69
69-- | Takes function filtering
70-- | Takes function filtering
70inFilteredTrav
71inFilteredTrav
test/Main.hs+4−4
@@ -156,7 +156,7 @@ specParser
156 :: String -- ^ Name of spec
156 :: String -- ^ Name of spec
157 -> Document -- ^ Document to parse
157 -> Document -- ^ Document to parse
158 -> (a -> Maybe String) -- ^ Value checker, Nothing if all ok
158 -> (a -> Maybe String) -- ^ Value checker, Nothing if all ok
159− -> DomParser Identity a -- ^ Parser itself
159+ -> DomParser Identity a -- ^ Parser itself
160 -> Spec
160 -> Spec
161specParser name doc check parser = it name $ do
161specParser name doc check parser = it name $ do
162 result <- either throwIO return $ runDomParser doc parser
162 result <- either throwIO return $ runDomParser doc parser
@@ -166,9 +166,9 @@ specParser name doc check parser = it name $ do
166
166
167specParserEq
167specParserEq
168 :: (Eq a, Show a)
168 :: (Eq a, Show a)
169− => String -- ^ Name of spec
169+ => String -- ^ Name of spec
170− -> Document -- ^ Document to parse
170+ -> Document -- ^ Document to parse
171− -> a -- ^ Value parser should return
171+ -> a -- ^ Value parser should return
172 -> DomParser Identity a -- ^ Parser itself
172 -> DomParser Identity a -- ^ Parser itself
173 -> Spec
173 -> Spec
174specParserEq name doc a parser = specParser name doc check parser
174specParserEq name doc a parser = specParser name doc check parser