7b06cfc · typeable/dom-parser

git.iko.soy/typeable/dom-parser

WIP: refactoring

commit7b06cfc23b7e57f1f32f48d80ed262ed8a6b1284 authorAlexey Uimanov <s9gf4ult@gmail.com> dateWed 4 Jan 2017, 00:00 (10 years ago) parent0016d46

6 files changed+125−104

compare with master

unifiedsplit

dom-parser.cabal+3−1 src/Text/XML/DOM/Parser.hs+7−3 src/Text/XML/DOM/Parser/Combinators.hs+21−48 src/Text/XML/DOM/Parser/Common.hs+54 src/Text/XML/DOM/Parser/FromAttribute.hs+38 src/Text/XML/DOM/Parser/Class.hs → src/Text/XML/DOM/Parser/FromDom.hs+2−52

dom-parser.cabal+3−1

@@ -57,8 +57,10 @@ library

5757 , xml-conduit

5858 , xml-lens

5959 exposed-modules: Text.XML.DOM.Parser

60− , Text.XML.DOM.Parser.Class

6160 , Text.XML.DOM.Parser.Combinators

61+ , Text.XML.DOM.Parser.Common

62+ , Text.XML.DOM.Parser.FromAttribute

63+ , Text.XML.DOM.Parser.FromDom

6264 , Text.XML.DOM.Parser.Types

6365

6466test-suite test

src/Text/XML/DOM/Parser.hs+7−3

@@ -1,9 +1,13 @@

11module Text.XML.DOM.Parser

2− ( module Text.XML.DOM.Parser.Class

3− , module Text.XML.DOM.Parser.Combinators

2+ ( module Text.XML.DOM.Parser.Combinators

3+ , module Text.XML.DOM.Parser.Common

4+ , module Text.XML.DOM.Parser.FromAttribute

5+ , module Text.XML.DOM.Parser.FromDom

46 , module Text.XML.DOM.Parser.Types

57 ) where

7−import Text.XML.DOM.Parser.Class

89import Text.XML.DOM.Parser.Combinators

10+import Text.XML.DOM.Parser.Common

11+import Text.XML.DOM.Parser.FromAttribute

12+import Text.XML.DOM.Parser.FromDom

913import Text.XML.DOM.Parser.Types

src/Text/XML/DOM/Parser/Combinators.hs+21−48

@@ -24,27 +24,25 @@ module Text.XML.DOM.Parser.Combinators

2424 , checkCurrentName

2525 -- * Parsing element's content

2626 , parseContent

27− , readContent

28− , maybeReadContent

2927 -- * Parsing attributes

3028 , parseAttribute

3129 , parseAttributeMaybe

3230 ) where

3331

34−import Control.Lens

35−import Control.Monad.Except

36−import Control.Monad.Reader

37−import Data.List.NonEmpty (NonEmpty(..))

38−import qualified Data.Map.Strict as M

39−import Data.Monoid

40−import Data.Text (Text)

41−import qualified Data.Text as T

42−import Data.Traversable

43−import Data.Typeable

44−import Text.Read

45−import Text.XML

46−import Text.XML.DOM.Parser.Types

47−import Text.XML.Lens

32+import Control.Lens

33+import Control.Monad.Except

34+import Control.Monad.Reader

35+import Data.Foldable as F

36+import Data.List as L

37+import Data.List.NonEmpty (NonEmpty(..))

38+import Data.Map.Strict as M

39+import Data.Monoid

40+import Data.Text as T

41+import Data.Traversable

42+import Text.XML

43+import Text.XML.DOM.Parser.Common

44+import Text.XML.DOM.Parser.Types

45+import Text.XML.Lens

4846

4947

5048-- | Generic function to traverse arbitrary inner cursors.

@@ -156,9 +154,9 @@ divePath path = magnify $ to modElems

156154 where

157155 modElems

158156 = over pdElements (toListOf $ folded . diver)

159− . over pdPath (<> DomPath (map _nmShow path))

157+ . over pdPath (<> DomPath (L.map _nmShow path))

160158 diver :: Fold Element Element

161− diver = foldr (.) id $ map toDive path

159+ diver = F.foldr (.) id $ L.map toDive path

162160 toDive n = nodes . folded . _Element . elMatchName n

163161

164162diveElem

@@ -190,7 +188,7 @@ ignoreEmpty

190188 -> DomParserT Identity m (Maybe a)

191189ignoreEmpty = ignoreElem test

192190 where

193− test e = null $ e ^. nodes

191+ test e = L.null $ e ^. nodes

194192

195193-- | If all current elements contains blank content, or contains nothing at all

