pinboard 0.9.5 → 0.9.6
raw patch · 9 files changed
+241/−139 lines, 9 filesdep ~http-clientPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: http-client
API changes (from Hackage documentation)
Files
- README.md +1/−1
- changelog.md +4/−0
- pinboard.cabal +7/−3
- src/Pinboard/Client.hs +1/−1
- tests/ApproxEq.hs +71/−0
- tests/Instances.hs +92/−0
- tests/PropJSON.hs +38/−0
- tests/Test.hs +27/−0
- tests/tests.hs +0/−134
README.md view
@@ -1,4 +1,4 @@-# Pinboard [](https://hackage.haskell.org/package/pinboard)+# Pinboard [](https://hackage.haskell.org/package/pinboard) [](https://travis-ci.org/jonschoning/pinboard) The Pinboard API is a way to interact programatically with your bookmarks, notes and other Pinboard data. This
changelog.md view
@@ -1,3 +1,7 @@+__v0.9.6__++add http-client bound+ __v0.9.5__ add JSON roundtrip tests
pinboard.cabal view
@@ -1,5 +1,5 @@ name: pinboard-version: 0.9.5+version: 0.9.6 synopsis: Access to the Pinboard API license: MIT license-file: LICENSE@@ -28,7 +28,7 @@ , containers , either , http-types- , http-client+ , http-client < 0.5.0 , http-client-tls , mtl >= 2.2.1 , old-locale@@ -60,8 +60,12 @@ test-suite tests ghc-options: -Wall -fno-warn-orphans type: exitcode-stdio-1.0- main-is: tests.hs+ main-is: Test.hs hs-source-dirs: tests+ other-modules: + ApproxEq+ Instances+ PropJSON build-depends: base >=4.6 && < 5.0, pinboard, bytestring,
src/Pinboard/Client.hs view
@@ -152,7 +152,7 @@ buildReq url = do req <- liftIO $ parseUrl $ "https://api.pinboard.in/v1/" <> url return $ req - { requestHeaders = [("User-Agent","pinboard.hs/0.9.5")]+ { requestHeaders = [("User-Agent","pinboard.hs/0.9.6")] , checkStatus = \_ _ _ -> Nothing }
+ tests/ApproxEq.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeOperators #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module ApproxEq where++import Data.Text (Text)+import Data.Time.Clock+import Test.QuickCheck+import GHC.Generics as G++(==~) :: (ApproxEq a, Show a) => a -> a -> Property+a ==~ b = counterexample (show a ++ " !=~ " ++ show b) (a =~ b)++class GApproxEq f where+ gApproxEq :: f a -> f a -> Bool++instance GApproxEq U1 where+ gApproxEq U1 U1 = True++instance (GApproxEq a, GApproxEq b) => GApproxEq (a :+: b) where+ gApproxEq (L1 a) (L1 b) = gApproxEq a b+ gApproxEq (R1 a) (R1 b) = gApproxEq a b+ gApproxEq _ _ = False++instance (GApproxEq a, GApproxEq b) => GApproxEq (a :*: b) where+ gApproxEq (a1 :*: b1) (a2 :*: b2) = gApproxEq a1 a2 && gApproxEq b1 b2++instance (ApproxEq a) => GApproxEq (K1 i a) where+ gApproxEq (K1 a) (K1 b) = a =~ b++instance (GApproxEq f) => GApproxEq (M1 i t f) where+ gApproxEq (M1 a) (M1 b) = gApproxEq a b++class ApproxEq a where+ (=~) :: a -> a -> Bool+ default (=~) :: (Generic a, GApproxEq (Rep a)) => a -> a -> Bool+ a =~ b = gApproxEq (G.from a) (G.from b)++instance ApproxEq Text where+ (=~) = (==)++instance ApproxEq Char where+ (=~) = (==)++instance ApproxEq Bool where+ (=~) = (==)++instance ApproxEq Int where+ (=~) = (==)++instance ApproxEq Double where+ (=~) = (==)++instance ApproxEq a => ApproxEq (Maybe a)++instance ApproxEq UTCTime where+ (=~) = (==)++instance ApproxEq a => ApproxEq [a] where+ as =~ bs = and (zipWith (=~) as bs)++instance (ApproxEq l, ApproxEq r) => ApproxEq (Either l r) where+ Left a =~ Left b = a =~ b+ Right a =~ Right b = a =~ b+ _ =~ _ = False++instance (ApproxEq l, ApproxEq r) => ApproxEq (l, r) where+ (=~) (l1,r1) (l2,r2) = l1 =~ l2 && r1 =~ r2
+ tests/Instances.hs view
@@ -0,0 +1,92 @@+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]
+ tests/PropJSON.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ConstraintKinds #-}++module PropJSON where++import Data.Aeson+import Data.Aeson.Types (parseEither)+import Data.Monoid ((<>))+import Data.Typeable (Proxy(..), typeOf, Typeable)+import qualified Data.ByteString.Lazy.Char8 as BL8+import Test.Hspec+import Test.QuickCheck+import Test.QuickCheck.Property+import Test.Hspec.QuickCheck (prop)++import ApproxEq++type ArbitraryJSON a = (Arbitrary a, ToJSON a, FromJSON a, Show a, Typeable a)++propJSON :: forall a b. (ArbitraryJSON a, Testable b) + => String+ -> (a -> a -> b) + -> Proxy a + -> Spec+propJSON eqDescr eq _ = prop (show (typeOf (undefined :: a)) <> " FromJSON/ToJSON roundtrip " <> eqDescr) $ \(x :: a) ->+ let actual = parseEither parseJSON (toJSON x)+ expected = Right x+ failMsg = "ACTUAL: " <> show actual <> "\nJSON: " <> BL8.unpack (encode x)+ in counterexample failMsg $ either reject property (eq <$> actual <*> expected)+ where reject = property . const rejected++propJSONEq :: (ArbitraryJSON a, Eq a) => Proxy a -> Spec+propJSONEq = propJSON "(Eq)" (==) ++propJSONApproxEq :: (ArbitraryJSON a, ApproxEq a) => Proxy a -> Spec+propJSONApproxEq = propJSON "(ApproxEq)" (==~) +
+ tests/Test.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE ScopedTypeVariables #-}++module Main where++import Data.Time.Clock (UTCTime(..))+import Data.Typeable (Proxy(..))+import Test.Hspec+import Test.Hspec.QuickCheck (prop)++import PropJSON+import Instances()++import Pinboard++main :: IO ()+main = hspec $ do+ prop "UTCTime" $ \(x :: UTCTime) -> (readNoteTime . showNoteTime) x == x+ describe "JSON instances" $ do+ propJSONEq (Proxy :: Proxy UTCTime)+ propJSONEq (Proxy :: Proxy Post)+ propJSONEq (Proxy :: Proxy Posts)+ propJSONEq (Proxy :: Proxy Note)+ propJSONEq (Proxy :: Proxy NoteList)+ propJSONEq (Proxy :: Proxy NoteListItem)+ propJSONEq (Proxy :: Proxy JsonTagMap)+ propJSONEq (Proxy :: Proxy Suggested)+ propJSONApproxEq (Proxy :: Proxy PostDates)
− tests/tests.hs
@@ -1,134 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE FlexibleContexts #-}--module Main where--import Data.Aeson-import Data.Aeson.Types (parseEither)-import Data.Char (isSpace)-import Data.Monoid-import Data.Text (Text, pack)-import Data.List-import Data.Ord-import Data.Time.Calendar (Day(..))-import Data.Time.Clock (UTCTime(..), secondsToDiffTime)-import Data.Typeable-import Test.Hspec-import Test.Hspec.QuickCheck (prop)-import Test.QuickCheck-import qualified Data.ByteString.Lazy.Char8 as BL8-import qualified Data.HashMap.Strict as HM-import qualified Data.Set as Set--import ApproxEq--import Pinboard--propJSON :: forall a b. (Arbitrary a, ToJSON a, FromJSON a, Show a, Typeable a, Testable b) - => (Either String a -> Either String a -> b) - -> Proxy a - -> Spec-propJSON eq _ = prop (show (typeOf (undefined :: a)) <> " FromJSON/ToJSON roundtrip") $ \(x :: a) ->- let actual = parseEither parseJSON (toJSON x)- expected = Right x- failMsg = "ACTUAL: " <> show actual <> "\nJSON: " <> BL8.unpack (encode x)- in counterexample failMsg (actual `eq` expected)--propJSONEq :: forall a. (Arbitrary a, ToJSON a, FromJSON a, Show a, Typeable a, Eq a) => Proxy a -> Spec-propJSONEq = propJSON (==)--propJSONApproxEq :: forall a. (Arbitrary a, ToJSON a, FromJSON a, Show a, Typeable a, ApproxEq a) => Proxy a -> Spec-propJSONApproxEq = propJSON (==~)--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 PostDates where- (=~) a b =- postDatesUser a == postDatesUser b- && postDatesTag a == postDatesTag b- && sorted (postDatesCount a) == sorted (postDatesCount b)- where sorted = sortBy (comparing fst <> comparing snd)--instance Arbitrary Suggested where- arbitrary = arbitrary >>= \a -> elements [Popular a, Recommended a]--main :: IO ()-main = hspec $ do- prop "UTCTime" $ \(x :: UTCTime) -> (readNoteTime . showNoteTime) x == x- describe "JSON instances" $ do- propJSONEq (Proxy :: Proxy UTCTime)- propJSONEq (Proxy :: Proxy Post)- propJSONEq (Proxy :: Proxy Posts)- propJSONEq (Proxy :: Proxy Note)- propJSONEq (Proxy :: Proxy NoteList)- propJSONEq (Proxy :: Proxy NoteListItem)- propJSONEq (Proxy :: Proxy JsonTagMap)- propJSONEq (Proxy :: Proxy Suggested)- propJSONApproxEq (Proxy :: Proxy PostDates)