opml-conduit (empty) → 0.1.0.0
raw patch · 16 files changed
+923/−0 lines, 16 filesdep +QuickCheckdep +basedep +case-insensitivesetup-changed
Dependencies added: QuickCheck, base, case-insensitive, conduit, conduit-combinators, containers, data-default, exceptions, lens, mono-traversable, monoid-subclasses, mtl, network-uri, opml-conduit, quickcheck-instances, resourcet, semigroups, tasty, tasty-hunit, tasty-quickcheck, text, time, timerep, xml-conduit, xml-types
Files
- Data/NotEmpty.hs +43/−0
- LICENSE +13/−0
- Setup.hs +2/−0
- Text/OPML.hs +10/−0
- Text/OPML/Arbitrary.hs +72/−0
- Text/OPML/Stream/Parse.hs +175/−0
- Text/OPML/Stream/Render.hs +100/−0
- Text/OPML/Types.hs +244/−0
- data/category.opml +1/−0
- data/directory.opml +1/−0
- data/placesLived.opml +1/−0
- data/simpleScript.opml +1/−0
- data/states.opml +1/−0
- data/subscriptionList.opml +31/−0
- opml-conduit.cabal +77/−0
- test/Main.hs +151/−0
+ Data/NotEmpty.hs view
@@ -0,0 +1,43 @@+module Data.NotEmpty+ ( NE()+ , notEmpty+ , original+ , NotEmptyException(..)+ ) where++-- {{{ Imports+import Control.Monad.Catch++import Data.Semigroup++import Test.QuickCheck+-- }}}++-- | For a monoid @s@, @NE s@ is @s@ without its neutral element 'mempty'.+newtype NE s = NE s++instance (Eq s) => Eq (NE s) where+ (NE a) == (NE b) = a == b++-- | @NE s@ is the semigroup derived from the monoid type @s@.+instance (Monoid s) => Semigroup (NE s) where+ (NE a) <> (NE b) = NE (a `mappend` b)++instance (Show s) => Show (NE s) where+ show (NE s) = show s++instance (Eq s, Monoid s, Arbitrary s) => Arbitrary (NE s) where+ arbitrary = NE <$> arbitrary `suchThat` (/= mempty)++-- | Smart constructor.+notEmpty :: (MonadThrow m, Eq s, Monoid s) => s -> m (NE s)+notEmpty s | s == mempty = throwM EmptyValue+ | otherwise = return $ NE s++-- | Unwrap the underlying value.+original :: NE s -> s+original (NE s) = s+++data NotEmptyException = EmptyValue deriving(Eq, Show)+instance Exception NotEmptyException
+ LICENSE view
@@ -0,0 +1,13 @@+DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE+Version 2, December 2004++Copyright (C) 2015 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+as the name is changed.++DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE+TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION++0. You just DO WHAT THE FUCK YOU WANT TO.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Text/OPML.hs view
@@ -0,0 +1,10 @@+-- | This module re-exports commonly used modules.+module Text.OPML+ ( module Text.OPML.Stream.Parse+ , module Text.OPML.Stream.Render+ , module Text.OPML.Types+ ) where++import Text.OPML.Stream.Parse+import Text.OPML.Stream.Render+import Text.OPML.Types
+ Text/OPML/Arbitrary.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE StandaloneDeriving #-}+-- | External 'Arbitrary' instances used by OPML types.+-- All instances are defined through the 'OpmlGen' wrapper to avoid conflicts.+module Text.OPML.Arbitrary where++-- {{{ Imports+import Data.Char+import Data.Maybe+import Data.NotEmpty+import Data.Text (Text, find)+import Data.Time.Clock+import Data.Version++import GHC.Generics++import Network.URI++import Test.QuickCheck+import Test.QuickCheck.Instances ()+-- }}}++newtype OpmlGen a = OpmlGen { unwrap :: a }+deriving instance (Generic a) => Generic (OpmlGen a)+instance (Arbitrary (OpmlGen a)) => Arbitrary (OpmlGen (Maybe a)) where+ arbitrary = do+ a <- arbitrary :: Gen (Maybe ())+ (OpmlGen result) <- arbitrary+ return . OpmlGen $ maybe Nothing (const $ Just result) a++-- | Alpha-numeric generator.+genAlphaNum :: Gen Char+genAlphaNum = oneof [choose('a', 'z'), suchThat arbitrary isDigit]++-- | OPML version may only be @1.0@, @1.1@ or @2.0@+instance Arbitrary (OpmlGen Version) where+ arbitrary = OpmlGen <$> (Version <$> elements [ [1, 0], [1, 1], [2, 0] ] <*> pure [])+ shrink (OpmlGen (Version a b)) = OpmlGen <$> (Version <$> shrink a <*> shrink b)++-- | Reasonable enough 'URI' generator.+instance Arbitrary (OpmlGen URI) where+ arbitrary = OpmlGen <$> (URI <$> genUriScheme <*> (unwrap <$> arbitrary) <*> genUriPath <*> genUriQuery <*> genUriFragment)+ where genUriPath = ("/" ++) <$> listOf1 genAlphaNum+ genUriQuery = oneof [return "", ("?" ++) <$> listOf1 genAlphaNum]+ genUriFragment = oneof [return "", ("#" ++) <$> listOf1 genAlphaNum]+ genUriScheme = (\x -> x ++ ":") <$> listOf1 (choose('a', 'z'))+ -- shrink = genericShrink++-- | Reasonable enough 'URIAuth' generator.+instance Arbitrary (OpmlGen URIAuth) where+ arbitrary = do+ userInfo <- oneof [return "", fmap (\x -> x ++ "@") $ listOf1 genAlphaNum]+ regName <- listOf1 genAlphaNum+ port <- oneof [return "", (\x -> ":" ++ x) . show <$> choose(1 :: Int, 65535)]+ return . OpmlGen $ URIAuth userInfo regName port+ -- shrink = genericShrink+++-- | Generates 'UTCTime' with rounded seconds.+instance Arbitrary (OpmlGen UTCTime) where+ arbitrary = do+ (UTCTime d s) <- arbitrary+ return . OpmlGen $ UTCTime d (fromIntegral (round s :: Int))+ -- shrink = genericShrink++-- | Generates 'OutlineBase''s categories.+-- This generator makes sure that the result has no @,@ nor @/@ characters, since those are used as separators.+instance Arbitrary (OpmlGen [[NE Text]]) where+ arbitrary = OpmlGen <$> listOf (listOf1 $ arbitrary `suchThat` (isNothing . find (\c -> c == ',' || c == '/') . original))+ shrink = genericShrink
+ Text/OPML/Stream/Parse.hs view
@@ -0,0 +1,175 @@+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies #-}+-- | Streaming parser for the OPML 2.0 standard.+--+-- The parser tries to be as lenient as possible. All functions may throw an 'OpmlException'.+module Text.OPML.Stream.Parse+ ( -- * Parsers+ parseOpml+ , parseOpmlHead+ , parseOpmlOutline+ -- * Exceptions+ , OpmlException(..)+ ) where++-- {{{ Imports+import Control.Lens.At+import Control.Lens.Setter+import Control.Monad+import Control.Monad.Catch++import Data.CaseInsensitive hiding (map)+import Data.Conduit+import Data.Containers+import Data.Map (Map)+import Data.Maybe+import Data.Monoid.Textual hiding (map)+import Data.MonoTraversable+import Data.NotEmpty+import Data.Text (Text, strip, unpack)+import Data.Time.Clock+import Data.Time.LocalTime+import Data.Time.RFC822+import Data.Tree+import Data.Version+import Data.XML.Types++import Network.URI (URI)+import qualified Network.URI as N++import Numeric++import Prelude hiding (foldr, lookup)++import Text.OPML.Types+import Text.ParserCombinators.ReadP (readP_to_S)+import Text.XML.Stream.Parse+-- }}}++data OpmlException = InvalidBool Text+ | InvalidDecimal Text+ | InvalidTime Text+ | InvalidURI Text+ | InvalidVersion Text++deriving instance Eq OpmlException+instance Show OpmlException where+ show (InvalidBool t) = "Invalid boolean: " ++ unpack t+ show (InvalidDecimal t) = "Invalid decimal: " ++ unpack t+ show (InvalidURI t) = "Invalid URI: " ++ unpack t+ show (InvalidTime t) = "Invalid time: " ++ unpack t+ show (InvalidVersion t) = "Invalid version: " ++ unpack t+instance Exception OpmlException++-- | Generic version of 'Network.URI.parseURI'.+parseURI :: (MonadThrow m) => Text -> m URI+parseURI t = maybe (throwM $ InvalidURI t) return . N.parseURI $ unpack t++parseVersion' :: (MonadThrow m) => Text -> m Version+parseVersion' v = case filter (onull . snd) . readP_to_S parseVersion $ unpack v of+ [(a, "")] -> return a+ _ -> throwM $ InvalidVersion v++parseDecimal :: (MonadThrow m, Integral a) => Text -> m a+parseDecimal t = case (filter (\(_, b) -> onull b) . readSigned readDec $ unpack t) of+ (result, _):_ -> return result+ _ -> throwM $ InvalidDecimal t++parseExpansionState :: (MonadThrow m, Integral a) => Text -> m [a]+parseExpansionState t = mapM parseDecimal . filter (not . onull) . map strip $ split (== ',') t++parseTime :: (MonadThrow m) => Text -> m UTCTime+parseTime t = maybe (throwM $ InvalidTime t) (return . zonedTimeToUTC) $ parseTimeRFC822 t++-- The standard only accepts "true", and "false",+-- but it doesn't hurt to be more lenient+parseBool :: (MonadThrow m) => Text -> m Bool+parseBool t+ | mk t == "true" = return True+ | mk t == "false" = return False+ | otherwise = throwM $ InvalidBool t+++opmlHeadBuilder :: (MonadThrow m) => Map Text (Text -> OpmlHead -> m OpmlHead)+opmlHeadBuilder = [ ("dateCreated", \v h -> set opmlCreated_ <$> (Just <$> parseTime v) <*> pure h)+ , ("dateModified", \v h -> set modified_ <$> (Just <$> parseTime v) <*> pure h)+ , ("docs", \v h -> set docs_ <$> (Just <$> parseURI v) <*> pure h)+ , ("expansionState", \v h -> set expansionState_ <$> parseExpansionState v <*> pure h)+ , ("ownerEmail", \v -> return . set ownerEmail_ v)+ , ("ownerId", \v h -> set ownerId_ <$> (Just <$> parseURI v) <*> pure h)+ , ("ownerName", \v -> return . set ownerName_ v)+ , ("title", \v -> return . set opmlTitle_ v)+ , ("vertScrollState", \v h -> set vertScrollState_ <$> (Just <$> parseDecimal v) <*> pure h)+ , ("windowBottom", \v h -> set (window_.at Bottom') <$> (Just <$> parseDecimal v) <*> pure h)+ , ("windowLeft", \v h -> set (window_.at Left') <$> (Just <$> parseDecimal v) <*> pure h)+ , ("windowRight", \v h -> set (window_.at Right') <$> (Just <$> parseDecimal v) <*> pure h)+ , ("windowTop", \v h -> set (window_.at Top') <$> (Just <$> parseDecimal v) <*> pure h)+ ]++-- | Parse the @\<head\>@ section.+-- This function is more lenient than what the standards demands on the following points:+--+-- - each sub-element may be repeated, in which case only the last occurrence is taken into account;+-- - each unknown sub-element is ignored.+parseOpmlHead :: (MonadThrow m) => Consumer Event m (Maybe OpmlHead)+parseOpmlHead = tagName "head" ignoreAttrs $ \_ -> foldM (\a f' -> f' a) def =<< many (tagHead `orE` unknownTag)+ where tagHead, unknownTag :: (MonadThrow m, MonadThrow m') => ConduitM Event o m (Maybe (OpmlHead -> m' OpmlHead))+ tagHead = tag ((`lookup` opmlHeadBuilder) . nameLocalName) (\f -> ignoreAttrs *> pure f) $ \f -> do+ c <- content+ return $ f c+ unknownTag = tagPredicate (const True) ignoreAttrs $ \_ -> return return+++parseCategories :: Text -> [[NE Text]]+parseCategories = filter (not . onull) . map (catMaybes . map notEmpty . split (== '/')) . split (== ',')++-- | 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 :: (MonadThrow m) => Consumer Event m (Maybe (Tree OpmlOutline))+parseOpmlOutline = tagName "outline" attributes handler+ where attributes = do+ otype <- optionalAttr "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 = (,,,,) <$> requireAttr "text"+ <*> optionalAttr "isComment"+ <*> optionalAttr "isBreakpoint"+ <*> optionalAttr "created"+ <*> optionalAttr "category"+ linkAttr = requireAttr "url"+ subscriptionAttr = (,,,,,) <$> requireAttr "xmlUrl"+ <*> optionalAttr "htmlUrl"+ <*> optionalAttr "description"+ <*> optionalAttr "language"+ <*> optionalAttr "title"+ <*> optionalAttr "version"+ handler (_, b, Just s, _) = Node <$> (OpmlOutlineSubscription <$> baseHandler b <*> subscriptionHandler s) <*> pure []+ handler (_, b, _, Just l) = Node <$> (OpmlOutlineLink <$> baseHandler b <*> parseURI l) <*> pure []+ handler (otype, b, _, _) = Node <$> (OpmlOutlineGeneric <$> baseHandler b <*> pure (fromMaybe mempty otype))+ <*> many parseOpmlOutline+ baseHandler (t, comment, breakpoint, created, category) =+ OutlineBase <$> notEmpty t+ <*> pure (parseBool =<< comment)+ <*> pure (parseBool =<< breakpoint)+ <*> pure (parseTime =<< created)+ <*> pure (parseCategories =<< otoList category)+ subscriptionHandler (uri, html, description, language, title, version) =+ OutlineSubscription <$> parseURI uri+ <*> pure (parseURI =<< html)+ <*> pure (fromMaybe mempty description)+ <*> pure (fromMaybe mempty language)+ <*> pure (fromMaybe mempty title)+ <*> pure (fromMaybe mempty version)++-- | Parse the top-level @\<opml\>@ element.+parseOpml :: (MonadThrow m) => Consumer Event m (Maybe Opml)+parseOpml = tagName "opml" attributes handler+ where attributes = requireAttr "version" <* ignoreAttrs+ handler version = Opml <$> parseVersion' version+ <*> force "Missing <head>." parseOpmlHead+ <*> force "Missing <body>." (tagName "body" ignoreAttrs $ \_ -> many parseOpmlOutline)
+ Text/OPML/Stream/Render.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-}+-- | Streaming renderer for the OPML 2.0 standard.+module Text.OPML.Stream.Render+ ( -- * Renderers+ renderOpmlHead+ , renderOpmlOutline+ , renderOpml+ ) where++-- {{{ Imports+import Control.Lens.At+import Control.Lens.Getter+import Control.Monad++import Data.Conduit+import Data.Monoid+import Data.MonoTraversable+import Data.NotEmpty+import Data.Text (Text, intercalate, pack, toLower)+import Data.Time.Clock+import Data.Time.LocalTime+import Data.Time.RFC822+import Data.Tree+import Data.Version+import Data.XML.Types++import Prelude hiding (foldr, lookup)++import Text.OPML.Types+import Text.XML.Stream.Render+-- }}}++tshow :: (Show a) => a -> Text+tshow = pack . show++empty :: (Eq s, Monoid s) => s -> Bool+empty t = t == mempty++toMaybe :: (Eq s, Monoid s) => s -> Maybe s+toMaybe s | s == mempty = mempty+ | otherwise = Just s++formatTime :: UTCTime -> Text+formatTime = formatTimeRFC822 . utcToZonedTime utc++formatCategories :: [[NE Text]] -> Maybe Text+formatCategories = toMaybe . intercalate "," . map (intercalate "/") . filter (not . onull) . map (map original)++formatBool :: Bool -> Text+formatBool = toLower . tshow++-- | Render the @\<head\>@ section.+renderOpmlHead :: (Monad m) => OpmlHead -> Source m Event+renderOpmlHead input = tag "head" mempty $ do+ forM_ (input^.opmlCreated_) $ tag "dateCreated" mempty . content . formatTime+ forM_ (input^.modified_) $ tag "dateModified" mempty . content . formatTime+ forM_ (input^.docs_) $ tag "docs" mempty . content . tshow+ unless (null es) . tag "expansionState" mempty . content . intercalate "," $ tshow <$> es+ unless (empty email) $ tag "ownerEmail" mempty $ content email+ forM_ (input^.ownerId_) $ tag "ownerId" mempty . content . tshow+ unless (empty name) $ tag "ownerName" mempty $ content name+ unless (empty title) $ tag "title" mempty $ content title+ forM_ (input^.vertScrollState_) $ tag "vertScrollState" mempty . content . tshow+ forM_ (input^.window_.at Bottom') $ tag "windowBottom" mempty . content . tshow+ forM_ (input^.window_.at Left') $ tag "windowLeft" mempty . content . tshow+ forM_ (input^.window_.at Right') $ tag "windowRight" mempty . content . tshow+ forM_ (input^.window_.at Top') $ tag "windowTop" mempty . content . tshow+ where es = input ^. expansionState_+ email = input ^. ownerEmail_+ name = input ^. ownerName_+ title = input ^. opmlTitle_++-- | Render an @\<outline\>@ section.+renderOpmlOutline :: (Monad m) => Tree OpmlOutline -> Source m Event+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" (tshow uri)+ OpmlOutlineSubscription b s -> baseAttr b <> subscriptionAttr s+ baseAttr b = attr "text" (original $ b^.text_)+ <> optionalAttr "isComment" (formatBool <$> b^.isComment_)+ <> optionalAttr "isBreakpoint" (formatBool <$> b^.isBreakpoint_)+ <> optionalAttr "created" (formatTime <$> b^.outlineCreated_)+ <> optionalAttr "category" (formatCategories $ b^.categories_)+ subscriptionAttr s = attr "type" "rss"+ <> attr "xmlUrl" (tshow $ s^.xmlUri_)+ <> optionalAttr "htmlUrl" (tshow <$> s^.htmlUri_)+ <> optionalAttr "description" (toMaybe $ s^.description_)+ <> optionalAttr "language" (toMaybe $ s^.language_)+ <> optionalAttr "title" (toMaybe $ s^.subscriptionTitle_)+ <> optionalAttr "version" (toMaybe $ s^.subscriptionVersion_)++-- | Render the top-level @\<opml\>@ section.+renderOpml :: (Monad m) => Opml -> Source m Event+renderOpml opml = tag "opml" (attr "version" . pack . showVersion $ opml^.opmlVersion_) $ do+ renderOpmlHead $ opml^.head_+ tag "body" mempty . mapM_ renderOpmlOutline $ opml^.outlines_
+ Text/OPML/Types.hs view
@@ -0,0 +1,244 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+-- | OPML is an XML format for outlines.+--+-- Example:+--+-- > <opml version="2.0">+-- > <head>+-- > <title>OPML title</title>+-- > <dateCreated>Mon, 31 Oct 2005 19:23:00 GMT</dateCreated>+-- > </head>+-- > <body>+-- > <outline text="Outline 1" created="Mon, 31 Oct 2005 18:21:33 GMT"/>+-- > <outline text="Outline 2" created="Mon, 31 Oct 2005 18:21:33 GMT"/>+-- > </body>+-- > </opml>+module Text.OPML.Types+ ( -- * Top-level OPML structure+ Opml(..)+ , opmlVersion_+ , head_+ , outlines_+ -- * OPML header+ , OpmlHead(..)+ , Direction(..)+ , opmlTitle_+ , opmlCreated_+ , modified_+ , ownerName_+ , ownerEmail_+ , ownerId_+ , docs_+ , expansionState_+ , vertScrollState_+ , window_+ -- * OPML outlines+ , OpmlOutline(..)+ , _OpmlOutlineGeneric+ , _OpmlOutlineLink+ , _OpmlOutlineSubscription+ -- ** Generic outlines+ , OutlineBase(..)+ , mkOutlineBase+ , text_+ , isComment_+ , isBreakpoint_+ , outlineCreated_+ , categories_+ -- ** Subscription outlines+ , OutlineSubscription(..)+ , mkOutlineSubscription+ , xmlUri_+ , htmlUri_+ , description_+ , language_+ , subscriptionTitle_+ , subscriptionVersion_+ ) where++-- {{{ Imports+import Control.Lens.TH+import Control.Monad++import Data.Default+import Data.Map+import Data.NotEmpty+import Data.Text+import Data.Time.Clock+import Data.Time.LocalTime ()+import Data.Tree+import Data.Version++import GHC.Generics++import Network.URI++import Test.QuickCheck+import Text.OPML.Arbitrary+-- }}}++data Direction = Top' | Left' | Bottom' | Right' deriving(Eq, Generic, Ord, Show)++instance Arbitrary Direction where+ arbitrary = elements [Top', Left', Right', Bottom']+ shrink = genericShrink+++declareLenses [d|+ data OpmlHead = OpmlHead+ { opmlTitle_ :: Text+ , opmlCreated_ :: Maybe UTCTime+ , modified_ :: Maybe UTCTime+ , ownerName_ :: Text+ , ownerEmail_ :: Text+ , ownerId_ :: Maybe URI+ , docs_ :: Maybe URI+ , expansionState_ :: [Int]+ , vertScrollState_ :: Maybe Int+ , window_ :: Map Direction Int+ }+ |]++deriving instance Eq OpmlHead+deriving instance Generic OpmlHead+deriving instance Show OpmlHead++-- | Use 'def' as a smart constructor. All fields are set to 'mempty'.+instance Default OpmlHead where+ def = OpmlHead mempty mzero mzero mempty mempty mzero mzero mzero mzero mempty++instance Arbitrary OpmlHead where+ arbitrary = OpmlHead <$> arbitrary+ <*> (unwrap <$> arbitrary)+ <*> (unwrap <$> arbitrary)+ <*> arbitrary+ <*> arbitrary+ <*> (unwrap <$> arbitrary)+ <*> (unwrap <$> arbitrary)+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ shrink (OpmlHead a b c d e f g h i j) = OpmlHead <$> shrink a+ <*> (unwrap <$> shrink (OpmlGen b))+ <*> (unwrap <$> shrink (OpmlGen c))+ <*> shrink d+ <*> shrink e+ <*> (unwrap <$> shrink (OpmlGen f))+ <*> (unwrap <$> shrink (OpmlGen g))+ <*> shrink h+ <*> shrink i+ <*> shrink j++declareLenses [d|+ data OutlineBase = OutlineBase+ { text_ :: NE Text+ , isComment_ :: Maybe Bool+ , isBreakpoint_ :: Maybe Bool+ , outlineCreated_ :: Maybe UTCTime+ , categories_ :: [[NE Text]]+ }+ |]++deriving instance Eq OutlineBase+deriving instance Generic OutlineBase+deriving instance Show OutlineBase++instance Arbitrary OutlineBase where+ arbitrary = OutlineBase <$> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> (unwrap <$> arbitrary)+ <*> (unwrap <$> arbitrary)+ shrink = genericShrink++-- | Smart constructor for 'OutlineBase'.+mkOutlineBase :: NE Text -> OutlineBase+mkOutlineBase t = OutlineBase t mzero mzero mzero mzero+++declareLenses [d|+ data OutlineSubscription = OutlineSubscription+ { xmlUri_ :: URI+ , htmlUri_ :: Maybe URI+ , description_ :: Text+ , language_ :: Text+ , subscriptionTitle_ :: Text+ , subscriptionVersion_ :: Text+ }+ |]++deriving instance Eq OutlineSubscription+deriving instance Generic OutlineSubscription+deriving instance Show OutlineSubscription++instance Arbitrary OutlineSubscription where+ arbitrary = OutlineSubscription <$> (unwrap <$> arbitrary)+ <*> (unwrap <$> arbitrary)+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ shrink (OutlineSubscription a b c d e f) = OutlineSubscription <$> (unwrap <$> shrink (OpmlGen a)) <*> (unwrap <$> shrink (OpmlGen b)) <*> shrink c <*> shrink d <*> shrink e <*> shrink f++-- | Smart constructor for 'OutlineSubscription'+mkOutlineSubscription :: URI -> OutlineSubscription+mkOutlineSubscription uri = OutlineSubscription uri mzero mempty mempty mempty mempty+++-- | Outlines are the main payload of an OPML document.+declarePrisms [d|+ data OpmlOutline = OpmlOutlineGeneric OutlineBase Text+ | OpmlOutlineLink OutlineBase URI+ | OpmlOutlineSubscription OutlineBase OutlineSubscription+ |]++deriving instance Eq OpmlOutline+deriving instance Generic OpmlOutline+deriving instance Show OpmlOutline++instance Arbitrary OpmlOutline where+ arbitrary = oneof [ OpmlOutlineGeneric <$> arbitrary <*> arbitrary+ , OpmlOutlineLink <$> arbitrary <*> (unwrap <$> arbitrary)+ , OpmlOutlineSubscription <$> arbitrary <*> arbitrary+ ]+ shrink (OpmlOutlineGeneric a b) = OpmlOutlineGeneric <$> shrink a <*> shrink b+ shrink (OpmlOutlineLink a b) = OpmlOutlineLink <$> shrink a <*> (unwrap <$> shrink (OpmlGen b))+ shrink (OpmlOutlineSubscription a b) = OpmlOutlineSubscription <$> shrink a <*> shrink b+++declareLenses [d|+ data Opml = Opml+ { opmlVersion_ :: Version+ , head_ :: OpmlHead+ , outlines_ :: Forest OpmlOutline+ }+ |]++deriving instance Eq Opml+deriving instance Generic Opml+deriving instance Show Opml++instance Default Opml where+ def = Opml (makeVersion [2, 0]) def mempty++instance Arbitrary Opml where+ arbitrary = Opml <$> (unwrap <$> arbitrary)+ <*> arbitrary+ <*> listOf (genOutlineTree 1)+ shrink (Opml a b c) = Opml <$> (unwrap <$> shrink (OpmlGen a)) <*> shrink b <*> shrink c++-- | Generate a tree of outlines with the given maximum depth.+-- This generator makes sure that only 'OpmlOutlineGeneric' may have children.+genOutlineTree :: Int -> Gen (Tree OpmlOutline)+genOutlineTree n = do+ root <- arbitrary+ case (n > 1, root) of+ (True, OpmlOutlineGeneric _ _) -> Node <$> pure root <*> listOf (genOutlineTree (n-1))+ (False, OpmlOutlineGeneric _ _) -> return $ Node root []+ _ -> return $ Node root []
+ data/category.opml view
@@ -0,0 +1,1 @@+<?xml version="1.0" encoding="ISO-8859-1"?> <opml version="2.0"> <head> <title>Illustrating the category attribute</title> <dateCreated>Mon, 31 Oct 2005 19:23:00 GMT</dateCreated> </head> <body> <outline text="The Mets are the best team in baseball." category="/Philosophy/Baseball/Mets,/Tourism/New York" created="Mon, 31 Oct 2005 18:21:33 GMT"/> </body> </opml>
+ data/directory.opml view
@@ -0,0 +1,1 @@+<?xml version="1.0" encoding="ISO-8859-1"?> <opml version="2.0"> <head> <title>scriptingNewsDirectory.opml</title> <dateCreated>Thu, 13 Oct 2005 15:34:07 GMT</dateCreated> <dateModified>Tue, 25 Oct 2005 21:33:57 GMT</dateModified> <ownerName>Dave Winer</ownerName> <ownerEmail>dwiner@yahoo.com</ownerEmail> <expansionState></expansionState> <vertScrollState>1</vertScrollState> <windowTop>105</windowTop> <windowLeft>466</windowLeft> <windowBottom>386</windowBottom> <windowRight>964</windowRight> </head> <body> <outline text="Scripting News sites" created="Sun, 16 Oct 2005 05:56:10 GMT" type="link" url="http://hosting.opml.org/dave/mySites.opml"/> <outline text="News.Com top 100 OPML" created="Tue, 25 Oct 2005 21:33:28 GMT" type="link" url="http://news.com.com/html/ne/blogs/CNETNewsBlog100.opml"/> <outline text="BloggerCon III Blogroll" created="Mon, 24 Oct 2005 05:23:52 GMT" type="link" url="http://static.bloggercon.org/iii/blogroll.opml"/> <outline text="TechCrunch reviews" type="link" url="http://hosting.opml.org/techcrunch.opml.org/TechCrunch.opml"/> <outline text="Tod Maffin's directory of Public Radio podcasts" type="link" url="http://todmaffin.com/radio.opml"/> <outline text="Adam Curry's iPodder.org directory" type="link" url="http://homepage.mac.com/dailysourcecode/DSC/ipodderDirectory.opml"/> <outline text="Memeorandum" created="Thu, 13 Oct 2005 15:19:05 GMT" type="link" url="http://tech.memeorandum.com/index.opml"/> <outline text="DaveNet archive" created="Wed, 12 Oct 2005 01:39:56 GMT" type="link" url="http://davenet.opml.org/index.opml"/> </body> </opml>
+ data/placesLived.opml view
@@ -0,0 +1,1 @@+<?xml version="1.0" encoding="ISO-8859-1"?> <opml version="2.0"> <head> <title>placesLived.opml</title> <dateCreated>Mon, 27 Feb 2006 12:09:48 GMT</dateCreated> <dateModified>Mon, 27 Feb 2006 12:11:44 GMT</dateModified> <ownerName>Dave Winer</ownerName> <ownerId>http://www.opml.org/profiles/sendMail?usernum=1</ownerId> <expansionState>1, 2, 5, 10, 13, 15</expansionState> <vertScrollState>1</vertScrollState> <windowTop>242</windowTop> <windowLeft>329</windowLeft> <windowBottom>665</windowBottom> <windowRight>547</windowRight> </head> <body> <outline text="Places I've lived"> <outline text="Boston"> <outline text="Cambridge"/> <outline text="West Newton"/> </outline> <outline text="Bay Area"> <outline text="Mountain View"/> <outline text="Los Gatos"/> <outline text="Palo Alto"/> <outline text="Woodside"/> </outline> <outline text="New Orleans"> <outline text="Uptown"/> <outline text="Metairie"/> </outline> <outline text="Wisconsin"> <outline text="Madison"/> </outline> <outline text="Florida" type="include" url="http://hosting.opml.org/dave/florida.opml"/> <outline text="New York"> <outline text="Jackson Heights"/> <outline text="Flushing"/> <outline text="The Bronx"/> </outline> </outline> </body> </opml>
+ data/simpleScript.opml view
@@ -0,0 +1,1 @@+<?xml version="1.0" encoding="ISO-8859-1"?> <opml version="2.0"> <head> <title>workspace.userlandsamples.doSomeUpstreaming</title> <dateCreated>Mon, 11 Feb 2002 22:48:02 GMT</dateCreated> <dateModified>Sun, 30 Oct 2005 03:30:17 GMT</dateModified> <ownerName>Dave Winer</ownerName> <ownerEmail>dwiner@yahoo.com</ownerEmail> <expansionState>1, 2, 4</expansionState> <vertScrollState>1</vertScrollState> <windowTop>74</windowTop> <windowLeft>41</windowLeft> <windowBottom>314</windowBottom> <windowRight>475</windowRight> </head> <body> <outline text="Changes" isComment="true"> <outline text="1/3/02; 4:54:25 PM by DW"> <outline text="Change "playlist" to "radio"."/> </outline> <outline text="2/12/01; 1:49:33 PM by DW" isComment="true"> <outline text="Test upstreaming by sprinkling a few files in a nice new test folder."/> </outline> </outline> <outline text="on writetestfile (f, size)"> <outline text="file.surefilepath (f)" isBreakpoint="true"/> <outline text="file.writewholefile (f, string.filledstring ("x", size))"/> </outline> <outline text="local (folder = user.radio.prefs.wwwfolder + "test\\largefiles\\")"/> <outline text="for ch = 'a' to 'z'"> <outline text="writetestfile (folder + ch + ".html", random (1000, 16000))"/> </outline> </body> </opml>
+ data/states.opml view
@@ -0,0 +1,1 @@+<?xml version="1.0" encoding="ISO-8859-1"?> <opml version="2.0"> <head> <title>states.opml</title> <dateCreated>Tue, 15 Mar 2005 16:35:45 GMT</dateCreated> <dateModified>Thu, 14 Jul 2005 23:41:05 GMT</dateModified> <ownerName>Dave Winer</ownerName> <ownerEmail>dave@scripting.com</ownerEmail> <expansionState>1, 6, 13, 16, 18, 20</expansionState> <vertScrollState>1</vertScrollState> <windowTop>106</windowTop> <windowLeft>106</windowLeft> <windowBottom>558</windowBottom> <windowRight>479</windowRight> </head> <body> <outline text="United States"> <outline text="Far West"> <outline text="Alaska"/> <outline text="California"/> <outline text="Hawaii"/> <outline text="Nevada"> <outline text="Reno" created="Tue, 12 Jul 2005 23:56:35 GMT"/> <outline text="Las Vegas" created="Tue, 12 Jul 2005 23:56:37 GMT"/> <outline text="Ely" created="Tue, 12 Jul 2005 23:56:39 GMT"/> <outline text="Gerlach" created="Tue, 12 Jul 2005 23:56:47 GMT"/> </outline> <outline text="Oregon"/> <outline text="Washington"/> </outline> <outline text="Great Plains"> <outline text="Kansas"/> <outline text="Nebraska"/> <outline text="North Dakota"/> <outline text="Oklahoma"/> <outline text="South Dakota"/> </outline> <outline text="Mid-Atlantic"> <outline text="Delaware"/> <outline text="Maryland"/> <outline text="New Jersey"/> <outline text="New York"/> <outline text="Pennsylvania"/> </outline> <outline text="Midwest"> <outline text="Illinois"/> <outline text="Indiana"/> <outline text="Iowa"/> <outline text="Kentucky"/> <outline text="Michigan"/> <outline text="Minnesota"/> <outline text="Missouri"/> <outline text="Ohio"/> <outline text="West Virginia"/> <outline text="Wisconsin"/> </outline> <outline text="Mountains"> <outline text="Colorado"/> <outline text="Idaho"/> <outline text="Montana"/> <outline text="Utah"/> <outline text="Wyoming"/> </outline> <outline text="New England"> <outline text="Connecticut"/> <outline text="Maine"/> <outline text="Massachusetts"/> <outline text="New Hampshire"/> <outline text="Rhode Island"/> <outline text="Vermont"/> </outline> <outline text="South"> <outline text="Alabama"/> <outline text="Arkansas"/> <outline text="Florida"/> <outline text="Georgia"/> <outline text="Louisiana"/> <outline text="Mississippi"/> <outline text="North Carolina"/> <outline text="South Carolina"/> <outline text="Tennessee"/> <outline text="Virginia"/> </outline> <outline text="Southwest"> <outline text="Arizona"/> <outline text="New Mexico"/> <outline text="Texas"/> </outline> </outline> </body> </opml>
+ data/subscriptionList.opml view
@@ -0,0 +1,31 @@+<?xml version="1.0" encoding="ISO-8859-1"?>+<opml version="2.0">+ <head>+ <title>mySubscriptions.opml</title>+ <dateCreated>Sat, 18 Jun 2005 12:11:52 GMT</dateCreated>+ <dateModified>Tue, 02 Aug 2005 21:42:48 GMT</dateModified>+ <ownerName>Dave Winer</ownerName>+ <ownerEmail>dave@scripting.com</ownerEmail>+ <expansionState></expansionState>+ <vertScrollState>1</vertScrollState>+ <windowTop>61</windowTop>+ <windowLeft>304</windowLeft>+ <windowBottom>562</windowBottom>+ <windowRight>842</windowRight>+ </head>+ <body>+ <outline text="CNET News.com" description="Tech news and business reports by CNET News.com. Focused on information technology, core topics include computers, hardware, software, networking, and Internet media." htmlUrl="http://news.com.com/" language="unknown" title="CNET News.com" type="rss" version="RSS2" xmlUrl="http://news.com.com/2547-1_3-0-5.xml"/>+ <outline text="washingtonpost.com - Politics" description="Politics" htmlUrl="http://www.washingtonpost.com/wp-dyn/politics?nav=rss_politics" language="unknown" title="washingtonpost.com - Politics" type="rss" version="RSS2" xmlUrl="http://www.washingtonpost.com/wp-srv/politics/rssheadlines.xml"/>+ <outline text="Scobleizer: Microsoft Geek Blogger" description="Robert Scoble's look at geek and Microsoft life." htmlUrl="http://radio.weblogs.com/0001011/" language="unknown" title="Scobleizer: Microsoft Geek Blogger" type="rss" version="RSS2" xmlUrl="http://radio.weblogs.com/0001011/rss.xml"/>+ <outline text="Yahoo! News: Technology" description="Technology" htmlUrl="http://news.yahoo.com/news?tmpl=index&cid=738" language="unknown" title="Yahoo! News: Technology" type="rss" version="RSS2" xmlUrl="http://rss.news.yahoo.com/rss/tech"/>+ <outline text="Workbench" description="Programming and publishing news and comment" htmlUrl="http://www.cadenhead.org/workbench/" language="unknown" title="Workbench" type="rss" version="RSS2" xmlUrl="http://www.cadenhead.org/workbench/rss.xml"/>+ <outline text="Christian Science Monitor | Top Stories" description="Read the front page stories of csmonitor.com." htmlUrl="http://csmonitor.com" language="unknown" title="Christian Science Monitor | Top Stories" type="rss" version="RSS" xmlUrl="http://www.csmonitor.com/rss/top.rss"/>+ <outline text="Dictionary.com Word of the Day" description="A new word is presented every day with its definition and example sentences from actual published works." htmlUrl="http://dictionary.reference.com/wordoftheday/" language="unknown" title="Dictionary.com Word of the Day" type="rss" version="RSS" xmlUrl="http://www.dictionary.com/wordoftheday/wotd.rss"/>+ <outline text="The Motley Fool" description="To Educate, Amuse, and Enrich" htmlUrl="http://www.fool.com" language="unknown" title="The Motley Fool" type="rss" version="RSS" xmlUrl="http://www.fool.com/xml/foolnews_rss091.xml"/>+ <outline text="InfoWorld: Top News" description="The latest on Top News from InfoWorld" htmlUrl="http://www.infoworld.com/news/index.html" language="unknown" title="InfoWorld: Top News" type="rss" version="RSS2" xmlUrl="http://www.infoworld.com/rss/news.xml"/>+ <outline text="NYT > Business" description="Find breaking news & business news on Wall Street, media & advertising, international business, banking, interest rates, the stock market, currencies & funds." htmlUrl="http://www.nytimes.com/pages/business/index.html?partner=rssnyt" language="unknown" title="NYT > Business" type="rss" version="RSS2" xmlUrl="http://www.nytimes.com/services/xml/rss/nyt/Business.xml"/>+ <outline text="NYT > Technology" description="" htmlUrl="http://www.nytimes.com/pages/technology/index.html?partner=rssnyt" language="unknown" title="NYT > Technology" type="rss" version="RSS2" xmlUrl="http://www.nytimes.com/services/xml/rss/nyt/Technology.xml"/>+ <outline text="Scripting News" description="It's even worse than it appears." htmlUrl="http://www.scripting.com/" language="unknown" title="Scripting News" type="rss" version="RSS2" xmlUrl="http://www.scripting.com/rss.xml"/>+ <outline text="Wired News" description="Technology, and the way we do business, is changing the world we know. Wired News is a technology - and business-oriented news service feeding an intelligent, discerning audience. What role does technology play in the day-to-day living of your life? Wired News tells you. How has evolving technology changed the face of the international business world? Wired News puts you in the picture." htmlUrl="http://www.wired.com/" language="unknown" title="Wired News" type="rss" version="RSS" xmlUrl="http://www.wired.com/news_drop/netcenter/netcenter.rdf"/>+ </body>+</opml>
+ opml-conduit.cabal view
@@ -0,0 +1,77 @@+name: opml-conduit+version: 0.1.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-file: LICENSE+author: koral <koral@mailoo.org>+maintainer: koral <koral@mailoo.org>+category: Conduit, Text, XML+build-type: Simple+-- extra-source-files:+cabal-version: >=1.10+data-files:+ data/category.opml+ data/directory.opml+ data/placesLived.opml+ data/simpleScript.opml+ data/states.opml+ data/subscriptionList.opml++source-repository head+ type: git+ location: git://github.com/k0ral/opml-conduit.git++library+ exposed-modules: Data.NotEmpty+ , Text.OPML+ , Text.OPML.Arbitrary+ , Text.OPML.Stream.Parse+ , Text.OPML.Stream.Render+ , Text.OPML.Types+ build-depends:+ base >= 4.8 && < 5+ , case-insensitive+ , conduit+ , containers+ , data-default+ , exceptions+ , lens+ , monoid-subclasses+ , mono-traversable+ , network-uri+ , QuickCheck+ , quickcheck-instances+ , semigroups+ , text+ , time >= 1.5+ , timerep >= 2.0.0+ , xml-conduit >= 1.2.5+ , xml-types+ default-language: Haskell2010+ ghc-options: -Wall -fno-warn-unused-do-bind++test-suite tests+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs+ other-modules: Paths_opml_conduit+ build-depends:+ base >= 4.8+ , conduit+ , conduit-combinators+ , containers+ , exceptions+ , lens+ , mtl+ , network-uri+ , opml-conduit+ , resourcet+ , tasty+ , tasty-hunit+ , tasty-quickcheck+ , xml-conduit >= 1.2.5+ default-language: Haskell2010+ ghc-options: -Wall
+ test/Main.hs view
@@ -0,0 +1,151 @@+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE OverloadedStrings #-}+import Control.Lens.Fold+import Control.Lens.Getter+import Control.Monad.Catch.Pure+import Control.Monad.Identity+import Control.Monad.Trans.Resource++import Data.Conduit+import Data.Conduit.Combinators as Conduit hiding (length, map)+import Data.String+import Data.Tree+import Data.Version++import Paths_opml_conduit++import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck+import Text.OPML.Arbitrary ()+import Text.OPML.Stream.Parse+import Text.OPML.Stream.Render+import Text.OPML.Types+import Text.XML.Stream.Parse as XML+++main :: IO ()+main = defaultMain $ testGroup "Tests"+ [ unitTests+ , properties+ ]++unitTests :: TestTree+unitTests = testGroup "Unit tests"+ [ categoriesCase+ , directoryCase+ , placesCase+ , scriptCase+ , statesCase+ , subscriptionsCase+ ]++properties :: TestTree+properties = testGroup "Properties"+ [ inverseHeadProperty+ , inverseProperty+ ]++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 ^. opmlVersion_) @?= Version [2,0] []+ (result ^. head_ . opmlTitle_) @?= "Illustrating the category attribute"+ show (result ^. head_ . opmlCreated_) @?= "Just 2005-10-31 19:23:00 UTC"+ length (result ^.. outlines_ . traverse . traverse . _OpmlOutlineGeneric) @?= 1+ map (map length .levels) (result ^. outlines_) @?= [[1]]++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 ^. opmlVersion_) @?= Version [2,0] []+ (result ^. head_ . opmlTitle_) @?= "scriptingNewsDirectory.opml"+ show (result ^. head_ . opmlCreated_) @?= "Just 2005-10-13 15:34:07 UTC"+ show (result ^. head_ . modified_) @?= "Just 2005-10-25 21:33:57 UTC"+ (result ^. head_ . ownerName_) @?= "Dave Winer"+ (result ^. head_ . ownerEmail_) @?= "dwiner@yahoo.com"+ (result ^. head_ . expansionState_) @?= []+ (result ^. head_ . vertScrollState_) @?= Just 1+ (result ^. head_ . window_) @?= [(Top',105), (Left',466), (Bottom',386), (Right',964)]+ length (result ^.. outlines_ . traverse . traverse . _OpmlOutlineLink) @?= 8+ map (map length .levels) (result ^. outlines_) @?= [[1], [1], [1], [1], [1], [1], [1], [1]]++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 ^. opmlVersion_) @?= Version [2,0] []+ (result ^. head_ . opmlTitle_) @?= "placesLived.opml"+ show (result ^. head_ . opmlCreated_) @?= "Just 2006-02-27 12:09:48 UTC"+ show (result ^. head_ . modified_) @?= "Just 2006-02-27 12:11:44 UTC"+ (result ^. head_ . ownerName_) @?= "Dave Winer"+ show (result ^. head_ . ownerId_) @?= "Just http://www.opml.org/profiles/sendMail?usernum=1"+ (result ^. head_ . expansionState_) @?= [1,2,5,10,13,15]+ (result ^. head_ . vertScrollState_) @?= Just 1+ (result ^. head_ . window_) @?= [(Top',242), (Left',329), (Bottom',665), (Right',547)]+ length (result ^.. outlines_ . traverse . traverse . _OpmlOutlineGeneric) @?= 18+ length (result ^.. outlines_ . traverse . traverse . _OpmlOutlineLink) @?= 1+ map (map length .levels) (result ^. outlines_) @?= [[1,6,12]]+++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 ^. opmlVersion_) @?= Version [2,0] []+ (result ^. head_ . opmlTitle_) @?= "workspace.userlandsamples.doSomeUpstreaming"+ show (result ^. head_ . opmlCreated_) @?= "Just 2002-02-11 22:48:02 UTC"+ show (result ^. head_ . modified_) @?= "Just 2005-10-30 03:30:17 UTC"+ (result ^. head_ . ownerName_) @?= "Dave Winer"+ (result ^. head_ . ownerEmail_) @?= "dwiner@yahoo.com"+ (result ^. head_ . expansionState_) @?= [1, 2, 4]+ (result ^. head_ . vertScrollState_) @?= Just 1+ (result ^. head_ . window_) @?= [(Top', 74), (Left', 41), (Bottom', 314), (Right', 475)]+ length (result ^.. outlines_ . traverse . traverse . _OpmlOutlineGeneric) @?= 11+ map (map length .levels) (result ^. outlines_) @?= [[1,2,2], [1,2], [1], [1,1]]+++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 ^. opmlVersion_) @?= Version [2,0] []+ (result ^. head_ . opmlTitle_) @?= "states.opml"+ show (result ^. head_ . opmlCreated_) @?= "Just 2005-03-15 16:35:45 UTC"+ show (result ^. head_ . modified_) @?= "Just 2005-07-14 23:41:05 UTC"+ (result ^. head_ . ownerName_) @?= "Dave Winer"+ (result ^. head_ . ownerEmail_) @?= "dave@scripting.com"+ (result ^. head_ . expansionState_) @?= [1, 6, 13, 16, 18, 20]+ (result ^. head_ . vertScrollState_) @?= Just 1+ (result ^. head_ . window_) @?= [(Top', 106), (Left', 106), (Bottom', 558), (Right', 479)]+ length (result ^.. outlines_ . traverse . traverse . _OpmlOutlineGeneric) @?= 63+ map (map length .levels) (result ^. outlines_) @?= [[1, 8, 50, 4]]+++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 ^. opmlVersion_) @?= Version [2,0] []+ (result ^. head_ . opmlTitle_) @?= "mySubscriptions.opml"+ show (result ^. head_ . opmlCreated_) @?= "Just 2005-06-18 12:11:52 UTC"+ show (result ^. head_ . modified_) @?= "Just 2005-08-02 21:42:48 UTC"+ (result ^. head_ . ownerName_) @?= "Dave Winer"+ (result ^. head_ . ownerEmail_) @?= "dave@scripting.com"+ (result ^. head_ . vertScrollState_) @?= Just 1+ (result ^. head_ . window_) @?= [(Top', 61), (Left', 304), (Bottom', 562), (Right',842)]+ length (result ^.. outlines_ . traverse . traverse . _OpmlOutlineSubscription) @?= 13++inverseHeadProperty :: TestTree+inverseHeadProperty = testProperty "parse . render = id (on OpmlHead)" $ \opmlHead -> either (const False) (opmlHead ==) (runIdentity . runCatchT . runConduit $ renderOpmlHead opmlHead =$= force "Invalid OPML head" parseOpmlHead)++inverseProperty :: TestTree+inverseProperty = testProperty "parse . render = id" $ \opml -> either (const False) (opml ==) (runIdentity . runCatchT . runConduit $ renderOpml opml =$= force "Invalid OPML" parseOpml)