version 0.6.0.00.6.0.0

6 files changed, 118 insertions, 108 deletions

diff --git a/LICENSE b/LICENSE
index 9c20de0..51039cd 100644
--- a/LICENSE
+++ b/LICENSE
@@ -1,7 +1,7 @@
 DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE
 Version 2, December 2004
 
-Copyright (C) 2015 koral <koral at mailoo dot org>
+Copyright (C) 2016 koral <koral at mailoo dot org>
 
 Everyone is permitted to copy and distribute verbatim or modified
 copies of this license document, and changing it is allowed as long
diff --git a/Text/OPML/Conduit/Parse.hs b/Text/OPML/Conduit/Parse.hs
index 284e39f..5a6515d 100644..100755
--- a/Text/OPML/Conduit/Parse.hs
+++ b/Text/OPML/Conduit/Parse.hs
@@ -1,6 +1,7 @@
 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
 {-# LANGUAGE OverloadedLists    #-}
 {-# LANGUAGE OverloadedStrings  #-}
+{-# LANGUAGE RankNTypes         #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TemplateHaskell    #-}
 {-# LANGUAGE TupleSections      #-}
@@ -18,14 +19,14 @@ module Text.OPML.Conduit.Parse
   ) where
 
 -- {{{ Imports
-import           Control.Applicative
-import           Control.Foldl                as Fold
+import           Conduit                      hiding (throwM)
+
+import           Control.Applicative          hiding(many)
+import           Control.Exception.Safe       as Exception
 import           Control.Monad
-import           Control.Monad.Catch
+import           Control.Monad.Fix
 
 import           Data.CaseInsensitive         hiding (map)
-import           Data.Conduit.Parser
-import           Data.Conduit.Parser.XML
 import           Data.List.NonEmpty           (NonEmpty, nonEmpty)
 import           Data.Maybe
 import           Data.Monoid
@@ -48,8 +49,8 @@ import           Numeric
 import           Prelude                      hiding (last)
 
 import           Text.OPML.Types
-import           Text.Parser.Combinators
 import           Text.ParserCombinators.ReadP (readP_to_S)
+import           Text.XML.Stream.Parse
 
 import           URI.ByteString
 -- }}}
@@ -78,7 +79,7 @@ asURI t = either (throwM . InvalidURI) return . parseURI laxURIParserOptions $ e
 asVersion :: (MonadThrow m) => Text -> m Version
 asVersion v = case filter (onull . snd) . readP_to_S parseVersion $ unpack v of
   [(a, "")] -> return a
-  _ -> throwM $ InvalidVersion v
+  _         -> throwM $ InvalidVersion v
 
 asDecimal :: (MonadThrow m, Integral a) => Text -> m a
 asDecimal t = case filter (onull . snd) . readSigned readDec $ unpack t of
@@ -105,23 +106,28 @@ asNonNull = maybe (throwM MissingText) return . fromNullable
 asCategories :: Text -> [NonEmpty (NonNull Text)]
 asCategories = mapMaybe (nonEmpty . mapMaybe fromNullable . split (== '/')) . split (== ',')
 
-dateTag :: (MonadCatch m) => Name -> ConduitParser Event m UTCTime
-dateTag name = tagName name ignoreAttrs $ \_ -> content asTime
+dateTag :: (MonadThrow m) => Name -> ConduitM Event o m (Maybe UTCTime)
+dateTag name = tagIgnoreAttrs name $ content >>= asTime
 
-uriTag :: (MonadCatch m) => Name -> ConduitParser Event m URI
-uriTag name = tagName name ignoreAttrs $ \_ -> content asURI
+uriTag :: (MonadThrow m) => Name -> ConduitM Event o m (Maybe URI)
+uriTag name = tagIgnoreAttrs name $ content >>= asURI
 
-expansionStateTag :: (MonadCatch m, Integral a) => ConduitParser Event m [a]
-expansionStateTag = tagName "expansionState" ignoreAttrs $ \_ -> content asExpansionState
+expansionStateTag :: (MonadThrow m, Integral a) => ConduitM Event o m (Maybe [a])
+expansionStateTag = tagIgnoreAttrs "expansionState" $ content >>= asExpansionState
 
-textTag :: (MonadCatch m) => Name -> ConduitParser Event m Text
-textTag name = tagName name ignoreAttrs $ const textContent
+textTag :: (MonadThrow m) => Name -> ConduitM Event o m (Maybe Text)
+textTag name = tagIgnoreAttrs name content
 
-decimalTag :: (Integral a, MonadCatch m) => Name -> ConduitParser Event m a
-decimalTag name = tagName name ignoreAttrs $ const $ content asDecimal
+decimalTag :: (Integral a, MonadThrow m) => Name -> ConduitM Event o m (Maybe a)
+decimalTag name = tagIgnoreAttrs name $ content >>= asDecimal
 
-unknownTag :: (MonadCatch m) => ConduitParser Event m ()
-unknownTag = tagPredicate (const True) ignoreAttrs $ \_ -> return ()
+projectC :: Monad m => Fold a a' b b' -> Conduit a m b
+projectC prism = fix $ \recurse -> do
+  item <- await
+  case (item, item ^? (_Just . prism)) of
+    (_, Just a) -> yield a >> recurse
+    (Just _, _) -> recurse
+    _           -> return ()
 
 
 data HeadPiece = HeadCreated UTCTime
@@ -137,7 +143,6 @@ data HeadPiece = HeadCreated UTCTime
                | HeadWindowLeft Int
                | HeadWindowRight Int
                | HeadWindowTop Int
-               | HeadUnknown
 
 makeTraversals ''HeadPiece
 
@@ -145,76 +150,85 @@ makeTraversals ''HeadPiece
 -- | Parse the @\<head\>@ section.
 -- This function is more lenient than what the standard demands on the following points:
 --
--- - each sub-element may be repeated, in which case only the last occurrence is taken into account;
+-- - each sub-element may be repeated, in which case only the first occurrence is taken into account;
 -- - each unknown sub-element is ignored.
-parseOpmlHead :: (MonadCatch m) => ConduitParser Event m OpmlHead
-parseOpmlHead = named "OPML <head> section" $ tagName "head" ignoreAttrs $ \_ -> do
-  p <- many $ choice piece
-  return $ flip fold p $ OpmlHead
-    <$> handles _HeadTitle (lastDef mempty)
-    <*> handles _HeadCreated last
-    <*> handles _HeadModified last
-    <*> handles _HeadOwnerName (lastDef mempty)
-    <*> handles _HeadOwnerEmail (lastDef mempty)
-    <*> handles _HeadOwnerId last
-    <*> handles _HeadDocs last
-    <*> handles _HeadExpansionState Fold.mconcat
-    <*> handles _HeadVertScrollState last
-    <*> handles _HeadWindowBottom last
-    <*> handles _HeadWindowLeft last
-    <*> handles _HeadWindowRight last
-    <*> handles _HeadWindowTop last
-  where piece = [ HeadCreated <$> dateTag "dateCreated"
-                , HeadModified <$> dateTag "dateModified"
-                , HeadDocs <$> uriTag "docs"
-                , HeadExpansionState <$> expansionStateTag
-                , HeadOwnerEmail <$> textTag "ownerEmail"
-                , HeadOwnerId <$> uriTag "ownerId"
-                , HeadOwnerName <$> textTag "ownerName"
-                , HeadTitle <$> textTag "title"
-                , HeadVertScrollState <$> decimalTag "vertScrollState"
-                , HeadWindowBottom <$> decimalTag "windowBottom"
-                , HeadWindowLeft <$> decimalTag "windowLeft"
-                , HeadWindowRight <$> decimalTag "windowRight"
-                , HeadWindowTop <$> decimalTag "windowTop"
-                , HeadUnknown <$ unknownTag
-                ]
+parseOpmlHead :: (MonadCatch m) => ConduitM Event o m (Maybe OpmlHead)
+parseOpmlHead = tagIgnoreAttrs "head" $ (manyYield' (choose piece) <* many ignoreAllTreesContent) =$= zipConduit where
+  zipConduit = getZipConduit $ OpmlHead
+    <$> ZipConduit (projectC _HeadTitle =$= headDefC mempty)
+    <*> ZipConduit (projectC _HeadCreated =$= headC)
+    <*> ZipConduit (projectC _HeadModified =$= headC)
+    <*> ZipConduit (projectC _HeadOwnerName =$= headDefC mempty)
+    <*> ZipConduit (projectC _HeadOwnerEmail =$= headDefC mempty)
+    <*> ZipConduit (projectC _HeadOwnerId =$= headC)
+    <*> ZipConduit (projectC _HeadDocs =$= headC)
+    <*> ZipConduit (projectC _HeadExpansionState =$= concatC =$= sinkList)
+    <*> ZipConduit (projectC _HeadVertScrollState =$= headC)
+    <*> ZipConduit (projectC _HeadWindowBottom =$= headC)
+    <*> ZipConduit (projectC _HeadWindowLeft =$= headC)
+    <*> ZipConduit (projectC _HeadWindowRight =$= headC)
+    <*> ZipConduit (projectC _HeadWindowTop =$= headC)
+  piece = [ fmap HeadCreated <$> dateTag "dateCreated"
+          , fmap HeadModified <$> dateTag "dateModified"
+          , fmap HeadDocs <$> uriTag "docs"
+          , fmap HeadExpansionState <$> expansionStateTag
+          , fmap HeadOwnerEmail <$> textTag "ownerEmail"
+          , fmap HeadOwnerId <$> uriTag "ownerId"
+          , fmap HeadOwnerName <$> textTag "ownerName"
+          , fmap HeadTitle <$> textTag "title"
+          , fmap HeadVertScrollState <$> decimalTag "vertScrollState"
+          , fmap HeadWindowBottom <$> decimalTag "windowBottom"
+          , fmap HeadWindowLeft <$> decimalTag "windowLeft"
+          , fmap HeadWindowRight <$> decimalTag "windowRight"
+          , fmap HeadWindowTop <$> decimalTag "windowTop"
+          ]
 
 
 -- | Parse an @\<outline\>@ section.
 -- The value of type attributes are not case-sensitive, that is @type=\"LINK\"@ has the same meaning as @type="link"@.
-parseOpmlOutline :: (MonadCatch m) => ConduitParser Event m (Tree OpmlOutline)
-parseOpmlOutline = tagName "outline" attributes handler <?> "OPML <outline> section" where
+parseOpmlOutline :: (MonadCatch m) => ConduitM Event o m (Maybe (Tree OpmlOutline))
+parseOpmlOutline = tagName "outline" attributes handler where
   attributes = do
-    otype <- optional $ textAttr "type"
+    otype <- optional $ requireAttr "type"
     case mk <$> otype of
       Just "include" -> (,,,) otype <$> baseAttr <*> pure Nothing <*> (Just <$> linkAttr) <* ignoreAttrs
       Just "link" -> (,,,) otype <$> baseAttr <*> pure Nothing <*> (Just <$> linkAttr) <* ignoreAttrs
       Just "rss" -> (,,,) otype <$> baseAttr <*> (Just <$> subscriptionAttr) <*> pure Nothing <* ignoreAttrs
       _          -> (,,,) otype <$> baseAttr <*> pure Nothing <*> pure Nothing <* ignoreAttrs
-  baseAttr = (,,,,) <$> attr "text" asNonNull
-                    <*> optional (attr "isComment" asBool)
-                    <*> optional (attr "isBreakpoint" asBool)
-                    <*> optional (attr "created" asTime)
-                    <*> optional (attr "category" (Just . asCategories))
-  linkAttr = textAttr "url"
-  subscriptionAttr = (,,,,,) <$> attr "xmlUrl" asURI
-                             <*> optional (attr "htmlUrl" asURI)
-                             <*> optional (textAttr "description")
-                             <*> optional (textAttr "language")
-                             <*> optional (textAttr "title")
-                             <*> optional (textAttr "version")
+  baseAttr = (,,,,) <$> (requireAttr "text" >>= asNonNull)
+                    <*> optional (requireAttr "isComment" >>= asBool)
+                    <*> optional (requireAttr "isBreakpoint" >>= asBool)
+                    <*> optional (requireAttr "created" >>= asTime)
+                    <*> optional (asCategories <$> requireAttr "category")
+  linkAttr = requireAttr "url"
+  subscriptionAttr = (,,,,,) <$> (requireAttr "xmlUrl" >>= asURI)
+                             <*> optional (requireAttr "htmlUrl" >>= asURI)
+                             <*> optional (requireAttr "description")
+                             <*> optional (requireAttr "language")
+                             <*> optional (requireAttr "title")
+                             <*> optional (requireAttr "version")
   handler (_, b, Just s, _) = Node <$> (OpmlOutlineSubscription <$> baseHandler b <*> pure (subscriptionHandler s)) <*> pure []
   handler (_, b, _, Just l) = Node <$> (OpmlOutlineLink <$> baseHandler b <*> asURI l) <*> pure []
   handler (otype, b, _, _) = Node <$> (OpmlOutlineGeneric <$> baseHandler b <*> pure (fromMaybe mempty otype))
-                                  <*> many parseOpmlOutline
+                                  <*> (manyYield' parseOpmlOutline =$= sinkList)
   baseHandler (txt, comment, breakpoint, created, category) = return $ OutlineBase txt comment breakpoint created (fromMaybe mempty category)
   subscriptionHandler (uri, html, desc, lang, title, version) = OutlineSubscription uri html (fromMaybe mempty desc) (fromMaybe mempty lang) (fromMaybe mempty title) (fromMaybe mempty version)
 
+
+data OpmlDocPiece = DocHead OpmlHead | DocBody [Tree OpmlOutline]
+
+makeTraversals ''OpmlDocPiece
+
+
 -- | Parse the top-level @\<opml\>@ element.
-parseOpml :: (MonadCatch m) => ConduitParser Event m Opml
-parseOpml = tagName "opml" attributes handler <?> "<opml> section" where
-  attributes = attr "version" asVersion <* ignoreAttrs
-  handler version = Opml version
-                      <$> parseOpmlHead
-                      <*> tagName "body" ignoreAttrs (const $ many parseOpmlOutline) <?> "<body> section."
+parseOpml :: (MonadCatch m) => ConduitM Event o m (Maybe Opml)
+parseOpml = tagName "opml" attributes handler where
+  attributes = (requireAttr "version" >>= asVersion) <* ignoreAttrs
+  handler version = (manyYield' (choose piece) <* many ignoreAllTreesContent) =$= zipConduit version
+  zipConduit version = getZipConduit $ Opml version
+    <$> ZipConduit (projectC _DocHead =$= headDefC mkOpmlHead)
+    <*> ZipConduit (projectC _DocBody =$= headDefC mempty)
+  parseOpmlBody = tagIgnoreAttrs "body" $ manyYield' parseOpmlOutline =$= sinkList
+  piece = [ fmap DocHead <$> parseOpmlHead
+          , fmap DocBody <$> parseOpmlBody
+          ]
diff --git a/Text/OPML/Conduit/Render.hs b/Text/OPML/Conduit/Render.hs
index 0c6fd45..9786203 100644..100755
--- a/Text/OPML/Conduit/Render.hs
+++ b/Text/OPML/Conduit/Render.hs
@@ -17,6 +17,7 @@ import           Data.Conduit
 import           Data.List.NonEmpty     hiding (filter, map)
 import           Data.Monoid
 import           Data.NonNull
+import           Data.String
 import           Data.Text              (Text, intercalate, pack, toLower)
 import           Data.Text.Encoding
 import           Data.Time.Clock
@@ -28,7 +29,8 @@ import           Data.XML.Types
 
 import           Lens.Simple
 
-import           Prelude                hiding (foldr, lookup)
+import           Prelude                hiding (foldr, lookup, show)
+import qualified Prelude                (show)
 
 import           Text.OPML.Lens
 import           Text.OPML.Types
@@ -37,8 +39,8 @@ import           Text.XML.Stream.Render
 import           URI.ByteString
 -- }}}
 
-tshow :: (Show a) => a -> Text
-tshow = pack . show
+show :: (Show a, IsString t) => a -> t
+show = fromString . Prelude.show
 
 empty :: (Eq s, Monoid s) => s -> Bool
 empty t = t == mempty
@@ -54,7 +56,7 @@ formatCategories :: [NonEmpty (NonNull Text)] -> Maybe Text
 formatCategories = toMaybe . intercalate "," . map (intercalate "/" . toList . fmap toNullable)
 
 formatBool :: Bool -> Text
-formatBool = toLower . tshow
+formatBool = toLower . show
 
 formatURI :: URI -> Text
 formatURI = decodeUtf8 . serializeURIRef'
@@ -65,16 +67,16 @@ renderOpmlHead input = tag "head" mempty $ do
   forM_ (input^.opmlCreatedL)       $ tag "dateCreated" mempty . content . formatTime
   forM_ (input^.modifiedL)          $ tag "dateModified" mempty . content . formatTime
   forM_ (input^.docsL)              $ tag "docs" mempty . content . formatURI
-  unless (null es)                  $ tag "expansionState" mempty . content . intercalate "," $ tshow <$> es
+  unless (null es)                  $ tag "expansionState" mempty . content . intercalate "," $ show <$> es
   unless (empty email)              $ tag "ownerEmail" mempty $ content email
   forM_ (input^.ownerIdL)           $ tag "ownerId" mempty . content . formatURI
   unless (empty name)               $ tag "ownerName" mempty $ content name
   unless (empty title)              $ tag "title" mempty $ content title
-  forM_ (input^.vertScrollStateL)   $ tag "vertScrollState" mempty . content . tshow
-  forM_ (input^.windowBottomL)      $ tag "windowBottom" mempty . content . tshow
-  forM_ (input^.windowLeftL)        $ tag "windowLeft" mempty . content . tshow
-  forM_ (input^.windowRightL)       $ tag "windowRight" mempty . content . tshow
-  forM_ (input^.windowTopL)         $ tag "windowTop" mempty . content . tshow
+  forM_ (input^.vertScrollStateL)   $ tag "vertScrollState" mempty . content . show
+  forM_ (input^.windowBottomL)      $ tag "windowBottom" mempty . content . show
+  forM_ (input^.windowLeftL)        $ tag "windowLeft" mempty . content . show
+  forM_ (input^.windowRightL)       $ tag "windowRight" mempty . content . show
+  forM_ (input^.windowTopL)         $ tag "windowTop" mempty . content . show
   where es = input ^.. expansionStateL
         email = input ^. ownerEmailL
         name = input ^. ownerNameL
diff --git a/Text/OPML/Lens.hs b/Text/OPML/Lens.hs
index 5236e35..5236e35 100644..100755
--- a/Text/OPML/Lens.hs
+++ b/Text/OPML/Lens.hs
diff --git a/opml-conduit.cabal b/opml-conduit.cabal
index 277fe5b..ce27c7a 100644
--- a/opml-conduit.cabal
+++ b/opml-conduit.cabal
@@ -1,10 +1,10 @@
 name:                opml-conduit
-version:             0.5.0.1
+version:             0.6.0.0
 synopsis:            Streaming parser/renderer for the OPML 2.0 format.
 description:
     This library implements the OPML 2.0 standard (<http://dev.opml.org/spec2.html>) as a 'conduit' parser/renderer.
 homepage:            https://github.com/k0ral/opml-conduit
-license:             OtherLicense
+license:             PublicDomain
 license-file:        LICENSE
 author:              koral <koral@mailoo.org>
 maintainer:          koral <koral@mailoo.org>
@@ -34,21 +34,18 @@ library
       base >= 4.8 && < 5
     , case-insensitive
     , conduit
-    , conduit-parse
+    , conduit-combinators
     , containers
-    , exceptions
-    , foldl
+    , safe-exceptions
     , lens-simple
     , monoid-subclasses
     , mono-traversable
-    , parsers
     , semigroups
     , text
     , time >= 1.5
     , timerep >= 2.0.0
     , uri-bytestring >= 0.2
     , xml-conduit >= 1.3
-    , xml-conduit-parse >= 0.2.0.0
     , xml-types
   default-language: Haskell2010
   ghc-options: -Wall -fno-warn-unused-do-bind
@@ -65,10 +62,8 @@ test-suite tests
     , bytestring
     , conduit
     , conduit-combinators
-    , conduit-parse
     , containers
     , data-default
-    , exceptions
     , hlint
     , lens-simple
     , mono-traversable
@@ -85,6 +80,6 @@ test-suite tests
     , text
     , time >= 1.5
     , uri-bytestring >= 0.1.9
-    , xml-conduit-parse
+    , xml-conduit >= 1.3
   default-language: Haskell2010
   ghc-options: -Wall -fno-warn-orphans
diff --git a/test/Main.hs b/test/Main.hs
index fbd0ed4..b67f924 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -1,15 +1,12 @@
 {-# LANGUAGE OverloadedLists   #-}
 {-# LANGUAGE OverloadedStrings #-}
+-- {{{ Imports
 import           Arbitrary                    ()
 
-import           Control.Monad.Catch.Pure
-import           Control.Monad.Identity
 import           Control.Monad.Trans.Resource
 
 import           Data.Conduit
 import           Data.Conduit.Combinators     as Conduit (sourceFile)
-import           Data.Conduit.Parser
-import           Data.Conduit.Parser.XML      as XML
 import           Data.Default
 import           Data.String
 import           Data.Text.Encoding
@@ -29,8 +26,10 @@ import           Test.Tasty.QuickCheck
 import           Text.OPML.Conduit.Parse
 import           Text.OPML.Conduit.Render
 import           Text.OPML.Lens
+import           Text.XML.Stream.Parse        as XML
 
 import           URI.ByteString
+-- }}}
 
 main :: IO ()
 main = defaultMain $ testGroup "Tests"
@@ -65,7 +64,7 @@ hlint = testCase "HLint check" $ do
 categoriesCase :: TestTree
 categoriesCase = testCase "Parse categories list" $ do
   dataFile <- fromString <$> getDataFileName "data/category.opml"
-  result <- runResourceT . runConduit $ sourceFile dataFile =$= XML.parseBytes def =$= runConduitParser parseOpml
+  result <- runResourceT . runConduit $ sourceFile dataFile =$= XML.parseBytes def =$= force "Invalid OPML" parseOpml
 
   (result ^. opmlVersionL) @?= Version [2,0] []
   (result ^. opmlHeadL . opmlTitleL) @?= "Illustrating the category attribute"
@@ -77,7 +76,7 @@ categoriesCase = testCase "Parse categories list" $ do
 directoryCase :: TestTree
 directoryCase = testCase "Parse directory tree" $ do
   dataFile <- fromString <$> getDataFileName "data/directory.opml"
-  result <- runResourceT . runConduit $ sourceFile dataFile =$= XML.parseBytes def =$= runConduitParser parseOpml
+  result <- runResourceT . runConduit $ sourceFile dataFile =$= XML.parseBytes def =$= force "Invalid OPML" parseOpml
 
   (result ^. opmlVersionL) @?= Version [2,0] []
   (result ^. opmlHeadL . opmlTitleL) @?= "scriptingNewsDirectory.opml"
@@ -98,7 +97,7 @@ directoryCase = testCase "Parse directory tree" $ do
 placesCase :: TestTree
 placesCase = testCase "Parse places list" $ do
   dataFile <- fromString <$> getDataFileName "data/placesLived.opml"
-  result <- runResourceT . runConduit $ sourceFile dataFile =$= XML.parseBytes def =$= runConduitParser parseOpml
+  result <- runResourceT . runConduit $ sourceFile dataFile =$= XML.parseBytes def =$= force "Invalid OPML" parseOpml
 
   (result ^. opmlVersionL) @?= Version [2,0] []
   (result ^. opmlHeadL . opmlTitleL) @?= "placesLived.opml"
@@ -120,7 +119,7 @@ placesCase = testCase "Parse places list" $ do
 scriptCase :: TestTree
 scriptCase = testCase "Parse script" $ do
   dataFile <- fromString <$> getDataFileName "data/simpleScript.opml"
-  result <- runResourceT . runConduit $ sourceFile dataFile =$= XML.parseBytes def =$= runConduitParser parseOpml
+  result <- runResourceT . runConduit $ sourceFile dataFile =$= XML.parseBytes def =$= force "Invalid OPML" parseOpml
 
   (result ^. opmlVersionL) @?= Version [2,0] []
   (result ^. opmlHeadL . opmlTitleL) @?= "workspace.userlandsamples.doSomeUpstreaming"
@@ -141,7 +140,7 @@ scriptCase = testCase "Parse script" $ do
 statesCase :: TestTree
 statesCase = testCase "Parse states list" $ do
   dataFile <- fromString <$> getDataFileName "data/states.opml"
-  result <- runResourceT . runConduit $ sourceFile dataFile =$= XML.parseBytes def =$= runConduitParser parseOpml
+  result <- runResourceT . runConduit $ sourceFile dataFile =$= XML.parseBytes def =$= force "Invalid OPML" parseOpml
 
   (result ^. opmlVersionL) @?= Version [2,0] []
   (result ^. opmlHeadL . opmlTitleL) @?= "states.opml"
@@ -162,7 +161,7 @@ statesCase = testCase "Parse states list" $ do
 subscriptionsCase :: TestTree
 subscriptionsCase = testCase "Parse subscriptions list" $ do
   dataFile <- fromString <$> getDataFileName "data/subscriptionList.opml"
-  result <- runResourceT . runConduit $ sourceFile dataFile =$= XML.parseBytes def =$= runConduitParser parseOpml
+  result <- runResourceT . runConduit $ sourceFile dataFile =$= XML.parseBytes def =$= force "Invalid OPML" parseOpml
 
   (result ^. opmlVersionL) @?= Version [2,0] []
   (result ^. opmlHeadL . opmlTitleL) @?= "mySubscriptions.opml"
@@ -178,7 +177,7 @@ subscriptionsCase = testCase "Parse subscriptions list" $ do
   length (result ^.. opmlOutlinesL . traverse . traverse . _OpmlOutlineSubscription) @?= 13
 
 inverseHeadProperty :: TestTree
-inverseHeadProperty = testProperty "parse . render = id (on OpmlHead)" $ \opmlHead -> either (const False) (opmlHead ==) (runIdentity . runCatchT . runConduit $ renderOpmlHead opmlHead =$= runConduitParser parseOpmlHead)
+inverseHeadProperty = testProperty "parse . render = id (on OpmlHead)" $ \opmlHead -> either (const False) (opmlHead ==) (runConduit $ renderOpmlHead opmlHead =$= force "Invalid <head>" parseOpmlHead)
 
 -- inverseProperty :: TestTree
--- inverseProperty = testProperty "parse . render = id" $ \opml -> either (const False) (opml ==) (runIdentity . runCatchT . runConduit $ renderOpml opml =$= runConduitParser parseOpml)
+-- inverseProperty = testProperty "parse . render = id" $ \opml -> either (const False) (opml ==) (runIdentity . runCatchT . runConduit $ renderOpml opml =$= force "Invalid OPML" parseOpml)