libstackexchange 0.1.0.0 → 0.2.0.0

raw patch · 9 files changed

+374/−327 lines, 9 filesdep +aeson-lensdep −HUnitdep −QuickCheckdep −doctestdep ~basedep ~lensPVP ok

version bump matches the API change (PVP)

Dependencies added: aeson-lens

Dependencies removed: HUnit, QuickCheck, doctest, libstackexchange, template-haskell

Dependency ranges changed: base, lens

API changes (from Hackage documentation)

Files

• doctests.hs +0/−8
• libstackexchange.cabal +2/−46
• src/Network/StackExchange/API.hs +288/−17
• src/Network/StackExchange/Auth.hs +17/−6
• src/Network/StackExchange/Request.hs +57/−46
• src/Network/StackExchange/Response.hs +10/−43
• tests/aeson-lens/Main.hs +0/−61
• tests/aeson-lens/TH.hs +0/−14
• tests/request/Main.hs +0/−86

@@ -1,8 +0,0 @@-{-# LANGUAGE UnicodeSyntax #-}-module Main where--import Test.DocTest---main ∷ IO ()-main = doctest ["-isrc", "-XOverloadedStrings", "src/Network/StackExchange/API.hs"]

@@ -1,5 +1,5 @@ name:          libstackexchange-version:       0.1.0.0+version:       0.2.0.0 synopsis:      StackExchange API interface description:   Provides interface for StackExchange v2.1 API homepage:      https://github.com/supki/libstackexchange@@ -11,11 +11,6 @@ build-type:    Simple cabal-version: >= 1.8 -flag enable-examples-  default: False-flag enable-doctests-  default: False- library   build-depends: base >= 4.6 && < 5,                  bytestring,@@ -24,6 +19,7 @@                  attoparsec,                  text,                  aeson,+                 aeson-lens,                  http-conduit,                  lens >= 3.0.4   hs-source-dirs: src@@ -32,45 +28,5 @@                    Network.StackExchange.Auth                    Network.StackExchange.Request                    Network.StackExchange.Response-  ghc-options: -Wall-               -fno-warn-unused-do-bind--test-suite aeson-lens-  build-depends: base >= 4.6,-                 template-haskell,-                 bytestring,-                 attoparsec,-                 aeson,-                 lens,-                 HUnit,-                 libstackexchange-  type: exitcode-stdio-1.0-  main-is: Main.hs-  hs-source-dirs: tests/aeson-lens-  other-modules: TH-  ghc-options: -Wall-               -fno-warn-unused-do-bind--test-suite request-  build-depends: base >= 4.6,-                 containers,-                 text,-                 QuickCheck,-                 libstackexchange-  type: exitcode-stdio-1.0-  main-is: Main.hs-  hs-source-dirs: tests/request-  ghc-options: -Wall-               -fno-warn-unused-do-bind--test-suite api-  build-depends: base >= 4.6,-                 doctest >= 0.8,-                 http-conduit,-                 libstackexchange-  if !flag(enable-doctests)-    buildable: False-  type:          exitcode-stdio-1.0-  main-is: doctests.hs   ghc-options: -Wall                -fno-warn-unused-do-bind

@@ -81,12 +81,14 @@   , writePermissions, meWritePermissions   ) where +import Control.Applicative ((<$>)) import Data.Monoid ((<>))  import           Control.Exception (throw)-import           Control.Lens ((^!))+import           Control.Lens ((^.)) import           Data.Aeson (Value) import qualified Data.Aeson as A+import qualified Data.Aeson.Lens as L import qualified Data.Attoparsec.Lazy as AP import           Data.ByteString.Lazy (ByteString) import           Data.Text.Lazy (Text)@@ -98,7 +100,11 @@ import Network.StackExchange.Request  -- $setup--- >>> let t = site "stackoverflow" <> key "Lhg6xe5d5BvNK*C0S8jijA(("+-- >>> let pagesize = 10 :: Int+-- >>> let checkLengthM f = ((== pagesize) . length) `fmap` f+-- >>> let k = key "Lhg6xe5d5BvNK*C0S8jijA(("+-- >>> let s = site "stackoverflow"+-- >>> let q = query [("pagesize", "10")]  -------------------------- -- Access Tokens@@ -129,23 +135,29 @@ -- Answers -------------------------- +-- $answers+-- >>> checkLengthM $ askSE (answers <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/answers>------ >>> fmap length $ askSE (answers <> t)--- 30 answers ∷ Request a "answers" [SE Answer] answers = path "answers" <> parse (attoparsec items ".answers: ")  --- | <https://api.stackexchange.com/docs/answers-by-ids>------ >>> fmap length $ askSE (answersByIds [6841479, 215422, 8881376] <> t)+-- $answersByIds+-- >>> length `fmap` askSE (answersByIds [6841479, 215422, 8881376] <> s <> k) -- 3++-- | <https://api.stackexchange.com/docs/answers-by-ids> answersByIds ∷ [Int] → Request a "answersByIds" [SE Answer] answersByIds (T.intercalate ";" . map (toLazyText . decimal) → is) =   path ("answers/" <> is) <> parse (attoparsec items ".answers/{ids}: ")  +-- $answersOnUsers+-- >>> checkLengthM $ askSE (answersOnUsers [972985] <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/answers-on-users> answersOnUsers ∷ [Int] → Request a "answersOnUsers" [SE Answer] answersOnUsers (T.intercalate ";" . map (toLazyText . decimal) → is) =@@ -153,6 +165,10 @@   parse (attoparsec items ".users/{ids}/answers: ")  +-- $answersOnQuestions+-- >>> checkLengthM $ askSE (answersOnQuestions [394601] <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/answers-on-questions> answersOnQuestions ∷ [Int] → Request a "answersOnQuestions" [SE Answer] answersOnQuestions (T.intercalate ";" . map (toLazyText . decimal) → is) =@@ -165,6 +181,9 @@ meAnswers =   path "me/answers" <> parse (attoparsec items ".me/answers: ") +-- $topUserAnswersInTags+-- >>> checkLengthM $ askSE (topUserAnswersInTags 1097181 ["haskell"] <> s <> k <> q)+-- True  -- | <https://api.stackexchange.com/docs/top-user-answers-in-tags> topUserAnswersInTags ∷ Int → [Text] → Request a "topUserAnswersInTags" [SE Answer]@@ -184,30 +203,50 @@ -- Badges -------------------------- +-- $badges+-- >>> checkLengthM $ askSE (badges <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/badges> badges ∷ Request a "badges" [SE Badge] badges = path "badges" <> parse (attoparsec items ".badges: ")  +-- $badgesByIds+-- >>> length `fmap` askSE (badgesByIds [20] <> s <> k <> q)+-- 1+ -- | <https://api.stackexchange.com/docs/badges-by-ids> badgesByIds ∷ [Int] → Request a "badgesByIds" [SE Badge] badgesByIds (T.intercalate ";" . map (toLazyText . decimal) → is) =   path ("badges/" <> is) <> parse (attoparsec items ".badges/{ids}: ")  +-- $badgeRecipientsByIds+-- >>> checkLengthM $ askSE (badgeRecipientsByIds [20] <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/badge-recipients-by-ids> badgeRecipientsByIds ∷ [Int] → Request a "badgeRecipientsByIds" [SE Badge] badgeRecipientsByIds (T.intercalate ";" . map (toLazyText . decimal) → is) =-  path ("badges" <> is <> "/recipients") <>+  path ("badges/" <> is <> "/recipients") <>   parse (attoparsec items ".badges/{ids}/recipients: ")  +-- $badgesByName+-- >>> checkLengthM $ askSE (badgesByName <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/badges-by-name> badgesByName ∷ Request a "badgesByName" [SE Badge] badgesByName =   path ("badges" <> "/name") <> parse (attoparsec items ".badges/name: ")  +-- $badgeRecipients+-- >>> checkLengthM $ askSE (badgeRecipients <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/badge-recipients> badgeRecipients ∷ Request a "badgeRecipients" [SE Badge] badgeRecipients =@@ -215,12 +254,20 @@   parse (attoparsec items ".badges/recipients: ")  +-- $badgesByTag+-- >>> checkLengthM $ askSE (badgesByTag <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/badges-by-tag> badgesByTag ∷ Request a "badgesByTag" [SE Badge] badgesByTag =   path ("badges" <> "/tags") <> parse (attoparsec items ".badges/tags: ")  +-- $badgesOnUsers+-- >>> checkLengthM $ askSE (badgesOnUsers [1097181] <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/badges-on-users> badgesOnUsers ∷ [Int] → Request a "badgesOnUsers" [SE Badge] badgesOnUsers (T.intercalate ";" . map (toLazyText . decimal) → is) =@@ -238,6 +285,10 @@ -- Comments -------------------------- +-- $commentsOnAnswers+-- >>> checkLengthM $ askSE (commentsOnAnswers [394837] <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/comments-on-answers> commentsOnAnswers ∷ [Int] → Request a "commentsOnAnswers" [SE Comment] commentsOnAnswers (T.intercalate ";" . map (toLazyText . decimal) → is) =@@ -245,6 +296,10 @@   parse (attoparsec items ".answers/{ids}/comments: ")  +-- $comments+-- >>> checkLengthM $ askSE (comments <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/comments> comments ∷ Request a "comments" [SE Comment] comments = path "comments" <> parse (attoparsec items ".comments: ")@@ -261,15 +316,23 @@ editComment (toLazyText . decimal → i) body =   path ("comments/" <> i <> "/edit") <>   query [("body", body)] <>-  parse (attoparsec (return . SE) ".comments/{id}/edit:")+  parse (attoparsec (fmap SE) ".comments/{id}/edit:")  +-- $commentsByIds+-- >>> length `fmap` askSE (commentsByIds [1218390] <> s <> k)+-- 1+ -- | <https://api.stackexchange.com/docs/comments-by-ids> commentsByIds ∷ [Int] → Request a "commentsByIds" [SE Comment] commentsByIds (T.intercalate ";" . map (toLazyText . decimal) → is) =   path ("comments/" <> is) <> parse (attoparsec items ".comments/{ids}: ")  +-- $commentsOnPosts+-- >>> checkLengthM $ askSE (commentsOnPosts [394837] <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/comments-on-posts> commentsOnPosts ∷ [Int] → Request a "commentsOnPosts" [SE Comment] commentsOnPosts (T.intercalate ";" . map (toLazyText . decimal) → is) =@@ -282,9 +345,13 @@ createComment (toLazyText . decimal → i) body =   path ("posts/" <> i <> "/comments/add") <>   query [("body", body)] <>-  parse (attoparsec (return . SE) ".posts/{id}/comments/add:")+  parse (attoparsec (fmap SE) ".posts/{id}/comments/add:")  +-- $commentsOnQuestions+-- >>> checkLengthM $ askSE (commentsOnQuestions [394601] <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/comments-on-questions> commentsOnQuestions ∷ [Int] → Request a "commentsOnQuestions" [SE Comment] commentsOnQuestions (T.intercalate ";" . map (toLazyText . decimal) → is) =@@ -292,6 +359,10 @@   parse (attoparsec items ".questions/{ids}/comments: ")  +-- $commentsOnUsers+-- >>> checkLengthM $ askSE (commentsOnUsers [1097181] <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/comments-on-users> commentsOnUsers ∷ [Int] → Request a "commentsOnUsers" [SE Comment] commentsOnUsers (T.intercalate ";" . map (toLazyText . decimal) → is) =@@ -304,6 +375,10 @@ meComments = path "me/comments" <> parse (attoparsec items ".me/comments: ")  +-- $commentsByUsersToUser+-- >>> checkLengthM $ askSE (commentsByUsersToUser [230461,1011995,157360] 1097181 <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/comments-by-users-to-user> commentsByUsersToUser ∷ [Int] → Int → Request a "commentsByUsersToUser" [SE Comment] commentsByUsersToUser (T.intercalate ";" . map (toLazyText . decimal) → is)@@ -319,6 +394,10 @@   parse (attoparsec items ".me/comments/{toid}:")  +-- $mentionsOnUsers+-- >>> checkLengthM $ askSE (mentionsOnUsers [1097181] <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/mentions-on-users> mentionsOnUsers ∷ [Int] → Request a "mentionsOnUsers" [SE Comment] mentionsOnUsers (T.intercalate ";" . map (toLazyText . decimal) → is) =@@ -335,6 +414,10 @@ -- Errors -------------------------- +-- $errors+-- >>> checkLengthM $ askSE (errors <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/errors> errors ∷ Request a "errors" [SE Error] errors = path "errors" <> parse (attoparsec items ".errors: ")@@ -358,7 +441,7 @@ createFilter (T.intercalate ";" → include) (T.intercalate ";" → exclude) base =   path "filter/create" <>   query [("include", include), ("exclude", exclude), ("base", base)] <>-  parse (attoparsec (return . SE) ".filter/create: ")+  parse (attoparsec (fmap SE) ".filter/create: ")   -- | <https://api.stackexchange.com/docs/read-filter>@@ -420,13 +503,17 @@  -- | <https://api.stackexchange.com/docs/info> info ∷ Request a "info" (SE Info)-info = path "info" <> parse (attoparsec (return . SE) ".info: ")+info = path "info" <> parse (attoparsec (fmap SE) ".info: ")   -------------------------- -- Network Users -------------------------- +-- $associatedUsers+-- >>> length `fmap` askSE (associatedUsers [1097181] <> k)+-- 1+ -- | <https://api.stackexchange.com/docs/associated-users> associatedUsers ∷ [Int] → Request a "associatedUsers" [SE NetworkUser] associatedUsers (T.intercalate ";" . map (toLazyText . decimal) → is) =@@ -445,6 +532,10 @@ -- Merge History -------------------------- +-- $mergeHistory+-- >>> ((>= 1) . length) `fmap` askSE (mergeHistory [14] <> k)+-- True+ -- | <https://api.stackexchange.com/docs/merge-history> mergeHistory ∷ [Int] → Request a "mergeHistory" [SE AccountMerge] mergeHistory (T.intercalate ";" . map (toLazyText . decimal) → is) =@@ -505,11 +596,19 @@ -- Posts -------------------------- +-- $posts+-- >>> checkLengthM $ askSE (posts <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/posts> posts ∷ Request a "posts" [SE Post] posts = path "posts" <> parse (attoparsec items ".posts: ")  +-- $postsByIds+-- >>> length `fmap` askSE (postsByIds [394601] <> s <> k)+-- 1+ -- | <https://api.stackexchange.com/docs/posts-by-ids> postsByIds ∷ [Int] → Request a "postsByIds" [SE Post] postsByIds (T.intercalate ";" . map (toLazyText . decimal) → is) =@@ -520,11 +619,19 @@ -- Privileges -------------------------- +-- $privileges+-- >>> checkLengthM $ askSE (privileges <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/privileges> privileges ∷ Request a "privileges" [SE Privilege] privileges = path "privileges" <> parse (attoparsec items ".privileges: ")  +-- $privilegesOnUsers+-- >>> checkLengthM $ askSE (privilegesOnUsers 1097181 <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/privileges-on-users> privilegesOnUsers ∷ Int → Request a "privilegesOnUsers" [SE Privilege] privilegesOnUsers (toLazyText . decimal → i) =@@ -541,17 +648,29 @@ -- Questions -------------------------- +-- $questions+-- >>> checkLengthM $ askSE (questions <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/questions> questions ∷ Request a "questions" [SE Question] questions = path "questions" <> parse (attoparsec items ".questions: ")  +-- $questionsByIds+-- >>> length `fmap` askSE (questionsByIds [394601] <> s <> k)+-- 1+ -- | <https://api.stackexchange.com/docs/questions-by-ids> questionsByIds ∷ [Int] → Request a "questionsByIds" [SE Question] questionsByIds (T.intercalate ";" . map (toLazyText . decimal) → is) =   path ("questions/" <> is) <> parse (attoparsec items ".questions/{ids}: ")  +-- $linkedQuestions+-- >>> checkLengthM $ askSE (linkedQuestions [394601] <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/linked-questions> linkedQuestions ∷ [Int] → Request a "linkedQuestions" [SE Question] linkedQuestions (T.intercalate ";" . map (toLazyText . decimal) → is) =@@ -559,6 +678,10 @@   parse (attoparsec items ".questions/{ids}/linked: ")  +-- $relatedQuestions+-- >>> checkLengthM $ askSE (relatedQuestions [394601] <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/related-questions> relatedQuestions ∷ [Int] → Request a "relatedQuestions" [SE Question] relatedQuestions (T.intercalate ";" . map (toLazyText . decimal) → is) =@@ -566,12 +689,20 @@   parse (attoparsec items ".questions/{ids}/related: ")  +-- $featuredQuestions+-- >>> checkLengthM $ askSE (featuredQuestions <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/featured-questions> featuredQuestions ∷ Request a "featuredQuestions" [SE Question] featuredQuestions =   path "questions/featured" <> parse (attoparsec items ".questions/featured: ")  +-- $unansweredQuestions+-- >>> checkLengthM $ askSE (unansweredQuestions <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/unanswered-questions> unansweredQuestions ∷ Request a "unansweredQuestions" [SE Question] unansweredQuestions =@@ -579,6 +710,10 @@   parse (attoparsec items ".questions/unanswered: ")  +-- $noAnswerQuestions+-- >>> checkLengthM $ askSE (noAnswerQuestions <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/no-answer-questions> noAnswerQuestions ∷ Request a "noAnswerQuestions" [SE Question] noAnswerQuestions =@@ -586,6 +721,10 @@   parse (attoparsec items ".questions/no-answers: ")  +-- $search+-- >>> checkLengthM $ askSE (search "why" ["haskell"] <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/search> search ∷ Text → [Text] → Request a "search" [SE Question] search t (T.intercalate ";" → ts) =@@ -594,12 +733,20 @@   parse (attoparsec items ".search: ")  +-- $advancedSearch+-- >>> checkLengthM $ askSE (advancedSearch <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/advanced-search> advancedSearch ∷ Request a "advancedSearch" [SE Question] advancedSearch =   path "search/advanced" <> parse (attoparsec items ".search/advanced: ")  +-- $similar+-- >>> checkLengthM $ askSE (similar "sublists of list" ["haskell"] <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/similar> similar ∷ Text → [Text] → Request a "similar" [SE Question] similar t (T.intercalate ";" → ts) =@@ -608,6 +755,10 @@   parse (attoparsec items ".similar: ")  +-- $faqsByTags+-- >>> checkLengthM $ askSE (faqsByTags ["haskell"] <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/faqs-by-tags> faqsByTags ∷ [Text] → Request a "faqsByTags" [SE Question] faqsByTags (T.intercalate ";" → ts) =@@ -615,6 +766,10 @@   parse (attoparsec items ".tags/{tags}/faq: ")  +-- $favoritesOnUsers+-- >>> checkLengthM $ askSE (favoritesOnUsers [9204] <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/favorites-on-users> favoritesOnUsers ∷ [Int] → Request a "favoritesOnUsers" [SE Question] favoritesOnUsers (T.intercalate ";" . map (toLazyText . decimal) → is) =@@ -627,6 +782,10 @@ meFavorites = path "me/favorites" <> parse (attoparsec items ".me/favorites: ")  +-- $questionsOnUsers+-- >>> checkLengthM $ askSE (questionsOnUsers [9204] <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/questions-on-users> questionsOnUsers ∷ [Int] → Request a "questionsOnUsers" [SE Question] questionsOnUsers (T.intercalate ";" . map (toLazyText . decimal) → is) =@@ -663,6 +822,10 @@ meNoAnswerQuestions = path "me/questions/no-answers" <> parse (attoparsec items ".me/questions/no-answers: ")  +-- $unacceptedQuestionsOnUsers+-- >>> null `fmap` askSE (unacceptedQuestionsOnUsers [570689] <> s <> k <> q)+-- False+-- -- | <https://api.stackexchange.com/docs/unaccepted-questions-on-users> unacceptedQuestionsOnUsers ∷ [Int] → Request a "unacceptedQuestionsOnUsers" [SE Question] unacceptedQuestionsOnUsers (T.intercalate ";" . map (toLazyText . decimal) → is) =@@ -687,6 +850,10 @@ meUnansweredQuestions = path "me/questions/unanswered" <> parse (attoparsec items ".me/questions/unanswered: ")  +-- $topUserQuestionsInTags+-- >>> checkLengthM $ askSE (topUserQuestionsInTags 570689 ["haskell"] <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/top-user-questions-in-tags> topUserQuestionsInTags ∷ Int → [Text] → Request a "topUserQuestionsInTags" [SE Question] topUserQuestionsInTags (toLazyText . decimal → i) (T.intercalate ";" → ts) =@@ -705,6 +872,10 @@ -- Question Timelines -------------------------- +-- $questionsTimeline+-- >>> checkLengthM $ askSE (questionsTimeline [570689] <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/questions-timeline> questionsTimeline ∷ [Int] → Request a "questionsTimeline" [SE QuestionTimeline] questionsTimeline (T.intercalate ";" . map (toLazyText . decimal) → is) =@@ -716,6 +887,10 @@ -- Reputation -------------------------- +-- $reputationOnUsers+-- >>> checkLengthM $ askSE (reputationOnUsers [1097181] <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/reputation-on-users> reputationOnUsers ∷ [Int] → Request a "reputationOnUsers" [SE Reputation] reputationOnUsers (T.intercalate ";" . map (toLazyText . decimal) → is) =@@ -732,6 +907,10 @@ -- Reputation History ------------------------- +-- $reputationHistory+-- >>> checkLengthM $ askSE (reputationHistory [1097181] <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/reputation-history> reputationHistory ∷ [Int] → Request a "reputationHistory" [SE ReputationHistory] reputationHistory (T.intercalate ";" . map (toLazyText . decimal) → is) =@@ -764,6 +943,10 @@ -- Revisions -------------------------- +-- $revisionsByIds+-- >>> checkLengthM $ askSE (revisionsByIds [1218390] <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/revisions-by-ids> revisionsByIds ∷ [Int] → Request a "revisionsByIds" [SE Revision] revisionsByIds (T.intercalate ";" . map (toLazyText . decimal) → is) =@@ -771,6 +954,10 @@   parse (attoparsec items ".posts/{ids}/revisions: ")  +-- $revisionsByGuids+-- >>> length `fmap` askSE (revisionsByGuids ["881687CA-9A98-46CC-B9F0-4063322B5E2F"] <> s <> k <> q)+-- 1+ -- | <https://api.stackexchange.com/docs/revisions-by-guids> revisionsByGuids ∷ [Text] → Request a "revisionsByGuids" [SE Revision] revisionsByGuids (T.intercalate ";" → is) =@@ -782,6 +969,10 @@ -- Sites -------------------------- +-- $sites+-- >>> checkLengthM $ askSE (sites <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/sites> sites ∷ Request a "sites" [SE Site] sites = path "sites" <> parse (attoparsec items ".sites: ")@@ -798,6 +989,10 @@   parse (attoparsec items ".posts/{ids}/suggested-edits: ")  +-- $suggestedEdits+-- >>> checkLengthM $ askSE (suggestedEdits <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/suggested-edits> suggestedEdits ∷ Request a "suggestedEdits" [SE SuggestedEdit] suggestedEdits =@@ -829,11 +1024,19 @@ -- Tags -------------------------- +-- $tags+-- >>> checkLengthM $ askSE (tags <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/tags> tags ∷ Request a "tags" [SE Tag] tags = path "tags" <> parse (attoparsec items ".tags: ")  +-- $moderatorOnlyTags+-- >>> checkLengthM $ askSE (moderatorOnlyTags <> site "meta.serverfault" <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/moderator-only-tags> moderatorOnlyTags ∷ Request a "moderatorOnlyTags" [SE Tag] moderatorOnlyTags =@@ -841,12 +1044,20 @@   parse (attoparsec items ".tags/moderator-only: ")  +-- $requiredTags+-- >>> (( > 0) . length) `fmap` askSE (requiredTags <> site "meta.serverfault" <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/required-tags> requiredTags ∷ Request a "requiredTags" [SE Tag] requiredTags =   path "tags/required" <> parse (attoparsec items ".tags/required: ")  +-- $tagsByName+-- >>> ((> 0) . length) `fmap` askSE (tagsByName ["haskell"] <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/tags-by-name> tagsByName ∷ [Text] → Request a "tagsByName" [SE Tag] tagsByName (T.intercalate ";" → ts) =@@ -854,6 +1065,10 @@   parse (attoparsec items ".tags/{tags}/info: ")  +-- $relatedTags+-- >>> checkLengthM $ askSE (relatedTags ["haskell"] <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/related-tags> relatedTags ∷ [Text] → Request a "relatedTags" [SE Tag] relatedTags (T.intercalate ";" → ts) =@@ -861,6 +1076,10 @@   parse (attoparsec items ".tags/{tags}/related: ")  +-- $tagsOnUsers+-- >>> checkLengthM $ askSE (tagsOnUsers [1097181] <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/tags-on-users> tagsOnUsers ∷ [Int] → Request a "tagsOnUsers" [SE Tag] tagsOnUsers (T.intercalate ";" . map (toLazyText . decimal) → is) =@@ -877,6 +1096,10 @@ -- Tag Scores -------------------------- +-- $topAnswerersOnTag+-- >>> checkLengthM $ askSE (topAnswerersOnTag "haskell" "Month" <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/top-answerers-on-tags> topAnswerersOnTag ∷ Text → Text → Request a "topAnswerersOnTag" [SE TagScore] topAnswerersOnTag t p =@@ -884,6 +1107,10 @@   parse (attoparsec items ".tags/{tag}/top-answerers/{period}: ")  +-- $topAskersOnTag+-- >>> checkLengthM $ askSE (topAskersOnTag "haskell" "Month" <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/top-askers-on-tags> topAskersOnTag ∷ Text → Text → Request a "topAskersOnTag" [SE TagScore] topAskersOnTag t p =@@ -895,12 +1122,20 @@ -- Tag Synonyms -------------------------- +-- $tagSynonyms+-- >>> checkLengthM $ askSE (tagSynonyms <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/tag-synonyms> tagSynonyms ∷ Request a "tagSynonyms" [SE TagSynonym] tagSynonyms =   path "tags/synonyms" <> parse (attoparsec items ".tags/synonyms: ")  +-- $synonymsByTags+-- >>> checkLengthM $ askSE (synonymsByTags ["iphone","java"] <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/synonyms-by-tags> synonymsByTags ∷ [Text] → Request a "synonymsByTags" [SE TagSynonym] synonymsByTags (T.intercalate ";" → ts) =@@ -912,6 +1147,10 @@ -- Tag Wikis -------------------------- +-- $wikisByTags+-- >>> length `fmap` askSE (wikisByTags ["haskell"] <> s <> k <> q)+-- 1+ -- | <https://api.stackexchange.com/docs/wikis-by-tags> wikisByTags ∷ [Text] → Request a "wikisByTags" [SE TagWiki] wikisByTags (T.intercalate ";" → ts) =@@ -923,6 +1162,10 @@ -- Top Tags -------------------------- +-- $topAnswerTagsOnUsers+-- >>> checkLengthM $ askSE (topAnswerTagsOnUsers 1097181 <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/top-answer-tags-on-users> topAnswerTagsOnUsers ∷ Int → Request a "topAnswerTagsOnUsers" [SE TopTag] topAnswerTagsOnUsers (toLazyText . decimal → i) =@@ -935,6 +1178,10 @@ meTopAnswerTags = path "me/top-answer-tags" <> parse (attoparsec items ".me/top-answer-tags: ")  +-- $topQuestionTagsOnUsers+-- >>> checkLengthM $ askSE (topQuestionTagsOnUsers 570689 <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/top-question-tags-on-users> topQuestionTagsOnUsers ∷ Int → Request a "topQuestionTagsOnUsers" [SE TopTag] topQuestionTagsOnUsers (toLazyText . decimal → i) =@@ -951,11 +1198,19 @@ -- Users -------------------------- +-- $users+-- >>> checkLengthM $ askSE (users <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/users> users ∷ Request a "users" [SE User] users = path "users" <> parse (attoparsec items ".users: ")  +-- $users+-- >>> length `fmap` askSE (usersByIds [1097181] <> s <> k <> q)+-- 1+ -- | <https://api.stackexchange.com/docs/users-by-ids> usersByIds ∷ [Int] → Request a "usersByIds" [SE User] usersByIds (T.intercalate ";" . map (toLazyText . decimal) → is) =@@ -967,12 +1222,20 @@ me = path "me" <> parse (head . attoparsec items ".me: ")  +-- $moderators+-- >>> checkLengthM $ askSE (moderators <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/moderators> moderators ∷ Request a "moderators" [SE User] moderators =   path "users/moderators" <> parse (attoparsec items ".users/moderators: ")  +-- $electedModerators+-- >>> checkLengthM $ askSE (electedModerators <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/elected-moderators> electedModerators ∷ Request a "electedModerators" [SE User] electedModerators =@@ -984,6 +1247,10 @@ -- User Timeline -------------------------- +-- $timelineOnUsers+-- >>> checkLengthM $ askSE (timelineOnUsers [1097181] <> s <> k <> q)+-- True+ -- | <https://api.stackexchange.com/docs/timeline-on-users> timelineOnUsers ∷ [Int] → Request a "timelineOnUsers" [SE UserTimeline] timelineOnUsers (T.intercalate ";" . map (toLazyText . decimal) → is) =@@ -1000,6 +1267,10 @@ -- Write Permissions -------------------------- +-- $writePermissions+-- >>> length `fmap` askSE (writePermissions 1097181 <> s <> k <> q)+-- 1+ -- | <https://api.stackexchange.com/docs/write-permissions> writePermissions ∷ Int → Request a "writePermissions" [SE WritePermission] writePermissions (toLazyText . decimal → i) =@@ -1012,13 +1283,13 @@ meWritePermissions = path "me/write-permissions" <> parse (attoparsec items ".me/write-permissions: ")  -attoparsec ∷ (Value → Maybe b) → String → ByteString → b+attoparsec ∷ (Maybe Value → Maybe b) → String → ByteString → b attoparsec f msg request = case AP.eitherResult $ AP.parse A.json request of-  Right s → case f s of+  Right s → case f (Just s) of     Just b → b     Nothing → throw $ SEException request ("libstackexchange" ++ msg ++ "incorrect JSON content")   Left e → throw $ SEException request ("libstackexchange" ++ msg ++ e)  -items ∷ (Functor m, Monad m) ⇒ Value → m [SE a]-items s = SE s ^! field "items"+items ∷ Maybe Value → Maybe [SE a]+items s = map SE <$> (s ^. L.key "items")

@@ -2,8 +2,10 @@ {-# LANGUAGE UnicodeSyntax #-} -- | StackExchange authentication helpers module Network.StackExchange.Auth-  ( -- * Authentication related routines-    askPermission, accessToken+  ( -- * Explicit OAuth 2.0 flow+    explicitUserPermission, explicitAccessToken+    -- * Implicit OAuth 2.0 flow+  , implicitUserPermission   ) where  import Control.Applicative ((<$>), (*>))@@ -20,13 +22,13 @@   -- | Construct URI at which user should approve app-askPermission ∷ Int → Text → Request a n r-askPermission c r = host "https://stackexchange.com/oauth" <> client c <> redirectURI r+explicitUserPermission ∷ Int → Text → Request a n r+explicitUserPermission c r = userPermission c r <> host "https://stackexchange.com/oauth"   -- | Request access_token from StackExchange-accessToken ∷ Int → Text → Text → Text → Request a n Text-accessToken c s c' r = mconcat+explicitAccessToken ∷ Int → Text → Text → Text → Request a n Text+explicitAccessToken c s c' r = mconcat   [ host "https://stackexchange.com/oauth/access_token"   , client c   , secret s@@ -42,3 +44,12 @@    parser ∷ P.Parser Text   parser = P.string "access_token=" *> (T.pack <$> P.manyTill P.anyChar (P.char '&'))+++-- | Construct URI at which user should approve app+implicitUserPermission ∷ Int → Text → Request a n r+implicitUserPermission c r = userPermission c r <> host "https://stackexchange.com/oauth/dialog"+++userPermission ∷ Int → Text → Request a n r+userPermission c r = client c <> redirectURI r

@@ -2,6 +2,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE UnicodeSyntax #-}@@ -9,16 +10,21 @@ -- | StackExchange API request manipulation routines module Network.StackExchange.Request   ( -- * Type-    Request(..), Auth(..), SE(..), Object(..)+    Request, R(..), Auth(..), SE(..), Object(..)     -- * Constructing requests   , host, path, method, parse   , query, token, key, site, filter, state, Scope(..), scope   , client, redirectURI, secret, code+    -- * Internal wrapping/unwrapping+  , wrap, unwrap+    -- * Rendering+  , render   ) where -import Data.Monoid (Monoid(..), (<>))-import GHC.TypeLits+import Data.Monoid+import GHC.TypeLits (Symbol) import Prelude hiding (filter)+import Unsafe.Coerce (unsafeCoerce)  import           Control.Lens hiding (query) import           Data.ByteString.Lazy (ByteString)@@ -33,8 +39,10 @@ import           Data.Text.Lazy.Builder.Int (decimal)  --- | Whether to use authentication at all. Currently isn't used-data Auth = RequireToken | Ready+-- | Authentication+data Auth =+    RequireToken -- ^ Request requires auth_token+  | Ready -- ^ Request may be sent without auth_token   -- | SE response type@@ -82,7 +90,7 @@ -- different API calls in one request -- -- @r@ is a type of parsed API call result-data Request (a ∷ Auth) (n ∷ Symbol) r = Request+data R (a ∷ Auth) (n ∷ Symbol) r = R   { _host ∷ Text -- ^ API host link   , _path ∷ Text -- ^ API call link   , _method ∷ Text -- ^ API call method (GET/POST)@@ -98,36 +106,21 @@   , ("_query", "__query")   , ("_parse", "__parse")   ]-  ''Request+  ''R  --- | Subject to monoid and idempotent laws, they all are checked in request test suite-instance Monoid (Request a n r) where-  mempty = Request-    { _host = mempty+type Request a n r = Dual (Endo (R a n r))+++-- | Default StackExchange API request, defines only host link+instance Default (R a n r) where+  def = R+    { _host = "https://api.stackexchange.com/2.1"     , _path = mempty-    , _method = mempty+    , _method = "GET"     , _query = mempty     , _parse = Nothing     }-  l `mappend` r = Request-    { _host = _host $ if T.null $ _host r then l else r-    , _path = _path $ if T.null $ _path r then l else r-    , _method = _method $ if T.null $ _method r then l else r-    , _query = _query r <> _query l-    , _parse = _parse $ case _parse r of Just _ → r; Nothing → l-    }----- | Useful if what's needed is immediate result parse-instance Functor (Request a n) where-  fmap f = over __parse (fmap (f .))-  {-# INLINE fmap #-}----- | Default StackExchange API request, defines only host link-instance Default (Request a n r) where-  def = mempty % __host .~ "https://api.stackexchange.com/2.1" % __method .~ "GET"   {-# INLINE def #-}  @@ -135,7 +128,7 @@ -- -- Primarily used in Auth, not intended for usage by library user host ∷ Text → Request a n r-host p = mempty % __host .~ p+host p = wrap $ __host .~ p {-# INLINE host #-}  @@ -143,7 +136,7 @@ -- -- Primarily used in API call wrappers, not intended for usage by library user path ∷ Text → Request a n r-path p = mempty % __path .~ p+path p = wrap $ __path .~ p {-# INLINE path #-}  @@ -151,7 +144,7 @@ -- -- Primarily used in API call wrappers, not intended for usage by library user method ∷ Text → Request a n r-method m = mempty % __method .~ m+method m = wrap $ __method .~ m {-# INLINE method #-}  @@ -159,7 +152,7 @@ -- -- Primarily used in API call wrappers, not intended for usage by library user parse ∷ (ByteString → r) → Request a n r-parse f = mempty % __parse ?~ f+parse f = wrap $ __parse ?~ f {-# INLINE parse #-}  @@ -169,39 +162,39 @@ -- 'filter', etc calls may be more convenient -- ----- Takes a list of (key, value) parameters such as @[("order", "asc"), ("sort", "rank")]@+-- Takes a list of (key, value) parameters such as @[(\"order\", \"asc\"), (\"sort\", \"rank\")]@ query ∷ [(Text, Text)] → Request a n r-query q = mempty % __query .~ M.fromList q+query q = wrap $ __query %~ (M.fromList q <>) {-# INLINE query #-}   -- | Convert token requiring Request into ready one token ∷ Text → Request RequireToken n r → Request Ready n r-token t = over __query (M.insert "access_token" t)+token t = unsafeCoerce . mappend (wrap (__query %~ M.insert "access_token" t)) {-# INLINE token #-}   -- | Request defining only App key key ∷ Text → Request a n r-key s = mempty % __query .~ M.singleton "key" s+key s = wrap $ __query %~ M.insert "key" s {-# INLINE key #-}   -- | Request defining only API call site query parameter site ∷ Text → Request a n r-site s = mempty % __query .~ M.singleton "site" s+site s = wrap $ __query %~ M.insert "site" s {-# INLINE site #-}   -- | Request defining only API call filter query parameter filter ∷ Text → Request a n r-filter f = mempty % __query .~ M.singleton "filter" f+filter f = wrap $ __query %~ M.insert "filter" f {-# INLINE filter #-}   -- | Request defining only API call state query parameter state ∷ Text → Request a n r-state s = mempty % __query .~ M.singleton "state" s+state s = wrap $ __query %~ M.insert "state" s {-# INLINE state #-}  @@ -211,7 +204,7 @@  -- | Request defining only API call scope query parameter scope ∷ [Scope] → Request a n r-scope ss = mempty % __query .~ (M.singleton "scope" $ scopie ss)+scope ss = wrap $ __query %~ (M.insert "scope" $ scopie ss)  where   scopie xs = T.intercalate "," . flip map xs $ \case     ReadInbox   → "read_inbox"@@ -224,7 +217,7 @@ -- -- Primarily used in Authentication API call wrappers, not intended for usage by library user client ∷ Int → Request a n r-client (toLazyText . decimal → c) = mempty % __query .~ M.singleton "client_id" c+client (toLazyText . decimal → c) = wrap $ __query %~ M.insert "client_id" c {-# INLINE client #-}  @@ -232,7 +225,7 @@ -- -- Primarily used in Authentication API call wrappers, not intended for usage by library user redirectURI ∷ Text → Request a n r-redirectURI r = mempty % __query .~ M.singleton "redirect_uri" r+redirectURI r = wrap $ __query %~ M.insert "redirect_uri" r {-# INLINE redirectURI #-}  @@ -240,7 +233,7 @@ -- -- Primarily used in Authentication API call wrappers, not intended for usage by library user secret ∷ Text → Request a n r-secret c = mempty % __query .~ M.singleton "client_secret" c+secret c = wrap $ __query %~ M.insert "client_secret" c {-# INLINE secret #-}  @@ -248,5 +241,23 @@ -- -- Primarily used in Authentication API call wrappers, not intended for usage by library user code ∷ Text → Request a n r-code c = mempty % __query .~ M.singleton "code" c+code c = wrap $ __query %~ M.insert "code" c {-# INLINE code #-}+++-- | Wrapping to interesting 'Monoid' ('R' -> 'R') instance+wrap ∷ (R a n r → R a n r) → Request a n r+wrap = Dual . Endo+++-- | Unwrapping from interesting 'Monoid' ('R' -> 'R') instance+unwrap ∷ Request a n r → (R a n r → R a n r)+unwrap = appEndo . getDual+++-- | Render 'R' as URI string for networking+render ∷ Request a n r → String+render (($ def) . unwrap → R {_host, _path, _query}) =+  T.unpack $ mconcat [_host, "/", _path, "?", argie _query]+ where+  argie = T.intercalate "&" . M.foldrWithKey (\k v m → T.concat [k, "=", v] : m) mempty

@@ -1,36 +1,24 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE Rank2Types #-} {-# LANGUAGE UnicodeSyntax #-}-{-# LANGUAGE ViewPatterns #-} -- | Get response from Request and retrieve data from it module Network.StackExchange.Response   ( -- * Schedule request-    SEException(..), askSE, render-    -- * Generalized combinator-  , aeson-    -- * Convenience functions-  , field, fields+    SEException(..), askSE+    -- * Iso lens+  , se   ) where  import Control.Applicative ((<$>)) import Control.Exception (Exception, throwIO)-import Control.Category ((>>>))-import Control.Monad ((<=<))-import Data.Monoid (Monoid(..)) import Data.Typeable (Typeable) -import           Data.ByteString.Lazy (ByteString, toStrict) import           Control.Lens-import           Data.Aeson (FromJSON, Value, (.:), parseJSON)-import qualified Data.Aeson.Types as A+import           Data.Aeson (Value)+import           Data.ByteString.Lazy (ByteString, toStrict) import           Data.Default (Default(..))-import qualified Data.Map as M-import           Data.Text (Text)-import qualified Data.Text.Lazy as T import           Data.Text.Lazy.Encoding (encodeUtf8) import qualified Network.HTTP.Conduit as C @@ -49,7 +37,8 @@  -- | Send Request and parse response askSE ∷ Request Ready n r → IO r-askSE (mappend def → q@Request {_method, _parse}) = do+askSE q = do+  let R {_method, _parse} = unwrap q def   r ← C.withManager $ \m → C.parseUrl (render q) >>= \url →     C.responseBody <$> C.httpLbs (url {C.method = toStrict $ encodeUtf8 _method}) m   case _parse of@@ -58,28 +47,6 @@       SEException r "libstackexchange.askSE: no parsing function registered"  --- | Render Request as string for networking-render ∷ Request a n r → String-render Request {_host, _path, _query} = T.unpack $ mconcat [_host, "/", _path, "?", argie _query]- where-  argie = T.intercalate "&" . M.foldrWithKey (\k v m → T.concat [k, "=", v] : m) mempty----- | Generalized combinator, useful if full power of Aeson is needed-aeson ∷ Monad m ⇒ (a → A.Parser b) → Action m a b-aeson p = act $ A.parse p >>> \case-  A.Success v → return v-  A.Error g → fail g-{-# INLINE aeson #-}----- | Select specific field in JSON-field ∷ (Monad m, FromJSON a) ⇒ Text → Action m (SE x) a-field xs = aeson ((.: xs) <=< parseJSON . unSE)-{-# INLINE field #-}----- | Select specific fields of an array in JSON-fields ∷ (Monad m, FromJSON a) ⇒ Text → Action m Value [a]-fields xs = aeson $ mapM (.: xs) <=< parseJSON-{-# INLINE fields #-}+-- | Isomorphism lens for the ease of interaction with generic aeson parser lenses+se ∷ (Functor f, Isomorphic k) ⇒ k (SE a → f (SE a)) (Value → f Value)+se = iso SE unSE

@@ -1,61 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE UnicodeSyntax #-}-module Main (main) where--import System.Exit (exitFailure, exitSuccess)--import           Data.ByteString.Lazy (ByteString)-import           Control.Lens-import qualified Data.Aeson as A-import           Network.StackExchange.Request-import           Network.StackExchange.Response-import qualified Data.Attoparsec.Lazy as AP-import           Test.HUnit--import TH (string)---main ∷ IO ()-main = do-  let AP.Done _ parsed = AP.parse A.json json-  Counts { errors, failures } ← runTestTT (tests $ SE parsed)-  if errors + failures == 0 then exitSuccess else exitFailure---json ∷ ByteString-json = [string|-  { "apples": 4-  , "bananas":-    { "bananas": 7-    }-  , "pinapples": [4, 7]-  , "peaches":-    [ { "peaches": [4, 7] }-    , { "peaches": [4, 7] }-    ]-  }-|]---tests ∷ SE a → Test-tests = TestList . sequence-  [ testKeyLookup-  , testNestedKeyLookup-  , testFailedKeyLookup-  , testKeysLookup-  , testNestedKeysLookup-  ]- where-  testKeyLookup parsed = TestCase . assertEqual "key lookup" (Just 4) $-    (parsed ^! field "apples" ∷ Maybe Int)-  testNestedKeyLookup parsed = TestCase . assertEqual "nested key lookup" (Just 7) $-    (parsed ^! field "bananas" . field "bananas" ∷ Maybe Int)-  testFailedKeyLookup parsed = TestCase . assertEqual "failed key lookup" Nothing $-    (parsed ^! field "oranges" ∷ Maybe Int)-  testKeysLookup parsed = TestCase . assertEqual "keys lookup" (Just [4,7]) $-    (parsed ^! field "pinapples" ∷ Maybe [Int])-  testNestedKeysLookup parsed = TestCase . assertEqual "nested keys lookup" (Just [4,7,4,7]) $-    (parsed ^! field "peaches" . fields "peaches" . traverse ∷ Maybe [Int])

@@ -1,14 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE UnicodeSyntax #-}-module TH(string) where--import GHC.Exts(IsString(..))-import Language.Haskell.TH.Quote---string ∷ QuasiQuoter-string = QuasiQuoter-  ((\a → [|fromString a|]) . filter (/= '\r'))-  (error "Cannot use q as a pattern")-  (error "Cannot use q as a type")-  (error "Cannot use q as a dec")

@@ -1,86 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE UnicodeSyntax #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-module Main (main) where--import Control.Applicative ((<$>), (<*>), liftA2)-import Data.Monoid ((<>), mempty)-import System.Exit (exitFailure, exitSuccess)--import           Data.Map (Map)-import qualified Data.Map as M-import           Data.Text.Lazy (Text)-import qualified Data.Text.Lazy as T-import           Network.StackExchange.Request-import           Test.QuickCheck-import           Test.QuickCheck.Function---instance Show (a → b) where-  show = const "<function>"---instance Eq (a → b) where-  (==) = const . const True---deriving instance Show (Request a i r)---deriving instance Eq (Request a i r)---instance Arbitrary Text where-  arbitrary = T.pack <$> arbitrary---instance (Ord k, Arbitrary k, Arbitrary v) ⇒ Arbitrary (Map k v) where-  arbitrary = M.fromList <$> arbitrary---instance Arbitrary (Request a i r) where-  arbitrary =-    Request <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> return Nothing---prop_right_id ∷ Request a i r → Bool-prop_right_id r = r <> mempty == r---prop_left_id ∷ Request a i r → Bool-prop_left_id r = mempty <> r == r---prop_associative ∷ Request a i r → Request a i r → Request a i r → Bool-prop_associative x y z = (x <> y) <> z == x <> (y <> z)---prop_idempotent ∷ Request a i r → Bool-prop_idempotent x = x <> x == x---prop_functor_id ∷ Request a i r → Bool-prop_functor_id x = fmap id x == x---prop_functor_composition ∷ Fun Char Int → Fun Int Char → Request a i Char → Bool-prop_functor_composition (Fun _ f) (Fun _ g) = liftA2 (==) (fmap (g . f)) (fmap g . fmap f)---main ∷ IO ()-main = (,,,,,) <$>-  (check prop_right_id) <*>-  (check prop_left_id) <*>-  (check prop_associative) <*>-  (check prop_idempotent) <*>-  (check prop_functor_id) <*>-  (check prop_functor_composition) >>= \case-  (True,True,True,True,True,True) → exitSuccess-  _                               → exitFailure- where-  check p = success <$> quickCheckResult p--  success (Success {}) = True-  success _ = False