summaryrefslogtreecommitdiff
path: root/Text/OPML/Types.hs
diff options
context:
space:
mode:
authorkoral <>2015-05-09 10:07:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2015-05-09 10:07:00 (GMT)
commitec463807470396ad4ebf364e741a87fb740492ca (patch)
treec850c9724e267c68180e5294e052aec99535c501 /Text/OPML/Types.hs
parenta1e6694f40a0bbc0e8736f9a9c69d08afc313382 (diff)
version 0.2.0.00.2.0.0
Diffstat (limited to 'Text/OPML/Types.hs')
-rw-r--r--Text/OPML/Types.hs47
1 files changed, 34 insertions, 13 deletions
diff --git a/Text/OPML/Types.hs b/Text/OPML/Types.hs
index 2de5f64..8aa6a7a 100644
--- a/Text/OPML/Types.hs
+++ b/Text/OPML/Types.hs
@@ -67,8 +67,11 @@ import Control.Lens.TH
import Control.Monad
import Data.Default
-import Data.Map
-import Data.NotEmpty
+import Data.Hashable
+import Data.Hashable.Time ()
+import Data.HashMap.Lazy
+import Data.List.NonEmpty
+import Data.NonNull
import Data.Text
import Data.Time.Clock
import Data.Time.LocalTime ()
@@ -83,7 +86,13 @@ import Test.QuickCheck
import Text.OPML.Arbitrary
-- }}}
-data Direction = Top' | Left' | Bottom' | Right' deriving(Eq, Generic, Ord, Show)
+-- 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']
@@ -101,13 +110,14 @@ declareLenses [d|
, docs_ :: Maybe URI
, expansionState_ :: [Int]
, vertScrollState_ :: Maybe Int
- , window_ :: Map Direction Int
+ , window_ :: HashMap Direction 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
@@ -137,28 +147,33 @@ instance Arbitrary OpmlHead where
declareLenses [d|
data OutlineBase = OutlineBase
- { text_ :: NE Text
+ { text_ :: NonNull Text
, isComment_ :: Maybe Bool
, isBreakpoint_ :: Maybe Bool
, outlineCreated_ :: Maybe UTCTime
- , categories_ :: [[NE Text]]
+ , 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 <$> arbitrary
+ arbitrary = OutlineBase <$> genNonNull
<*> arbitrary
<*> arbitrary
<*> (unwrap <$> arbitrary)
<*> (unwrap <$> arbitrary)
- shrink = genericShrink
+ shrink (OutlineBase _ b c d e) = OutlineBase <$> []
+ <*> shrink b
+ <*> shrink c
+ <*> shrink d
+ <*> (unwrap <$> shrink (OpmlGen e))
-- | Smart constructor for 'OutlineBase'.
-mkOutlineBase :: NE Text -> OutlineBase
+mkOutlineBase :: NonNull Text -> OutlineBase
mkOutlineBase t = OutlineBase t mzero mzero mzero mzero
@@ -176,6 +191,7 @@ declareLenses [d|
deriving instance Eq OutlineSubscription
deriving instance Generic OutlineSubscription
deriving instance Show OutlineSubscription
+-- instance Hashable OutlineSubscription
instance Arbitrary OutlineSubscription where
arbitrary = OutlineSubscription <$> (unwrap <$> arbitrary)
@@ -201,6 +217,7 @@ declarePrisms [d|
deriving instance Eq OpmlOutline
deriving instance Generic OpmlOutline
deriving instance Show OpmlOutline
+-- instance Hashable OpmlOutline
instance Arbitrary OpmlOutline where
arbitrary = oneof [ OpmlOutlineGeneric <$> arbitrary <*> arbitrary
@@ -223,14 +240,17 @@ declareLenses [d|
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 = Opml <$> (unwrap <$> arbitrary)
- <*> arbitrary
- <*> listOf (genOutlineTree 1)
+ 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.
@@ -238,7 +258,8 @@ instance Arbitrary Opml where
genOutlineTree :: Int -> Gen (Tree OpmlOutline)
genOutlineTree n = do
root <- arbitrary
+ degree <- choose (0, 100)
case (n > 1, root) of
- (True, OpmlOutlineGeneric _ _) -> Node <$> pure root <*> listOf (genOutlineTree (n-1))
+ (True, OpmlOutlineGeneric _ _) -> Node <$> pure root <*> vectorOf degree (genOutlineTree (n-1))
(False, OpmlOutlineGeneric _ _) -> return $ Node root []
_ -> return $ Node root []