pinboard 0.9.4 → 0.9.5

raw patch · 5 files changed

+170/−14 lines, 5 filesdep +QuickCheckdep +hspecdep +pinboardPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: QuickCheck, hspec, pinboard, semigroups

API changes (from Hackage documentation)

Files

• changelog.md +4/−0
• pinboard.cabal +23/−2
• src/Pinboard/ApiTypes.hs +1/−1
• src/Pinboard/Client.hs +8/−11
• tests/tests.hs +134/−0

@@ -1,3 +1,7 @@+__v0.9.5__++add JSON roundtrip tests+ __v0.9.4__  derive generic

@@ -1,5 +1,5 @@ name:                pinboard-version:             0.9.4+version:             0.9.5 synopsis:            Access to the Pinboard API license:             MIT license-file:        LICENSE@@ -53,10 +53,31 @@                        Pinboard.Error                        Pinboard.Types                        Pinboard.Util-  ghc-options:         -Wall -rtsopts+  ghc-options:         -Wall                        -fwarn-incomplete-patterns                        -funbox-strict-fields                        -fexpose-all-unfoldings+test-suite tests+  ghc-options: -Wall -fno-warn-orphans+  type: exitcode-stdio-1.0+  main-is: tests.hs+  hs-source-dirs: tests+  build-depends:       base >=4.6 && < 5.0,+                       pinboard,+                       bytestring,+                       containers,+                       hspec                >= 1.8 ,+                       text,+                       time,+                       aeson,+                       semigroups,+                       QuickCheck,+                       mtl >= 2.2.1,+                       unordered-containers,+                       transformers >= 0.4.0.0+  ghc-options:         -Wall +                       -fno-warn-orphans+  default-language:    Haskell2010  source-repository head   type:     git

@@ -206,7 +206,7 @@     , "hash"       .= toJSON noteHash     , "title"      .= toJSON noteTitle     , "text"       .= toJSON noteText-    , "length"     .= toJSON (show noteLength)+    , "length"     .= toJSON noteLength     , "created_at" .= toJSON (showNoteTime noteCreatedAt)     , "updated_at" .= toJSON (showNoteTime noteUpdatedAt) ] 

@@ -43,9 +43,7 @@     ,createParserErr     ,httpStatusPinboardError      -- * Client Dependencies-    , module Pinboard.Error-    , module Pinboard.Types-    , module Pinboard.Util+    , module X     ) where  @@ -67,9 +65,9 @@ import           Network.HTTP.Client.TLS  -import Pinboard.Types-import Pinboard.Error-import Pinboard.Util+import Pinboard.Types as X+import Pinboard.Error as X+import Pinboard.Util as X  import qualified Data.ByteString.Lazy        as LBS import qualified Data.Text                   as T@@ -127,7 +125,7 @@     responseBody r <$ checkStatusCodeResponse r  runPinboardSingleJson-    :: (Functor m, MonadIO m, FromJSON a)+    :: (MonadIO m, FromJSON a)     => PinboardConfig            -> PinboardRequest     -> m (Either PinboardError a)@@ -146,8 +144,7 @@                       , "?"                        , T.decodeUtf8 $ paramsToByteString $ ("auth_token", urlEncode False apiToken) : encodeParams requestParams ]    req <- buildReq $ T.unpack url-   res <- liftIO $ httpLbs req mgr-   return res+   liftIO $ httpLbs req mgr  -------------------------------------------------------------------------------- @@ -155,7 +152,7 @@ buildReq url = do   req <- liftIO $ parseUrl $ "https://api.pinboard.in/v1/" <> url   return $ req -    { requestHeaders = [("User-Agent","pinboard.hs/0.9.4")]+    { requestHeaders = [("User-Agent","pinboard.hs/0.9.5")]     , checkStatus = \_ _ _ -> Nothing     } @@ -177,7 +174,7 @@     -> m a decodeJSONResponse s =    let r = eitherDecodeStrict' (LBS.toStrict s) -  in either (throwError . createParserErr . toText) (return . id) r+  in either (throwError . createParserErr . toText) return r  -------------------------------------------------------------------------------- 

@@ -0,0 +1,134 @@+{-# 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)