summaryrefslogtreecommitdiff
path: root/Text/OPML/Types.hs
diff options
context:
space:
mode:
authorkoral <>2016-01-01 22:46:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2016-01-01 22:46:00 (GMT)
commit6a01eed2a3771da22c2ee43cac67b30615ee8d3f (patch)
tree8f6cecdda1b0f8fda8be09cd7369b2fc7fc225c8 /Text/OPML/Types.hs
parente445a9532785843376a346dddea296bcf7983351 (diff)
version 0.4.0.00.4.0.0
Diffstat (limited to 'Text/OPML/Types.hs')
-rw-r--r--Text/OPML/Types.hs234
1 files changed, 52 insertions, 182 deletions
diff --git a/Text/OPML/Types.hs b/Text/OPML/Types.hs
index 8aa6a7a..ad9dbcd 100644
--- a/Text/OPML/Types.hs
+++ b/Text/OPML/Types.hs
@@ -1,10 +1,8 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE StandaloneDeriving #-}
-- | OPML is an XML format for outlines.
--
-- Example:
@@ -22,54 +20,23 @@
module Text.OPML.Types
( -- * Top-level OPML structure
Opml(..)
- , opmlVersion_
- , head_
- , outlines_
+ , mkOpml
-- * OPML header
, OpmlHead(..)
- , Direction(..)
- , opmlTitle_
- , opmlCreated_
- , modified_
- , ownerName_
- , ownerEmail_
- , ownerId_
- , docs_
- , expansionState_
- , vertScrollState_
- , window_
+ , mkOpmlHead
-- * 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.Hashable
-import Data.Hashable.Time ()
-import Data.HashMap.Lazy
import Data.List.NonEmpty
import Data.NonNull
import Data.Text
@@ -80,127 +47,64 @@ import Data.Version
import GHC.Generics
-import Network.URI
-
-import Test.QuickCheck
-import Text.OPML.Arbitrary
+import URI.ByteString
-- }}}
--- Orphan instance
-instance (Hashable a) => Hashable (NonNull a) where
- hashWithSalt s = hashWithSalt s . toNullable
-
-data Direction = Top' | Left' | Bottom' | Right' deriving(Eq, Generic, Show)
-
-instance Hashable Direction
-
-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_ :: HashMap Direction Int
- }
- |]
+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
+ , windowBottom :: Maybe Int
+ , windowLeft :: Maybe Int
+ , windowRight :: Maybe Int
+ , windowTop :: Maybe Int
+ }
deriving instance Eq OpmlHead
deriving instance Generic OpmlHead
deriving instance Show OpmlHead
--- instance Hashable 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
+-- | Bare 'OpmlHead', all fields are set to 'mempty'.
+mkOpmlHead :: OpmlHead
+mkOpmlHead = OpmlHead mempty mzero mzero mempty mempty mzero mzero mzero mzero mzero mzero mzero mzero
-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_ :: NonNull Text
- , isComment_ :: Maybe Bool
- , isBreakpoint_ :: Maybe Bool
- , outlineCreated_ :: Maybe UTCTime
- , categories_ :: [NonEmpty (NonNull Text)] -- ^
- }
- |]
+data OutlineBase = OutlineBase
+ { text :: NonNull Text
+ , isComment :: Maybe Bool
+ , isBreakpoint :: Maybe Bool
+ , outlineCreated :: Maybe UTCTime
+ , categories :: [NonEmpty (NonNull Text)] -- ^
+ }
deriving instance Eq OutlineBase
deriving instance Generic OutlineBase
deriving instance Show OutlineBase
-instance Hashable OutlineBase
-instance Arbitrary OutlineBase where
- arbitrary = OutlineBase <$> genNonNull
- <*> arbitrary
- <*> arbitrary
- <*> (unwrap <$> arbitrary)
- <*> (unwrap <$> arbitrary)
- shrink (OutlineBase _ b c d e) = OutlineBase <$> []
- <*> shrink b
- <*> shrink c
- <*> shrink d
- <*> (unwrap <$> shrink (OpmlGen e))
-- | Smart constructor for 'OutlineBase'.
mkOutlineBase :: NonNull 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
- }
- |]
+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 Hashable 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
@@ -208,58 +112,24 @@ mkOutlineSubscription uri = OutlineSubscription uri mzero mempty mempty mempty m
-- | Outlines are the main payload of an OPML document.
-declarePrisms [d|
- data OpmlOutline = OpmlOutlineGeneric OutlineBase Text
- | OpmlOutlineLink OutlineBase URI
- | OpmlOutlineSubscription OutlineBase OutlineSubscription
- |]
+data OpmlOutline = OpmlOutlineGeneric OutlineBase Text
+ | OpmlOutlineLink OutlineBase URI
+ | OpmlOutlineSubscription OutlineBase OutlineSubscription
deriving instance Eq OpmlOutline
deriving instance Generic OpmlOutline
deriving instance Show OpmlOutline
--- instance Hashable 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
- }
- |]
+data Opml = Opml
+ { opmlVersion :: Version
+ , opmlHead :: OpmlHead
+ , opmlOutlines :: Forest OpmlOutline
+ }
deriving instance Eq Opml
deriving instance Generic Opml
deriving instance Show Opml
--- instance Hashable Opml
-
-instance Default Opml where
- def = Opml (makeVersion [2, 0]) def mempty
-
-instance Arbitrary Opml where
- arbitrary = do
- degree <- choose (0, 100)
- Opml <$> (unwrap <$> arbitrary)
- <*> arbitrary
- <*> vectorOf degree (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
- degree <- choose (0, 100)
- case (n > 1, root) of
- (True, OpmlOutlineGeneric _ _) -> Node <$> pure root <*> vectorOf degree (genOutlineTree (n-1))
- (False, OpmlOutlineGeneric _ _) -> return $ Node root []
- _ -> return $ Node root []
+-- | Bare 'Opml'. Version is set to @2.0@.
+mkOpml :: Opml
+mkOpml = Opml (makeVersion [2, 0]) mkOpmlHead mempty