196194-- , then returns Nothing, else runs parser.

@@ -204,7 +202,7 @@ ignoreBlank = ignoreElem test

204202 let

205203 elems = e ^.. nodes . folded . _Element

206204 cont = mconcat $ e ^.. nodes . folded . _Content

207− in if | not $ null elems -> False

205+ in if | not $ L.null elems -> False

208206 | T.null $ T.strip cont -> True

209207 | otherwise -> False

210208

@@ -225,7 +223,7 @@ checkCurrentName n = do

225223 cn <- getCurrentName

226224 unless ((n ^. nmMatch) cn) $ do

227225 p <- view pdPath

228− let pinit = if null (unDomPath p) then [] else init $ unDomPath p

226+ let pinit = if L.null (unDomPath p) then [] else L.init $ unDomPath p

229227 throwError $ ParserErrors [PENotFound $ DomPath $ pinit ++ [_nmShow n]]

230228 return ()

231229

@@ -242,8 +240,8 @@ getCurrentContent = do

242240 conts :: [Text]

243241 conts = nds ^.. folded . _Content

244242 return $ if

245− | not $ null els -> Nothing

246− | null conts -> Nothing

243+ | not $ L.null els -> Nothing

244+ | L.null conts -> Nothing

247245 | otherwise -> Just $ mconcat conts

248246

249247-- | Parses content inside current tag. It expects current element set

@@ -260,31 +258,6 @@ parseContent parse = getCurrentContent >>= \case

260258 Left e -> throwParserError $ PEWrongFormat e

261259 Right a -> return a

262260

263−-- | If reader returns 'Nothing' then resulting function returns 'Left

264−-- "error message"'

265−--

266−-- @since 1.0.0

267−maybeReadContent

268− :: forall a

269− . (Typeable a)

270− => (Text -> Maybe a)

271− -- ^ Content or attribute reader

272− -> Text

273− -- ^ Content or attribute value

274− -> Either Text a

275−maybeReadContent f t = maybe (Left msg) Right $ f t

276− where

277− msg = "Not readable " <> n <> ": " <> t

278− n = T.pack $ show $ typeRep (Proxy :: Proxy a)

279−

280−-- | Tries to read given text to value using 'Read'. Useful to use

281−-- with 'parseContent' and 'parseAttribute'

282−readContent

283− :: (Read a, Typeable a)

284− => Text

285− -> Either Text a

286−readContent = maybeReadContent $ readMaybe . T.unpack . T.strip

287−

288261-- | Retuns map of attributes of current element

289262--

290263-- @since 1.0.0

src/Text/XML/DOM/Parser/Common.hsnew file+54

@@ -0,0 +1,54 @@

1+module Text.XML.DOM.Parser.Common where

3+import Data.Monoid

4+import Data.Text as T

5+import Data.Typeable

6+import Text.Read

9+-- | @since 1.0.0

10+readBool :: Text -> Either Text Bool

11+readBool t =

12+ let

13+ lowt = T.toLower $ T.strip t

14+ tvals = ["y", "yes", "t", "true", "1"]

15+ fvals = ["n", "no", "f", "false", "0"]

16+ in if

17+ | lowt `elem` tvals -> Right True

18+ | lowt `elem` fvals -> Right False

19+ | otherwise ->

20+ Left $ "Could not read " <> t <> " as Bool"

21+

22+-- | Expects text to be single character

23+--

24+-- @since 1.0.0

25+readChar :: Text -> Either Text Char

26+readChar t = case T.unpack $ T.strip t of

27+ [c] -> Right c

28+ _ -> Left "Should have exactly one non-blank character"

29+

30+-- | If reader returns 'Nothing' then resulting function returns 'Left

31+-- "error message"'

32+--

33+-- @since 1.0.0

34+maybeReadContent

35+ :: forall a

36+ . (Typeable a)

37+ => (Text -> Maybe a)

38+ -- ^ Content or attribute reader

39+ -> Text

40+ -- ^ Content or attribute value

41+ -> Either Text a

42+maybeReadContent f t = maybe (Left msg) Right $ f t

43+ where

44+ msg = "Not readable " <> n <> ": " <> t

45+ n = T.pack $ show $ typeRep (Proxy :: Proxy a)

46+

47+

48+-- | Tries to read given text to value using 'Read'. Useful to use

49+-- with 'parseContent' and 'parseAttribute'

50+readContent

51+ :: (Read a, Typeable a)

52+ => Text

53+ -> Either Text a

54+readContent = maybeReadContent $ readMaybe . T.unpack . T.strip

src/Text/XML/DOM/Parser/FromAttribute.hsnew file+38

