93 lines
2.5 KiB
Haskell
93 lines
2.5 KiB
Haskell
module Instances where
|
|
|
|
import Data.Text (Text, pack)
|
|
import Data.Char (isSpace)
|
|
import Data.List (sort)
|
|
import Data.Time.Calendar (Day(..))
|
|
import Data.Time.Clock (UTCTime(..), secondsToDiffTime)
|
|
import Test.QuickCheck
|
|
import qualified Data.HashMap.Strict as HM
|
|
import qualified Data.Set as Set
|
|
|
|
import ApproxEq
|
|
import Pinboard
|
|
|
|
instance Arbitrary Text where
|
|
arbitrary = pack <$> arbitrary
|
|
|
|
instance Arbitrary Day where
|
|
arbitrary = ModifiedJulianDay . (2000 +) <$> arbitrary
|
|
shrink = (ModifiedJulianDay <$>) . shrink . toModifiedJulianDay
|
|
|
|
instance Arbitrary UTCTime where
|
|
arbitrary =
|
|
UTCTime <$> arbitrary <*> (secondsToDiffTime <$> choose (0, 86401))
|
|
|
|
instance Arbitrary Note where
|
|
arbitrary =
|
|
Note <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*>
|
|
arbitrary <*>
|
|
arbitrary
|
|
|
|
instance Arbitrary NoteList where
|
|
arbitrary = NoteList <$> arbitrary <*> resize 15 arbitrary
|
|
|
|
instance Arbitrary NoteListItem where
|
|
arbitrary =
|
|
NoteListItem <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*>
|
|
arbitrary
|
|
|
|
instance Arbitrary Posts where
|
|
arbitrary = Posts <$> arbitrary <*> arbitrary <*> resize 15 arbitrary
|
|
|
|
instance Arbitrary Post where
|
|
arbitrary =
|
|
Post <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*>
|
|
arbitrary <*>
|
|
arbitrary <*>
|
|
arbitrary <*>
|
|
arbitraryTags
|
|
|
|
instance Arbitrary JsonTagMap where
|
|
arbitrary =
|
|
ToJsonTagMap <$>
|
|
(HM.fromList <$> listOf ((,) <$> arbitraryTag <*> arbitrary))
|
|
|
|
arbitraryTags :: Gen [Tag]
|
|
arbitraryTags = listOf arbitraryTag
|
|
|
|
arbitraryTag :: Gen Tag
|
|
arbitraryTag =
|
|
pack <$>
|
|
listOf1 (arbitrary `suchThat` (\c -> (not . isSpace) c && (',' /= c)))
|
|
|
|
-- | Checks if a given list has no duplicates in _O(n log n)_.
|
|
hasNoDups
|
|
:: (Ord a)
|
|
=> [a] -> Bool
|
|
hasNoDups = go Set.empty
|
|
where
|
|
go _ [] = True
|
|
go s (x:xs)
|
|
| s' <- Set.insert x s
|
|
, Set.size s' > Set.size s = go s' xs
|
|
| otherwise = False
|
|
|
|
instance Arbitrary PostDates where
|
|
arbitrary =
|
|
PostDates <$> arbitrary <*> arbitrary <*>
|
|
(arbitrary `suchThat` isValidDateCount)
|
|
where
|
|
isValidDateCount xs = hasNoDups (fst <$> xs) && all (> 0) (snd <$> xs)
|
|
|
|
instance ApproxEq Day where
|
|
(=~) = (==)
|
|
|
|
instance ApproxEq PostDates where
|
|
(=~) a b =
|
|
postDatesUser a =~ postDatesUser b &&
|
|
postDatesTag a =~ postDatesTag b &&
|
|
sort (postDatesCount a) =~ sort (postDatesCount b)
|
|
|
|
instance Arbitrary Suggested where
|
|
arbitrary = arbitrary >>= \a -> elements [Popular a, Recommended a]
|