pinboard 0.6.2.2 → 0.6.3

raw patch · 3 files changed

+89/−7 lines, 3 filesdep +haskell-src-extsdep +vectorPVP ok

version bump matches the API change (PVP)

Dependencies added: haskell-src-exts, vector

API changes (from Hackage documentation)

Files

• pinboard.cabal +3/−1
• src/Pinboard/ApiTypes.hs +85/−5
• src/Pinboard/Client.hs +1/−1

@@ -1,5 +1,5 @@ name:                pinboard-version:             0.6.2.2+version:             0.6.3 synopsis:            Access to the Pinboard API license:             MIT license-file:        LICENSE@@ -37,6 +37,7 @@                      , bytestring                      , containers                      , either+                     , haskell-src-exts                      , HsOpenSSL                      , http-streams                      , http-types@@ -49,6 +50,7 @@                      , time < 1.5                      , transformers                      , unordered-containers+                     , vector                  default-language:    Haskell2010   other-modules:       

@@ -1,6 +1,8 @@ {-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}  -- | -- Module      : Pinboard.ApiTypes@@ -10,20 +12,24 @@ -- Portability : POSIX module Pinboard.ApiTypes where -import Data.Aeson          (FromJSON (parseJSON), Value (String, Object), ( .:))+import Data.Aeson           import Data.Aeson.Types    (Parser) import Data.HashMap.Strict (HashMap, member, toList) import Data.Data           (Data, Typeable)-import Data.Text           (Text, words, unpack)+import Data.Text           (Text, words, unwords, unpack, pack) import Data.Time           (UTCTime) import Data.Time.Calendar  (Day)-import Data.Time.Format    (readTime)+import Data.Time.Format    (readTime, formatTime) import System.Locale       (defaultTimeLocale)+import Language.Haskell.Exts.Parser+import Language.Haskell.Exts.Pretty import qualified Data.HashMap.Strict as HM+import qualified Data.Vector as V  import Control.Applicative -import Prelude hiding      (words)+import Prelude hiding      (words, unwords) + -- * Posts  data Posts = Posts {@@ -39,6 +45,12 @@              <*> o .: "posts"    parseJSON _ = error "bad parse" +instance ToJSON Posts where+  toJSON Posts{..} = object +    [ "date"  .= toJSON postsDate+    , "user"  .= toJSON postsUser+    , "posts" .= toJSON postsPosts ]+ data Post = Post {       postHref         :: Text     , postDescription  :: Text@@ -64,10 +76,26 @@             <*> (words <$> o .: "tags")    parseJSON _ = error "bad parse" +instance ToJSON Post where+  toJSON Post{..} = object +    [ "href"        .= toJSON postHref+    , "description" .= toJSON postDescription+    , "extended"    .= toJSON postExtended+    , "meta"        .= toJSON postMeta+    , "hash"        .= toJSON postHash+    , "time"        .= toJSON postTime+    , "shared"      .= boolToYesNo postShared+    , "toread"      .= boolToYesNo postToread+    , "tags"        .= unwords postTags ]+ boolFromYesNo :: Text -> Bool boolFromYesNo "yes" = True boolFromYesNo _     = False +boolToYesNo :: Bool -> Text+boolToYesNo True = "yes"+boolToYesNo _    = "no"+ data PostDates = PostDates {       postDatesUser     :: Text     , postDatesTag      :: Text@@ -87,6 +115,13 @@        parseDates _ = []    parseJSON _ = error "bad parse" +instance ToJSON PostDates where+  toJSON PostDates{..} = object +    [ "user"  .= toJSON postDatesUser+    , "tag"   .= toJSON postDatesTag+    , "dates" .= object (dateCountToPair <$> postDatesCount) ]+      where dateCountToPair (day, count) = ((pack.show) day, String $ (pack.show) count)+ type DateCount = (Day, Int)  @@ -103,6 +138,11 @@                 <*> o .: "notes"    parseJSON _ = error "bad parse" +instance ToJSON NoteList where+  toJSON NoteList{..} = object +    [ "count" .= toJSON noteListCount+    , "notes" .= toJSON noteListItems ]+ data NoteListItem = NoteListItem {       noteListItemId     :: Text     , noteListItemHash   :: Text@@ -122,6 +162,14 @@                     <*> (readNoteTime <$> o .: "updated_at")    parseJSON _ = error "bad parse" +instance ToJSON NoteListItem where+  toJSON NoteListItem{..} = object +    [ "id"         .= toJSON noteListItemId+    , "hash"       .= toJSON noteListItemHash+    , "title"      .= toJSON noteListItemTitle+    , "length"     .= toJSON (show noteListItemLength)+    , "created_at" .= toJSON (showNoteTime noteListItemCreatedAt)+    , "updated_at" .= toJSON (showNoteTime noteListItemUpdatedAt) ]   data Note = Note {@@ -145,9 +193,21 @@             <*> (readNoteTime <$> o .: "updated_at")    parseJSON _ = error "bad parse" +instance ToJSON Note where+  toJSON Note{..} = object +    [ "id"         .= toJSON noteId+    , "hash"       .= toJSON noteHash+    , "title"      .= toJSON noteTitle+    , "text"       .= toJSON noteText+    , "length"     .= toJSON (show noteLength)+    , "created_at" .= toJSON (showNoteTime noteCreatedAt)+    , "updated_at" .= toJSON (showNoteTime noteUpdatedAt) ]+ readNoteTime :: String -> UTCTime readNoteTime = readTime defaultTimeLocale "%F %T" +showNoteTime :: UTCTime -> String+showNoteTime = formatTime defaultTimeLocale "%F %T"  -- * Tags @@ -161,7 +221,10 @@     where toTags (Object o) = ToJsonTagMap $ HM.map (\(String s)-> read (unpack s)) o           toTags _ = error "bad parse" +instance ToJSON JsonTagMap where+  toJSON (ToJsonTagMap o) = toJSON $ show <$> o + data Suggested = Popular [Text]                | Recommended [Text]     deriving (Show, Eq, Data, Typeable, Ord)@@ -174,6 +237,13 @@    parseJSON _ = error "bad parse"  +instance ToJSON [Suggested] where+  toJSON xs = Array $ toJSON <$> V.fromList xs++instance ToJSON Suggested where+  toJSON (Popular tags)     = object [ "popular" .= toJSON tags]+  toJSON (Recommended tags) = object [ "recommended" .= toJSON tags]+ -- * Scalars  newtype DoneResult = ToDoneResult {fromDoneResult :: ()}@@ -200,6 +270,16 @@ instance FromJSON UpdateTime where   parseJSON (Object o) = ToUpdateTime <$> (o .: "update_time")   parseJSON _ = error "bad parse"++-- * Pretty++prettyString :: String -> String+prettyString s = case parseExp s of+    ParseOk x -> prettyPrint x+    ParseFailed{} -> s++pretty :: Show a => a -> String+pretty = prettyString . show  -- * Aliases 

@@ -160,7 +160,7 @@ buildReq url = buildRequest $ do   http GET ("/v1/" <> url)   setHeader "Connection" "Keep-Alive"  -  setHeader "User-Agent" "pinboard.hs/0.6.2"  +  setHeader "User-Agent" "pinboard.hs/0.6.3"    --------------------------------------------------------------------------------