6849254 · typeable/dom-parser

git.iko.soy/typeable/dom-parser

on master help sign in

Make DomPath newtype

6849254Alexey Uimanov10 years ago

src/Text/XML/DOM/Parser/Combinators.hs+6−6

compare with master

unifiedsplit

@@ -91,7 +91,7 @@ inElemTrav

91 -> DomParserT g m (f a)

92inElemTrav n = inFilteredTrav deeper

93 where

94− deeper = ([n],) . toListOf (folded . nodes . folded . _Element . ell n)

94+ deeper = (DomPath [n],) . toListOf (folded . nodes . folded . _Element . ell n)

96-- | Runs parser inside first children element with given name

97inElem

@@ -149,7 +149,7 @@ in given path.

149divePath

150 :: forall m g a

151 . (Monad m, Foldable g)

152− => [Text]

152+ => DomPath

153 -> DomParserT [] m a

154 -> DomParserT g m a

155divePath path = magnify $ to modElems

@@ -158,7 +158,7 @@ divePath path = magnify $ to modElems

158 = over pdElements (toListOf $ folded . diver)

159 . over pdPath (<> path)

160 diver :: Fold Element Element

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

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

162 toDive n = nodes . folded . _Element . ell n

163

164diveElem

@@ -166,7 +166,7 @@ diveElem

166 => Text

167 -> DomParserT [] m a

168 -> DomParserT g m a

169−diveElem p = divePath [p]

169+diveElem p = divePath $ DomPath [p]

170

171-- | Ignore arbitrary current element if it conforms to predicate.

172ignoreElem

@@ -225,8 +225,8 @@ checkCurrentName n = do

225 cn <- getCurrentName

226 unless (cn == n) $ do

227 p <- view pdPath

228− let pinit = if null p then [] else init p

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

229− throwError $ ParserErrors [PENotFound $ pinit ++ [n]]

229+ throwError $ ParserErrors [PENotFound $ DomPath $ pinit ++ [n]]

230 return ()

231

232-- | Get current content. If current element contains no content or

src/Text/XML/DOM/Parser/Types.hs+18−17

@@ -1,6 +1,6 @@

1module Text.XML.DOM.Parser.Types

2 ( -- * Parser internals

3− DomPath

3+ DomPath(..)

4 , ParserError(..)

5 , pePath

6 , peDetails

@@ -21,19 +21,20 @@ module Text.XML.DOM.Parser.Types

21 , throwWrongFormat

22 ) where

24−import Control.Exception

24+import Control.Exception

25−import Control.Lens

25+import Control.Lens

26−import Control.Monad.Except

26+import Control.Monad.Except

27−import Control.Monad.Reader

27+import Control.Monad.Reader

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

29−import qualified Data.List.NonEmpty as NE

28+import Data.List.NonEmpty as NE

30−import Data.Maybe

29+import Data.Maybe

31−import Data.Text (Text)

30+import Data.Text (Text)

32−import GHC.Generics (Generic)

31+import GHC.Generics (Generic)

33−import Text.XML

32+import Text.XML

34−import Text.XML.Lens

33+import Text.XML.Lens

35−

34+

36−type DomPath = [Text]

35+newtype DomPath = DomPath

36+ { unDomPath :: [Text]

37+ } deriving (Eq, Ord, Show, Read, Monoid)

38-- | DOM parser error description.

39-- | DOM parser error description.

39data ParserError

40data ParserError

@@ -121,7 +122,7 @@ runDomParserT

121runDomParserT doc par =

122runDomParserT doc par =

122 let pd = ParserData

123 let pd = ParserData

123 { _pdElements = doc ^. root . to pure

124 { _pdElements = doc ^. root . to pure

124− , _pdPath = [doc ^. root . localName]

125+ , _pdPath = DomPath [doc ^. root . localName]

125 }

126 }

126 in runExceptT $ runReaderT par pd

127 in runExceptT $ runReaderT par pd

127

128

@@ -152,11 +153,11 @@ instance DomTraversable NonEmpty where

152

153

153throwParserError

154throwParserError

154 :: (MonadError ParserErrors m, MonadReader (ParserData f) m)

155 :: (MonadError ParserErrors m, MonadReader (ParserData f) m)

155− => ([Text] -> ParserError)

156+ => (DomPath -> ParserError)

156 -> m a

157 -> m a

157throwParserError mkerr = do

158throwParserError mkerr = do

158 path <- view pdPath

159 path <- view pdPath

159− throwError $ ParserErrors [mkerr path]

160+ throwError $ ParserErrors $ [mkerr path]

160

161

161-- | Throw 'PEWrongFormat' as very common case

162-- | Throw 'PEWrongFormat' as very common case

162throwWrongFormat

163throwWrongFormat

test/Main.hs+5−5

@@ -193,7 +193,7 @@ specParserFailedPath

193 :: (Show a)

194 => String -- ^ Name of spec

195 -> Document

196− -> [Text] -- ^ Expteced path in error

196+ -> DomPath -- ^ Expteced path in error

197 -> DomParser Identity a

198 -> Spec

199specParserFailedPath name doc path parser = it name $ example $ do

@@ -226,7 +226,7 @@ combinationsSpec = do

226 describe "deep" $ do

227 let parser = inElem "a" $ inElem "b" textFromDom

228 specParserFailedPath "docDeepMultiple2" docDeepMultiple2

229− ["root", "a", "b"] parser

229+ (DomPath ["root", "a", "b"]) parser

230 -- should fail here because first tag "a" does not contains

231 -- tag "b" which is expected by parser @inElem "b"@

232

@@ -276,7 +276,7 @@ combinationsSpec = do

276 specParserEq "docDeepMultiple1" docDeepMultiple1 "content1" parser

277 specParserEq "docDeepMultiple2" docDeepMultiple2 "content1" parser

278 describe "fails" $ do

279− specParserFailedPath "docSimple" docSimple ["root", "a", "b"] parser

279+ specParserFailedPath "docSimple" docSimple (DomPath ["root", "a", "b"]) parser

280 describe "multiple elements" $ do

281 let

282 parser = diveElem "a" $ inElemAll "b" textFromDom

@@ -311,9 +311,9 @@ combinationsSpec = do

311 inElem "a" $ do

312 checkCurrentName "a"

313 describe "fails" $ do

314− specParserFailedPath "root element" docSimple ["toor"] $ do

314+ specParserFailedPath "root element" docSimple (DomPath ["toor"]) $ do

315 checkCurrentName "toor"

316− specParserFailedPath "inner element" docSimple ["root", "b"] $ do

316+ specParserFailedPath "inner element" docSimple (DomPath ["root", "b"]) $ do

317 inElem "a" $ checkCurrentName "b"

318

319contentSpec :: Spec