@@ -0,0 +1,38 @@

1+module Text.XML.DOM.Parser.FromAttribute

2+ ( -- * FromAttribute

3+ FromAttribute(..)

4+ ) where

6+import Data.Fixed

7+import Data.Scientific

8+import Data.Text as T

9+import Data.Typeable

10+import Text.XML.DOM.Parser.Common

11+

12+class FromAttribute a where

13+ fromAttribute

14+ :: Text

15+ -- ^ Attribute contents to parse

16+ -> Either Text a

17+ -- ^ Either error message or result

18+

19+instance FromAttribute () where

20+ fromAttribute _ = Right ()

21+

22+instance FromAttribute Text where

23+ fromAttribute = Right

24+

25+instance FromAttribute Char where

26+ fromAttribute = readChar

27+

28+instance FromAttribute Int where

29+ fromAttribute = readContent

30+

31+instance FromAttribute Integer where

32+ fromAttribute = readContent

33+

34+instance (Typeable a, HasResolution a) => FromAttribute (Fixed a) where

35+ fromAttribute = readContent

36+

37+instance FromAttribute Scientific where

38+ fromAttribute = readContent

src/Text/XML/DOM/Parser/Class.hs → src/Text/XML/DOM/Parser/FromDom.hsrenamed+2−52

@@ -1,4 +1,4 @@

1−module Text.XML.DOM.Parser.Class

1+module Text.XML.DOM.Parser.FromDom

22 ( -- * FromDom

33 FromDom(..)

44 , proxyFromDom

@@ -18,8 +18,6 @@ module Text.XML.DOM.Parser.Class

1818 , unitFromDom

1919 , voidFromDom

2020 , scientificFromDom

21− -- * FromAttribute

22− , FromAttribute(..)

2321 ) where

2422

2523import Control.Applicative

@@ -33,6 +31,7 @@ import Data.Typeable

3331import Data.Void

3432import Text.XML

3533import Text.XML.DOM.Parser.Combinators

34+import Text.XML.DOM.Parser.Common

3635import Text.XML.DOM.Parser.Types

3736import TypeFun.Data.List hiding (Union)

3837

@@ -112,14 +111,6 @@ stringFromDom = parseContent $ Right . T.unpack

112111charFromDom :: (Monad m) => DomParserT Identity m Char

113112charFromDom = parseContent readChar

114113

115−-- | Expects text to be single character

116−--

117−-- @since 1.0.0

118−readChar :: Text -> Either Text Char

119−readChar t = case T.unpack $ T.strip t of

120− [c] -> Right c

121− _ -> Left "Should have exactly one non-blank character"

122−

123114intFromDom :: (Monad m) => DomParserT Identity m Int

124115intFromDom = parseContent readContent

125116

@@ -143,19 +134,6 @@ scientificFromDom = parseContent readContent

143134boolFromDom :: (Monad m) => DomParserT Identity m Bool

144135boolFromDom = parseContent readBool

145136

146−-- | @since 1.0.0

147−readBool :: Text -> Either Text Bool

148−readBool t =

149− let

150− lowt = T.toLower $ T.strip t

151− tvals = ["y", "yes", "t", "true", "1"]

152− fvals = ["n", "no", "f", "false", "0"]

153− in if

154− | lowt `elem` tvals -> Right True

155− | lowt `elem` fvals -> Right False

156− | otherwise ->

157− Left $ "Could not read " <> t <> " as Bool"

158−

159137-- | Always successfully parses any DOM to @()@

160138unitFromDom :: (Monad m) => DomParserT Identity m ()

161139unitFromDom = pure ()

@@ -163,31 +141,3 @@ unitFromDom = pure ()

163141-- | Never parses successfully. It is just 'mzero'

164142voidFromDom :: (Monad m) => DomParserT Identity m Void

165143voidFromDom = empty

166−

167−class FromAttribute a where

168− fromAttribute

169− :: Text

170− -- ^ Attribute contents to parse

171− -> Either Text a

172− -- ^ Either error message or result

173−

174−instance FromAttribute () where

175− fromAttribute _ = Right ()

176−

177−instance FromAttribute Text where

178− fromAttribute = Right

179−

180−instance FromAttribute Char where

181− fromAttribute = readChar

182−

183−instance FromAttribute Int where

184− fromAttribute = readContent

185−

186−instance FromAttribute Integer where

187− fromAttribute = readContent

188−

189−instance (Typeable a, HasResolution a) => FromAttribute (Fixed a) where

190− fromAttribute = readContent

191−

192−instance FromAttribute Scientific where

193− fromAttribute = readContent