git.iko.soy/typeable/dom-parser
on master help sign in
Add explicit method for FromAttribute
e0b34d0Alexey Uimanov
src/Text/XML/DOM/Parser/FromAttribute.hs+77−7
compare with master
unifiedsplit
@@ -1,12 +1,27 @@
1module Text.XML.DOM.Parser.FromAttribute
1module Text.XML.DOM.Parser.FromAttribute
2 ( -- * FromAttribute
2 ( -- * FromAttribute
3 FromAttribute(..)
3 FromAttribute(..)
4+ , proxyFromAttribute
5+ -- * Explicit methods
6+ , textFromAttribute
7+ , stringFromAttribute
8+ , charFromAttribute
9+ , intFromAttribute
10+ , integerFromAttribute
11+ , doubleFromAttribute
12+ , fixedFromAttribute
13+ , boolFromAttribute
14+ , unitFromAttribute
15+ , voidFromAttribute
16+ , scientificFromAttribute
17+
4 ) where
18 ) where
5
19
6import Data.Fixed
20import Data.Fixed
7import Data.Scientific
21import Data.Scientific
8import Data.Text as T
22import Data.Text as T
9import Data.Typeable
23import Data.Typeable
24+import Data.Void
10import Text.XML.DOM.Parser.Common
25import Text.XML.DOM.Parser.Common
11
26
12class FromAttribute a where
27class FromAttribute a where
@@ -16,23 +31,78 @@ class FromAttribute a where
16 -> Either Text a
31 -> Either Text a
17 -- ^ Either error message or result
32 -- ^ Either error message or result
18
33
34+proxyFromAttribute
35+ :: FromAttribute a
36+ => Proxy a
37+ -> Text
38+ -> Either Text a
39+proxyFromAttribute _ = fromAttribute
40+
19instance FromAttribute () where
41instance FromAttribute () where
20− fromAttribute _ = Right ()
42+ fromAttribute = unitFromAttribute
43+
44+unitFromAttribute :: Text -> Either Text ()
45+unitFromAttribute _ = Right ()
46+
47+instance FromAttribute Void where
48+ fromAttribute = voidFromAttribute
49+
50+voidFromAttribute :: Text -> Either Text Void
51+voidFromAttribute _ = Left "Void has been parsed"
21
52
22instance FromAttribute Text where
53instance FromAttribute Text where
23− fromAttribute = Right
54+ fromAttribute = textFromAttribute
55+
56+textFromAttribute :: Text -> Either Text Text
57+textFromAttribute = Right
58+
59+instance FromAttribute String where
60+ fromAttribute = stringFromAttribute
61+
62+stringFromAttribute :: Text -> Either Text String
63+stringFromAttribute = Right . T.unpack
24
64
25instance FromAttribute Char where
65instance FromAttribute Char where
26− fromAttribute = readChar
66+ fromAttribute = charFromAttribute
67+
68+charFromAttribute :: Text -> Either Text Char
69+charFromAttribute = readChar
27
70
28instance FromAttribute Int where
71instance FromAttribute Int where
29− fromAttribute = readContent
72+ fromAttribute = intFromAttribute
73+
74+intFromAttribute :: Text -> Either Text Int
75+intFromAttribute = readContent
30
76
31instance FromAttribute Integer where
77instance FromAttribute Integer where
32− fromAttribute = readContent
78+ fromAttribute = integerFromAttribute
79+
80+integerFromAttribute :: Text -> Either Text Integer
81+integerFromAttribute = readContent
82+
83+instance FromAttribute Double where
84+ fromAttribute = doubleFromAttribute
85+
86+doubleFromAttribute :: Text -> Either Text Double
87+doubleFromAttribute = readContent
33
88
34instance (Typeable a, HasResolution a) => FromAttribute (Fixed a) where
89instance (Typeable a, HasResolution a) => FromAttribute (Fixed a) where
35− fromAttribute = readContent
90+ fromAttribute = fixedFromAttribute
91+
92+fixedFromAttribute
93+ :: (HasResolution a, Typeable a)
94+ => Text
95+ -> Either Text (Fixed a)
96+fixedFromAttribute = readContent
97+
98+instance FromAttribute Bool where
99+ fromAttribute = boolFromAttribute
100+
101+boolFromAttribute :: Text -> Either Text Bool
102+boolFromAttribute = readBool
36
103
37instance FromAttribute Scientific where
104instance FromAttribute Scientific where
38− fromAttribute = readContent
105+ fromAttribute = scientificFromAttribute
106+
107+scientificFromAttribute :: Text -> Either Text Scientific
108+scientificFromAttribute = readContent
src/Text/XML/DOM/Parser/FromDom.hs+44−46
@@ -8,13 +8,11 @@ module Text.XML.DOM.Parser.FromDom
8 , textFromDom
8 , textFromDom
9 , stringFromDom
9 , stringFromDom
10 , charFromDom
10 , charFromDom
11− , readChar
12 , intFromDom
11 , intFromDom
13 , integerFromDom
12 , integerFromDom
14 , doubleFromDom
13 , doubleFromDom
15 , fixedFromDom
14 , fixedFromDom
16 , boolFromDom
15 , boolFromDom
17− , readBool
18 , unitFromDom
16 , unitFromDom
19 , voidFromDom
17 , voidFromDom
20 , scientificFromDom
18 , scientificFromDom
@@ -47,36 +45,76 @@ class FromDom a where
47instance FromDom () where
45instance FromDom () where
48 fromDom = unitFromDom
46 fromDom = unitFromDom
49
47
48+-- | Always successfully parses any DOM to @()@
49+unitFromDom :: (Monad m) => DomParserT Identity m ()
50+unitFromDom = pure ()
51+
50instance FromDom Void where
52instance FromDom Void where
51 fromDom = voidFromDom
53 fromDom = voidFromDom
52
54
55+-- | Never parses successfully. It is just 'empty'
56+voidFromDom :: (Monad m) => DomParserT Identity m Void
57+voidFromDom = empty
58+
53instance FromDom Text where
59instance FromDom Text where
54 fromDom = textFromDom
60 fromDom = textFromDom
55
61
62+textFromDom :: (Monad m) => DomParserT Identity m Text
63+textFromDom = parseContent Right
64+
56instance FromDom String where
65instance FromDom String where
57 fromDom = stringFromDom
66 fromDom = stringFromDom
58
67
68+stringFromDom :: (Monad m) => DomParserT Identity m String
69+stringFromDom = parseContent $ Right . T.unpack
70+
59instance FromDom Char where
71instance FromDom Char where
60 fromDom = charFromDom
72 fromDom = charFromDom
61
73
74+charFromDom :: (Monad m) => DomParserT Identity m Char
75+charFromDom = parseContent readChar
76+
62instance FromDom Int where
77instance FromDom Int where
63 fromDom = intFromDom
78 fromDom = intFromDom
64
79
80+intFromDom :: (Monad m) => DomParserT Identity m Int
81+intFromDom = parseContent readContent
82+
65instance FromDom Integer where
83instance FromDom Integer where
66 fromDom = integerFromDom
84 fromDom = integerFromDom
67
85
86+integerFromDom :: (Monad m) => DomParserT Identity m Integer
87+integerFromDom = parseContent readContent
88+
68instance FromDom Double where
89instance FromDom Double where
69 fromDom = doubleFromDom
90 fromDom = doubleFromDom
70
91
92+doubleFromDom :: (Monad m) => DomParserT Identity m Double
93+doubleFromDom = parseContent readContent
94+
71instance (HasResolution a, Typeable a) => FromDom (Fixed a) where
95instance (HasResolution a, Typeable a) => FromDom (Fixed a) where
72 fromDom = fixedFromDom
96 fromDom = fixedFromDom
73
97
98+fixedFromDom
99+ :: (Monad m, Typeable a, HasResolution a)
100+ => DomParserT Identity m (Fixed a)
101+fixedFromDom = parseContent readContent
102+
74instance FromDom Scientific where
103instance FromDom Scientific where
75 fromDom = scientificFromDom
104 fromDom = scientificFromDom
76
105
106+scientificFromDom :: Monad m => DomParserT Identity m Scientific
107+scientificFromDom = parseContent readContent
108+
77instance FromDom Bool where
109instance FromDom Bool where
78 fromDom = boolFromDom
110 fromDom = boolFromDom
79
111
112+-- | Expects content to be y, yes, t, true or 1 for True Values n, no,
113+-- f, false or 0 for False. Case is not significant, blank characters
114+-- are striped.
115+boolFromDom :: (Monad m) => DomParserT Identity m Bool
116+boolFromDom = parseContent readBool
117+
80instance FromDom (Union '[]) where
118instance FromDom (Union '[]) where
81 fromDom = empty
119 fromDom = empty
82
120
@@ -88,54 +126,14 @@ instance
88 fromDom = (liftUnion <$> (proxyFromDom (Proxy :: Proxy a)))
126 fromDom = (liftUnion <$> (proxyFromDom (Proxy :: Proxy a)))
89 <|> (reUnion <$> (proxyFromDom (Proxy :: Proxy (Union as))))
127 <|> (reUnion <$> (proxyFromDom (Proxy :: Proxy (Union as))))
90
128
91−instance FromDom Element where
92− fromDom = elementFromDom
93−
94−elementFromDom :: (Monad m) => DomParserT Identity m Element
95−elementFromDom = view $ pdElements . to runIdentity
96−
97unionFromDom
129unionFromDom
98 :: (Monad m, FromDom (Union as))
130 :: (Monad m, FromDom (Union as))
99 => proxy as
131 => proxy as
100 -> DomParserT Identity m (Union as)
132 -> DomParserT Identity m (Union as)
101unionFromDom _ = fromDom
133unionFromDom _ = fromDom
102
134
103−textFromDom :: (Monad m) => DomParserT Identity m Text
135+instance FromDom Element where
104−textFromDom = parseContent Right
136+ fromDom = elementFromDom
105−
106−stringFromDom :: (Monad m) => DomParserT Identity m String
107−stringFromDom = parseContent $ Right . T.unpack
108−
109−charFromDom :: (Monad m) => DomParserT Identity m Char
110−charFromDom = parseContent readChar
111−
112−intFromDom :: (Monad m) => DomParserT Identity m Int
113−intFromDom = parseContent readContent
114−
115−integerFromDom :: (Monad m) => DomParserT Identity m Integer
116−integerFromDom = parseContent readContent
117−
118−doubleFromDom :: (Monad m) => DomParserT Identity m Double
119−doubleFromDom = parseContent readContent
120−
121−fixedFromDom
122− :: (Monad m, Typeable a, HasResolution a)
123− => DomParserT Identity m (Fixed a)
124−fixedFromDom = parseContent readContent
125−
126−scientificFromDom :: Monad m => DomParserT Identity m Scientific
127−scientificFromDom = parseContent readContent
128−
129−-- | Expects content to be y, yes, t, true or 1 for True value. n, no,
130−-- f, false or 0 for False value. Case is not significant, blank
131−-- characters are striped.
132−boolFromDom :: (Monad m) => DomParserT Identity m Bool
133−boolFromDom = parseContent readBool
134−
135−-- | Always successfully parses any DOM to @()@
136−unitFromDom :: (Monad m) => DomParserT Identity m ()
137−unitFromDom = pure ()
138
137
139−-- | Never parses successfully. It is just 'mzero'
140−voidFromDom :: (Monad m) => DomParserT Identity m Void
138+elementFromDom :: (Monad m) => DomParserT Identity m Element
141−voidFromDom = empty
139+elementFromDom = view $ pdElements . to runIdentity