summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Text/OPML/Conduit/Parse.hs70
-rw-r--r--Text/OPML/Conduit/Render.hs18
-rw-r--r--Text/OPML/Types.hs23
-rw-r--r--opml-conduit.cabal6
-rw-r--r--test/Arbitrary.hs24
-rw-r--r--test/Main.hs16
6 files changed, 73 insertions, 84 deletions
diff --git a/Text/OPML/Conduit/Parse.hs b/Text/OPML/Conduit/Parse.hs
index bfd820e..0194e31 100644
--- a/Text/OPML/Conduit/Parse.hs
+++ b/Text/OPML/Conduit/Parse.hs
@@ -20,20 +20,18 @@ module Text.OPML.Conduit.Parse
-- {{{ Imports
import Conduit hiding (throwM)
-
import Control.Applicative hiding (many)
import Control.Exception.Safe as Exception
import Control.Monad
import Control.Monad.Fix
-
import Data.CaseInsensitive hiding (map)
+import Data.Either
import Data.List.NonEmpty (NonEmpty, nonEmpty)
import Data.Maybe
import Data.Monoid
import Data.Monoid.Textual hiding (map)
-import Data.MonoTraversable
-import Data.NonNull (NonNull, fromNullable)
-import Data.Text (Text, strip, unpack)
+import Data.Text as Text (Text, null, strip,
+ unpack)
import Data.Text.Encoding
import Data.Time.Clock
import Data.Time.LocalTime
@@ -41,13 +39,10 @@ import Data.Time.RFC822
import Data.Tree
import Data.Version
import Data.XML.Types
-
import Lens.Simple
-
import Numeric
-
import Prelude hiding (last)
-
+import Refined hiding (NonEmpty)
import Text.OPML.Types
import Text.ParserCombinators.ReadP (readP_to_S)
import Text.XML.Stream.Parse
@@ -76,18 +71,18 @@ instance Exception OpmlException where
asURI :: (MonadThrow m) => Text -> m URI
asURI t = either (throwM . InvalidURI) return . parseURI laxURIParserOptions $ encodeUtf8 t
-asVersion :: (MonadThrow m) => Text -> m Version
-asVersion v = case filter (onull . snd) . readP_to_S parseVersion $ unpack v of
+asVersion :: MonadThrow m => Text -> m Version
+asVersion v = case filter (Prelude.null . snd) . readP_to_S parseVersion $ unpack v of
[(a, "")] -> return a
_ -> throwM $ InvalidVersion v
asDecimal :: (MonadThrow m, Integral a) => Text -> m a
-asDecimal t = case filter (onull . snd) . readSigned readDec $ unpack t of
+asDecimal t = case filter (Prelude.null . snd) . readSigned readDec $ unpack t of
(result, _):_ -> return result
_ -> throwM $ InvalidDecimal t
asExpansionState :: (MonadThrow m, Integral a) => Text -> m [a]
-asExpansionState t = mapM asDecimal . filter (not . onull) . map strip $ split (== ',') t
+asExpansionState t = mapM asDecimal . filter (not . Text.null) . map strip $ split (== ',') t
asTime :: (MonadThrow m) => Text -> m UTCTime
asTime t = maybe (throwM $ InvalidTime t) (return . zonedTimeToUTC) $ parseTimeRFC822 t
@@ -100,11 +95,8 @@ asBool t
| mk t == "false" = return False
| otherwise = throwM $ InvalidBool t
-asNonNull :: (MonoFoldable mono, MonadThrow m) => mono -> m (NonNull mono)
-asNonNull = maybe (throwM MissingText) return . fromNullable
-
-asCategories :: Text -> [NonEmpty (NonNull Text)]
-asCategories = mapMaybe (nonEmpty . mapMaybe fromNullable . split (== '/')) . split (== ',')
+asCategories :: Text -> [NonEmpty (Refined (Not Null) Text)]
+asCategories = mapMaybe (nonEmpty . rights . map refine . split (== '/')) . split (== ',')
dateTag :: (MonadThrow m) => NameMatcher a -> ConduitM Event o m (Maybe UTCTime)
dateTag name = tagIgnoreAttrs name $ content >>= asTime
@@ -121,7 +113,7 @@ textTag name = tagIgnoreAttrs name content
decimalTag :: (Integral i, MonadThrow m) => NameMatcher a -> ConduitM Event o m (Maybe i)
decimalTag name = tagIgnoreAttrs name $ content >>= asDecimal
-projectC :: Monad m => Fold a a' b b' -> Conduit a m b
+projectC :: Monad m => Fold a a' b b' -> ConduitT a b m ()
projectC prism = fix $ \recurse -> do
item <- await
case (item, item ^? (_Just . prism)) of
@@ -153,21 +145,21 @@ makeTraversals ''HeadPiece
-- - 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) => ConduitM Event o m (Maybe OpmlHead)
-parseOpmlHead = tagIgnoreAttrs "head" $ (manyYield' (choose piece) <* many ignoreAnyTreeContent) =$= zipConduit where
+parseOpmlHead = tagIgnoreAttrs "head" $ (manyYield' (choose piece) <* many ignoreAnyTreeContent) .| 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)
+ <$> 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"
@@ -195,7 +187,7 @@ parseOpmlOutline = tag' "outline" attributes handler where
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 = (,,,,) <$> (requireAttr "text" >>= asNonNull)
+ baseAttr = (,,,,) <$> (requireAttr "text" >>= refineThrow)
<*> optional (requireAttr "isComment" >>= asBool)
<*> optional (requireAttr "isBreakpoint" >>= asBool)
<*> optional (requireAttr "created" >>= asTime)
@@ -210,7 +202,7 @@ parseOpmlOutline = tag' "outline" attributes handler where
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))
- <*> (manyYield' parseOpmlOutline =$= sinkList)
+ <*> (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)
@@ -224,11 +216,11 @@ makeTraversals ''OpmlDocPiece
parseOpml :: (MonadCatch m) => ConduitM Event o m (Maybe Opml)
parseOpml = tag' "opml" attributes handler where
attributes = (requireAttr "version" >>= asVersion) <* ignoreAttrs
- handler version = (manyYield' (choose piece) <* many ignoreAnyTreeContent) =$= zipConduit version
+ handler version = (manyYield' (choose piece) <* many ignoreAnyTreeContent) .| zipConduit version
zipConduit version = getZipConduit $ Opml version
- <$> ZipConduit (projectC _DocHead =$= headDefC mkOpmlHead)
- <*> ZipConduit (projectC _DocBody =$= headDefC mempty)
- parseOpmlBody = tagIgnoreAttrs "body" $ manyYield' parseOpmlOutline =$= sinkList
+ <$> 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 9786203..611926d 100644
--- a/Text/OPML/Conduit/Render.hs
+++ b/Text/OPML/Conduit/Render.hs
@@ -16,7 +16,6 @@ import Control.Monad
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
@@ -26,16 +25,13 @@ import Data.Time.RFC822
import Data.Tree
import Data.Version
import Data.XML.Types
-
import Lens.Simple
-
import Prelude hiding (foldr, lookup, show)
import qualified Prelude (show)
-
+import Refined hiding (NonEmpty)
import Text.OPML.Lens
import Text.OPML.Types
import Text.XML.Stream.Render
-
import URI.ByteString
-- }}}
@@ -52,8 +48,8 @@ toMaybe s | s == mempty = mempty
formatTime :: UTCTime -> Text
formatTime = formatTimeRFC822 . utcToZonedTime utc
-formatCategories :: [NonEmpty (NonNull Text)] -> Maybe Text
-formatCategories = toMaybe . intercalate "," . map (intercalate "/" . toList . fmap toNullable)
+formatCategories :: [NonEmpty (Refined (Not Null) Text)] -> Maybe Text
+formatCategories = toMaybe . intercalate "," . map (intercalate "/" . toList . fmap unrefine)
formatBool :: Bool -> Text
formatBool = toLower . show
@@ -62,7 +58,7 @@ formatURI :: URI -> Text
formatURI = decodeUtf8 . serializeURIRef'
-- | Render the @\<head\>@ section.
-renderOpmlHead :: (Monad m) => OpmlHead -> Source m Event
+renderOpmlHead :: (Monad m) => OpmlHead -> ConduitT () Event m ()
renderOpmlHead input = tag "head" mempty $ do
forM_ (input^.opmlCreatedL) $ tag "dateCreated" mempty . content . formatTime
forM_ (input^.modifiedL) $ tag "dateModified" mempty . content . formatTime
@@ -83,13 +79,13 @@ renderOpmlHead input = tag "head" mempty $ do
title = input ^. opmlTitleL
-- | Render an @\<outline\>@ section.
-renderOpmlOutline :: (Monad m) => Tree OpmlOutline -> Source m Event
+renderOpmlOutline :: (Monad m) => Tree OpmlOutline -> ConduitT () Event m ()
renderOpmlOutline (Node outline subOutlines) = tag "outline" attributes $ mapM_ renderOpmlOutline subOutlines
where attributes = case outline of
OpmlOutlineGeneric b t -> baseAttr b <> optionalAttr "type" (toMaybe t)
OpmlOutlineLink b uri -> baseAttr b <> attr "type" "link" <> attr "url" (formatURI uri)
OpmlOutlineSubscription b s -> baseAttr b <> subscriptionAttr s
- baseAttr b = attr "text" (toNullable $ b^.textL)
+ baseAttr b = attr "text" (unrefine $ b^.textL)
<> optionalAttr "isComment" (formatBool <$> b^.isCommentL)
<> optionalAttr "isBreakpoint" (formatBool <$> b^.isBreakpointL)
<> optionalAttr "created" (formatTime <$> b^.outlineCreatedL)
@@ -103,7 +99,7 @@ renderOpmlOutline (Node outline subOutlines) = tag "outline" attributes $ mapM_
<> optionalAttr "version" (toMaybe $ s^.subscriptionVersionL)
-- | Render the top-level @\<opml\>@ section.
-renderOpml :: (Monad m) => Opml -> Source m Event
+renderOpml :: Monad m => Opml -> ConduitT () Event m ()
renderOpml opml = tag "opml" (attr "version" . pack . showVersion $ opml^.opmlVersionL) $ do
renderOpmlHead $ opml^.opmlHeadL
tag "body" mempty . mapM_ renderOpmlOutline $ opml^.opmlOutlinesL
diff --git a/Text/OPML/Types.hs b/Text/OPML/Types.hs
index 101c884..2a4a1a2 100644
--- a/Text/OPML/Types.hs
+++ b/Text/OPML/Types.hs
@@ -1,6 +1,7 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
-- | OPML is an XML format for outlines.
--
@@ -31,24 +32,30 @@ module Text.OPML.Types
-- ** Subscription outlines
, OutlineSubscription(..)
, mkOutlineSubscription
+ -- * Others
+ , Null()
) where
-- {{{ Imports
import Control.Monad
-
import Data.List.NonEmpty
-import Data.NonNull
-import Data.Text
+import Data.Text as Text
import Data.Time.Clock
import Data.Time.LocalTime ()
import Data.Tree
+import Data.Typeable
import Data.Version
-
import GHC.Generics
-
+import Refined hiding (NonEmpty)
import URI.ByteString
-- }}}
+-- | 'Predicate' on 'Text', true iff text is null.
+data Null deriving(Typeable)
+
+instance Predicate Null Text where
+ validate p value = unless (Text.null value) $ throwRefine $ RefineOtherException (typeOf p) "Text is not null"
+
data OpmlHead = OpmlHead
{ opmlTitle :: Text
, opmlCreated :: Maybe UTCTime
@@ -74,11 +81,11 @@ mkOpmlHead :: OpmlHead
mkOpmlHead = OpmlHead mempty mzero mzero mempty mempty mzero mzero mzero mzero mzero mzero mzero mzero
data OutlineBase = OutlineBase
- { text :: NonNull Text
+ { text :: Refined (Not Null) Text
, isComment :: Maybe Bool
, isBreakpoint :: Maybe Bool
, outlineCreated :: Maybe UTCTime
- , categories :: [NonEmpty (NonNull Text)] -- ^
+ , categories :: [NonEmpty (Refined (Not Null) Text)] -- ^
}
deriving instance Eq OutlineBase
@@ -87,7 +94,7 @@ deriving instance Show OutlineBase
-- | Smart constructor for 'OutlineBase'.
-mkOutlineBase :: NonNull Text -> OutlineBase
+mkOutlineBase :: Refined (Not Null) Text -> OutlineBase
mkOutlineBase t = OutlineBase t mzero mzero mzero mzero
diff --git a/opml-conduit.cabal b/opml-conduit.cabal
index 9b6d67e..3fb364e 100644
--- a/opml-conduit.cabal
+++ b/opml-conduit.cabal
@@ -1,5 +1,5 @@
name: opml-conduit
-version: 0.6.0.4
+version: 0.7.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.
@@ -44,7 +44,7 @@ library
, safe-exceptions
, lens-simple
, monoid-subclasses
- , mono-traversable
+ , refined >= 0.2
, semigroups
, text
, time >= 1.5
@@ -70,12 +70,12 @@ test-suite tests
, containers
, data-default
, lens-simple
- , mono-traversable
, mtl
, opml-conduit
, parsers
, QuickCheck
, quickcheck-instances
+ , refined >= 0.2
, resourcet
, semigroups
, tasty
diff --git a/test/Arbitrary.hs b/test/Arbitrary.hs
index 2e6f5c6..6660c0c 100644
--- a/test/Arbitrary.hs
+++ b/test/Arbitrary.hs
@@ -14,22 +14,15 @@ import Data.ByteString (ByteString)
import Data.Char
import Data.List.NonEmpty
import Data.Maybe
-import Data.MonoTraversable (Element)
-import Data.NonNull
-import Data.Sequences (SemiSequence)
-import Data.Text (Text, find, pack)
+import Data.Text as Text (Text, find, null, pack)
import Data.Text.Encoding
import Data.Time.Clock
import Data.Tree
import Data.Version
-
-import GHC.Generics
-
+import Refined hiding (NonEmpty)
import Test.QuickCheck
import Test.QuickCheck.Instances ()
-
import Text.OPML.Types
-
import URI.ByteString
-- }}}
@@ -94,17 +87,18 @@ genTime = do
-- | Generates 'OutlineBase''s categories.
-- This generator makes sure that the result has no @,@ nor @/@ characters, since those are used as separators.
-genCategoryPath :: Gen (NonEmpty (NonNull Text))
+genCategoryPath :: Gen (NonEmpty (Refined (Not Null) Text))
genCategoryPath = (:|) <$> genCategory <*> listOf genCategory where
- genCategory = genNonNull `suchThat` (isNothing . find (\c -> c == ',' || c == '/') . toNullable)
+ genCategory = arbitrary `suchThat` (isNothing . find (\c -> c == ',' || c == '/') . unrefine)
-- | Alpha-numeric generator.
genAlphaNum :: Gen Char
genAlphaNum = oneof [choose('a', 'z'), suchThat arbitrary isDigit]
--- | Non-empty mono-foldable
-genNonNull :: (SemiSequence a, Arbitrary (Element a), Arbitrary a) => Gen (NonNull a)
-genNonNull = ncons <$> arbitrary <*> arbitrary
+instance Arbitrary (Refined (Not Null) Text) where
+ arbitrary = do
+ ~(Right t) <- refine <$> arbitrary `suchThat` (not . Text.null)
+ return t
instance Arbitrary OpmlHead where
@@ -124,7 +118,7 @@ instance Arbitrary OpmlHead where
shrink = genericShrink
instance Arbitrary OutlineBase where
- arbitrary = OutlineBase <$> genNonNull
+ arbitrary = OutlineBase <$> arbitrary
<*> arbitrary
<*> arbitrary
<*> (Just <$> genTime)
diff --git a/test/Main.hs b/test/Main.hs
index 0c43911..7b39cb9 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -49,7 +49,7 @@ properties = testGroup "Properties"
categoriesCase :: TestTree
categoriesCase = testCase "Parse categories list" $ do
dataFile <- fromString <$> getDataFileName "data/category.opml"
- result <- runResourceT . runConduit $ sourceFile dataFile =$= XML.parseBytes def =$= force "Invalid OPML" 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"
@@ -61,7 +61,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 =$= force "Invalid OPML" parseOpml
+ result <- runResourceT . runConduit $ sourceFile dataFile .| XML.parseBytes def .| force "Invalid OPML" parseOpml
(result ^. opmlVersionL) @?= Version [2,0] []
(result ^. opmlHeadL . opmlTitleL) @?= "scriptingNewsDirectory.opml"
@@ -82,7 +82,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 =$= force "Invalid OPML" parseOpml
+ result <- runResourceT . runConduit $ sourceFile dataFile .| XML.parseBytes def .| force "Invalid OPML" parseOpml
(result ^. opmlVersionL) @?= Version [2,0] []
(result ^. opmlHeadL . opmlTitleL) @?= "placesLived.opml"
@@ -104,7 +104,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 =$= force "Invalid OPML" parseOpml
+ result <- runResourceT . runConduit $ sourceFile dataFile .| XML.parseBytes def .| force "Invalid OPML" parseOpml
(result ^. opmlVersionL) @?= Version [2,0] []
(result ^. opmlHeadL . opmlTitleL) @?= "workspace.userlandsamples.doSomeUpstreaming"
@@ -125,7 +125,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 =$= force "Invalid OPML" parseOpml
+ result <- runResourceT . runConduit $ sourceFile dataFile .| XML.parseBytes def .| force "Invalid OPML" parseOpml
(result ^. opmlVersionL) @?= Version [2,0] []
(result ^. opmlHeadL . opmlTitleL) @?= "states.opml"
@@ -146,7 +146,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 =$= force "Invalid OPML" parseOpml
+ result <- runResourceT . runConduit $ sourceFile dataFile .| XML.parseBytes def .| force "Invalid OPML" parseOpml
(result ^. opmlVersionL) @?= Version [2,0] []
(result ^. opmlHeadL . opmlTitleL) @?= "mySubscriptions.opml"
@@ -162,7 +162,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 ==) (runConduit $ renderOpmlHead opmlHead =$= force "Invalid <head>" 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 =$= force "Invalid OPML" parseOpml)
+-- inverseProperty = testProperty "parse . render = id" $ \opml -> either (const False) (opml ==) (runIdentity . runCatchT . runConduit $ renderOpml opml .| force "Invalid OPML" parseOpml)