packages feed

reddit (empty) → 0.1.0.0

raw patch · 59 files changed

+2942/−0 lines, 59 filesdep +Cabaldep +aesondep +api-buildersetup-changed

Dependencies added: Cabal, aeson, api-builder, base, bytestring, data-default, hspec, http-conduit, http-types, network, reddit, stm, text, time, transformers, unordered-containers, vector

Files

+ LICENSE view
@@ -0,0 +1,10 @@+Copyright (c) Fraser Murray, 2013-2015+All rights reserved.++Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,72 @@+reddit for haskell [![Build Status](https://travis-ci.org/intolerable/reddit.svg?branch=master)](https://travis-ci.org/intolerable/reddit)+---++A Haskell library for interacting with the [Reddit API](http://reddit.com/api).++### A couple of examples++Let's get all the posts from the frontpage of Reddit and write a summary of each of them to the console:++```haskell+import Reddit+import Reddit.Types.Post++import Control.Monad+import Control.Monad.IO.Class+import Data.Monoid+import qualified Data.Text as Text+import qualified Data.Text.IO as Text++main = runRedditAnon $ do+  Listing _ _ posts <- getPosts+  forM_ posts $ \post -> do+    liftIO $ Text.putStrLn $+       "[" <> tshow (score post) <> "] " <>+       title post <> " (" <> tshow (subreddit post) <> ")"++tshow = Text.pack . show+```++Let's check to see which of a group of has the highest link karma:++```haskell+import Reddit+import Reddit.Types.User++import Data.List+import Data.Ord++usersToCheck = ["nikita-volkov", "simonmar", "bos", "roche"]++main = runRedditAnon $ do+    infos <- mapM (getUserInfo . Username) usersToCheck+    return $ maximumBy (comparing linkKarma) infos+```++Testing+===++Pure tests+---++`cabal test test`++This suite will only run test that don't require doing any IO. Helpful because it runs quickly and isn't subject to any network problems.++Anonymous tests+---++`cabal test test-anon`++There's also a suite of tests that can be run anonymously without having to set up a user account and an empty subreddit.++Full IO tests+---++`cabal test test-io`++The `test` test suite will run the tests that don't rely on doing any IO, but the `test-io` should be used too to ensure that IO functions do what they're supposed to do. If you want to run the IO suite, add a file `test.cfg` to the `reddit/` directory, containing (one field per line):++- a reddit username+- a reddit password+- a subreddit name (the user should be a moderator for the subredit)
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ reddit.cabal view
@@ -0,0 +1,165 @@+name:                reddit+version:             0.1.0.0+synopsis:            Library for interfacing with Reddit's API+description:+  A library for interfacing with Reddit's API in Haskell. Handles+  logins, rate-limiting and converted to and from JSON responses.++  Supports most user-facing Reddit API functions, as well as some+  moderator endpoints.++  Check out the readme at https://github.com/intolerable/reddit.+  Contributions are welcome.++license:             BSD2+license-file:        LICENSE+author:              Fraser Murray+maintainer:          fraser.m.murray@gmail.com+homepage:            https://github.com/intolerable/reddit+copyright:           Copyright (c) Fraser Murray, 2013-2015+category:            Network+build-type:          Simple+cabal-version:       >= 1.10+extra-source-files:+  README.md+  test/data/aboutMe_example.json+  test/data/getUserInfo_example.json+  test/data/getUserComments_example.json++source-repository head+  type: git+  location: https://github.com/intolerable/reddit++library+  exposed-modules:+    Reddit+    Reddit.Actions+    Reddit.Actions.Captcha+    Reddit.Actions.Comment+    Reddit.Actions.Flair+    Reddit.Actions.Message+    Reddit.Actions.Moderation+    Reddit.Actions.Post+    Reddit.Actions.Search+    Reddit.Actions.Subreddit+    Reddit.Actions.Thing+    Reddit.Actions.User+    Reddit.Actions.Voting+    Reddit.Actions.Wiki+    Reddit.Login+    Reddit.Types+    Reddit.Types.Captcha+    Reddit.Types.Comment+    Reddit.Types.Error+    Reddit.Types.Flair+    Reddit.Types.Listing+    Reddit.Types.Message+    Reddit.Types.Moderation+    Reddit.Types.Options+    Reddit.Types.Post+    Reddit.Types.Reddit+    Reddit.Types.SearchOptions+    Reddit.Types.Subreddit+    Reddit.Types.SubredditSettings+    Reddit.Types.Thing+    Reddit.Types.User+    Reddit.Types.Wiki+  other-modules:+    Reddit.Parser+    Reddit.Routes+    Reddit.Routes.Captcha+    Reddit.Routes.Comment+    Reddit.Routes.Flair+    Reddit.Routes.Message+    Reddit.Routes.Moderation+    Reddit.Routes.Post+    Reddit.Routes.Run+    Reddit.Routes.Search+    Reddit.Routes.Subreddit+    Reddit.Routes.Thing+    Reddit.Routes.User+    Reddit.Routes.Vote+    Reddit.Routes.Wiki+    Reddit.Types.Empty+    Reddit.Utilities+  default-extensions:+    FlexibleInstances,+    OverloadedStrings+  default-language: Haskell2010+  hs-source-dirs: src/+  build-depends:+    base >= 4.6 && < 4.9,+    aeson,+    api-builder >= 0.9,+    bytestring,+    data-default,+    http-conduit,+    http-types,+    network,+    stm,+    text,+    time,+    transformers == 0.4.*,+    unordered-containers,+    vector+  ghc-options: -Wall++test-suite test+  hs-source-dirs: test+  main-is: Spec.hs+  default-extensions: OverloadedStrings+  default-language: Haskell2010+  type: exitcode-stdio-1.0+  build-depends:+    base == 4.*,+    Cabal >= 1.16.0,+    api-builder,+    bytestring,+    http-conduit,+    reddit,+    hspec,+    text,+    time,+    transformers+  ghc-options: -Wall++test-suite test-io+  hs-source-dirs: test-io+  main-is: Spec.hs+  default-extensions:+    OverloadedStrings+    Rank2Types+  default-language: Haskell2010+  type: exitcode-stdio-1.0+  build-depends:+    base == 4.*,+    Cabal >= 1.16.0,+    api-builder,+    bytestring,+    http-conduit,+    reddit,+    hspec,+    text,+    time,+    transformers+  ghc-options: -Wall++test-suite test-anon+  hs-source-dirs: test-anon+  main-is: Spec.hs+  default-extensions:+    OverloadedStrings+    Rank2Types+  default-language: Haskell2010+  type: exitcode-stdio-1.0+  build-depends:+    base == 4.*,+    Cabal >= 1.16.0,+    api-builder,+    http-conduit,+    reddit,+    hspec,+    text,+    time,+    transformers+  ghc-options: -Wall
+ src/Reddit.hs view
@@ -0,0 +1,104 @@+-- | This module should be most of what you need to operate the library.+--   It exports functionality for running built 'RedditT' actions, as well+--   as re-exporting a few helpful types from around the library. Not every+--   type is exported, however, due to clashing record fields. It's recommended+--   to import modules from @Reddit.Types.*@ qualified so that you can use all+--   the record fields without having to deal with ambiguous functions.+module Reddit+  ( runReddit+  , runRedditAnon+  , runRedditWith+  , RedditOptions(..)+  , LoginMethod(..)+  -- * Re-exports+  , APIError(..)+  , module Reddit.Actions+  , module Reddit.Types+  , module Reddit.Types.Error+  , module Reddit.Types.Reddit ) where++import Reddit.Actions+import Reddit.Login+import Reddit.Types.Error+import Reddit.Types+import Reddit.Types.Reddit hiding (info, should)++import Control.Concurrent.STM.TVar+import Control.Monad.IO.Class+import Data.ByteString.Char8 (ByteString)+import Data.Default+import Data.Text (Text)+import Data.Text.Encoding (encodeUtf8)+import Network.API.Builder+import Network.HTTP.Conduit++-- | Options for how we should run the 'Reddit' action.+--+-- - 'rateLimitingEnabled': 'True' if the connection should be automatically rate-limited+--   and should pause when we hit the limit, 'False' otherwise.+--+-- - 'connectionManager': @'Just' x@ if the connection should use the 'Manager' @x@, 'Nothing'+--   if we should create a new one for the connection.+--+-- - 'loginMethod': The method we should use for authentication, described in 'LoginMethod'.+--+-- - 'customUserAgent': @'Just' "string"@ if the connection should use the user agent @"string"@,+--   @'Nothing'@ if it should use the default agent.+data RedditOptions =+  RedditOptions { rateLimitingEnabled :: Bool+                , connectionManager :: Maybe Manager+                , loginMethod :: LoginMethod+                , customUserAgent :: Maybe ByteString }++instance Default RedditOptions where+  def = RedditOptions True Nothing Anonymous Nothing++-- | Should we log in to Reddit? If so, should we use a stored set of credentials+--   or get a new fresh set?+data LoginMethod = Anonymous -- ^ Don't login, instead use an anonymous account+                 | Credentials Text Text -- ^ Login using the specified username and password+                 | StoredDetails LoginDetails -- ^+                 --   Login using a stored set of credentials. Usually the best way to get+                 --   these is to do @'runRedditAnon' $ 'login' user pass@.+  deriving (Show)++instance Default LoginMethod where def = Anonymous++-- | Run a 'Reddit' action (or a 'RedditT' transformer action). This uses the default logged-in settings+--   for 'RedditOptions': rate limiting enabled, default manager, login via username and password, and+--   the default user-agent. You should change the user agent if you're making anything more complex than+--   a basic script, since Reddit's API policy says that you should have a uniquely identifiable user agent.+runReddit :: MonadIO m => Text -> Text -> RedditT m a -> m (Either (APIError RedditError) a)+runReddit user pass = runRedditWith def { loginMethod = Credentials user pass }++-- | Run a 'Reddit' action (or a 'RedditT' transformer action). This uses the default logged-out settings, so+--   you won't be able to do anything that requires authentication (like checking messages or making a post).+--   At the moment, authentication isn't statically checked, so it'll return a runtime error if you try to do+--   anything you don't have permissions for.+runRedditAnon :: MonadIO m => RedditT m a -> m (Either (APIError RedditError) a)+runRedditAnon = runRedditWith def++-- | Run a 'Reddit' or 'RedditT' action with custom settings. You probably won't need this function for+--   most things, but it's handy if you want to persist a connection over multiple 'Reddit' sessions or+--   use a custom user agent string.+runRedditWith :: MonadIO m => RedditOptions -> RedditT m a -> m (Either (APIError RedditError) a)+runRedditWith (RedditOptions rl man lm ua) (RedditT reddit) = do+  rli <- liftIO $ newTVarIO $ RateLimits rl Nothing+  manager <- case man of+    Just m -> return m+    Nothing -> liftIO $ newManager conduitManagerSettings+  (res, _, _) <- runAPI builder manager rli $ do+    customizeRequest $ addHeader ua+    case lm of+      StoredDetails (LoginDetails (Modhash mh) cj) ->+        customizeRequest $ \r ->+          addHeader ua r { cookieJar = Just cj+                         , requestHeaders = ("X-Modhash", encodeUtf8 mh):requestHeaders r }+      Credentials user pass -> do+        LoginDetails (Modhash mh) cj <- unRedditT $ login user pass+        customizeRequest $ \r ->+          addHeader ua r { cookieJar = Just cj+                         , requestHeaders = ("X-Modhash", encodeUtf8 mh):requestHeaders r }+      Anonymous -> return ()+    reddit+  return res
+ src/Reddit/Actions.hs view
@@ -0,0 +1,27 @@+-- | All the actions that the library can perform.+module Reddit.Actions+  ( module Reddit.Actions.Captcha+  , module Reddit.Actions.Comment+  , module Reddit.Actions.Flair+  , module Reddit.Actions.Message+  , module Reddit.Actions.Moderation+  , module Reddit.Actions.Post+  , module Reddit.Actions.Search+  , module Reddit.Actions.Subreddit+  , module Reddit.Actions.Thing+  , module Reddit.Actions.User+  , module Reddit.Actions.Voting+  , module Reddit.Actions.Wiki ) where++import Reddit.Actions.Captcha+import Reddit.Actions.Comment+import Reddit.Actions.Flair+import Reddit.Actions.Message+import Reddit.Actions.Moderation+import Reddit.Actions.Post+import Reddit.Actions.Search+import Reddit.Actions.Subreddit+import Reddit.Actions.Thing+import Reddit.Actions.User+import Reddit.Actions.Voting+import Reddit.Actions.Wiki
+ src/Reddit/Actions/Captcha.hs view
@@ -0,0 +1,27 @@+-- | Contains Captcha-related actions. Reddit sometimes requests Captchas in order+--   to prevent spambots, and you can use this module to get more info on them.+--   Unfortunately the library doesn't yet support answering Captchas on a widespread+--   scale, and you have to use slightly modified variants of other functions to+--   convince Reddit that you aren't a robot.+module Reddit.Actions.Captcha+  ( needsCaptcha+  , newCaptcha ) where++import Reddit.Routes.Run+import Reddit.Types.Captcha+import Reddit.Types.Reddit+import qualified Reddit.Routes.Captcha as Route++import Control.Monad.IO.Class++-- | Find out if the account currently logged in requires a captcha to be submitted for+--   certain requests (like sending a private message or submitting a post).+needsCaptcha :: MonadIO m => RedditT m Bool+needsCaptcha = runRoute Route.needsCaptcha++-- | Returns the ID of a captcha to be completed (the image for which can be found at+--   <http://reddit.com/captcha/$CAPTCHA_ID>)+newCaptcha :: MonadIO m => RedditT m CaptchaID+newCaptcha = do+  POSTWrapped c <- runRoute Route.newCaptcha+  return c
+ src/Reddit/Actions/Comment.hs view
@@ -0,0 +1,98 @@+-- | Contains comment-related actions, like editing comments+--   and performing moderator actions on posts.+module Reddit.Actions.Comment+  ( getNewComments+  , getNewComments'+  , getMoreChildren+  , getCommentInfo+  , getCommentsInfo+  , editComment+  , deleteComment+  , removeComment ) where++import Reddit.Routes.Run+import Reddit.Types.Comment+import Reddit.Types.Empty+import Reddit.Types.Error+import Reddit.Types.Listing+import Reddit.Types.Options+import Reddit.Types.Post+import Reddit.Types.Reddit+import Reddit.Types.Subreddit+import qualified Reddit.Routes as Route++import Control.Monad.IO.Class+import Data.Default+import Data.Text (Text)+import Network.API.Builder (APIError(..))++-- | Get a 'CommentListing' for the most recent comments on the site overall.+--   This maps to <http://reddit.com/r/$SUBREDDIT/comments>, or <http://reddit.com/comments>+--   if the subreddit is not specified.+--   Note that none of the comments returned will have any child comments.+getNewComments :: MonadIO m => Maybe SubredditName -> RedditT m CommentListing+getNewComments = getNewComments' def++-- | Get a 'CommentListing' for the most recent comments with the specified 'Options' and+--   'SubredditName'. Note that none of the comments returned will have any child comments.+--   If the 'Options' is 'def', then this function is identical to 'getNewComments'.+getNewComments' :: MonadIO m => Options CommentID -> Maybe SubredditName -> RedditT m CommentListing+getNewComments' opts r = runRoute $ Route.newComments opts r++-- | Expand children comments that weren't fetched on initial load.+--   Equivalent to the web UI's "load more comments" button.+getMoreChildren :: MonadIO m+                => PostID -- ^ @PostID@ for the top-level+                -> [CommentID] -- ^ List of @CommentID@s to expand+                -> RedditT m [CommentReference]+getMoreChildren _ [] = return []+getMoreChildren p cs = do+  let (now, next) = splitAt 20 cs+  POSTWrapped rs <- runRoute $ Route.moreChildren p now+  more <- getMoreChildren p next+  return $ rs ++ more++-- | Given a 'CommentID', 'getCommentInfo' will return the full details for that comment.+getCommentInfo :: MonadIO m => CommentID -> RedditT m Comment+getCommentInfo c = do+  res <- getCommentsInfo [c]+  case res of+    Listing _ _ [comment] -> return comment+    _ -> failWith $ APIError InvalidResponseError++-- | Given a list of 'CommentID's, 'getCommentsInfo' will return another list containing+--   the full details for all the comments. Note that Reddit's+--   API imposes a limitation of 100 comments per request, so this function will fail immediately if given a list of more than 100 IDs.+getCommentsInfo :: MonadIO m => [CommentID] -> RedditT m CommentListing+getCommentsInfo cs =+  if null $ drop 100 cs+    then do+      res <- runRoute $ Route.commentsInfo cs+      case res of+        Listing _ _ comments | sameLength comments cs ->+          return res+        _ -> failWith $ APIError InvalidResponseError+    else failWith $ APIError TooManyRequests+  where+    sameLength (_:xs) (_:ys) = sameLength xs ys+    sameLength [] [] = True+    sameLength _ _ = False++-- | Edit a comment.+editComment :: MonadIO m+            => CommentID -- ^ Comment to edit+            -> Text -- ^ New comment text+            -> RedditT m Comment+editComment thing text = do+  POSTWrapped res <- runRoute $ Route.edit thing text+  return res++-- | Deletes one of your own comments. Note that this is different from+--   removing a comment as a moderator action.+deleteComment :: MonadIO m => CommentID -> RedditT m ()+deleteComment = nothing . runRoute . Route.delete++-- | Removes a comment (as a moderator action). Note that this is different+--   from deleting a comment.+removeComment :: MonadIO m => CommentID -> RedditT m ()+removeComment = nothing . runRoute . Route.removePost False
+ src/Reddit/Actions/Flair.hs view
@@ -0,0 +1,46 @@+-- | Contains actions for handling flair on a subreddit-wise basis.+module Reddit.Actions.Flair+  ( getFlairList+  , getFlairList'+  , addLinkFlair+  , flairCSV ) where++import Reddit.Routes.Flair+import Reddit.Routes.Run+import Reddit.Types.Empty+import Reddit.Types.Flair+import Reddit.Types.Options+import Reddit.Types.Reddit+import Reddit.Types.Subreddit+import Reddit.Types.User++import Control.Monad+import Control.Monad.IO.Class+import Data.Aeson+import Data.Default+import Data.Text (Text)++-- | Get the flair list for a subreddit. Requires moderator privileges on+--   the subreddit.+getFlairList :: MonadIO m => SubredditName -> RedditT m FlairListing+getFlairList = getFlairList' def++-- | Get the flair list for a subreddit (with 'Options'). Requires moderator+--   privileges on the subreddit.+getFlairList' :: MonadIO m => Options UserID -> SubredditName -> RedditT m FlairListing+getFlairList' opts r = liftM flistToListing $ runRoute (flairList opts r)++-- | Add link flair to the subreddit-wide template for a subreddit that you moderate.+--   Requires moderator privileges on the subreddit.+addLinkFlair :: MonadIO m+             => SubredditName -- ^ The subreddit whose template you want to modify+             -> Text -- ^ The intended CSS class of the new link flair+             -> Text -- ^ The intended text label of the new link flair+             -> Bool -- ^ Whether the flair should be editable by users+             -> RedditT m ()+addLinkFlair r c l e =+  nothing $ runRoute $ addLinkFlairTemplate r c l e++flairCSV :: MonadIO m => SubredditName -> [(Username, Text, Text)] -> RedditT m Value+flairCSV r sets =+  runRoute $ flairCSVRoute r sets
+ src/Reddit/Actions/Message.hs view
@@ -0,0 +1,68 @@+-- | Contains message-related actions, like retrieving your own inbox+--   and sending other users private messages.+module Reddit.Actions.Message+  ( getInbox+  , getInbox'+  , getUnread+  , getUnread'+  , markRead+  , sendMessage+  , sendMessageWithCaptcha ) where++import Reddit.Routes.Run+import Reddit.Types.Captcha+import Reddit.Types.Empty+import Reddit.Types.Listing+import Reddit.Types.Message+import Reddit.Types.Options+import Reddit.Types.Reddit+import Reddit.Types.Thing+import Reddit.Types.User+import qualified Reddit.Routes.Message as Route++import Control.Monad.IO.Class+import Data.Default+import Data.Text (Text)+import Network.API.Builder.Query++-- | Get the message inbox for the current user.+getInbox :: MonadIO m => RedditT m (Listing MessageKind Message)+getInbox = runRoute $ Route.inbox False def++-- | Don't use this for watching for new messages, Reddit's ordering on+-- |   inbox messages is odd and not likely to work how you expect.+getInbox' :: MonadIO m => Bool -> Options MessageKind -> RedditT m (Listing MessageKind Message)+getInbox' m o = runRoute $ Route.inbox m o++-- | Get any unread messages for the current user.+getUnread :: MonadIO m => RedditT m (Listing MessageKind Message)+getUnread = runRoute $ Route.unread False def++-- | Get unread messages for the current user, with options.+getUnread' :: MonadIO m+           => Bool -- ^ Whether the orangered notifier should be marked "off"+           -> Options MessageKind+           -> RedditT m (Listing MessageKind Message)+getUnread' m o = runRoute $ Route.unread m o++-- | Mark a message as read.+markRead :: (ToQuery a, Thing a, MonadIO m) => a -> RedditT m ()+markRead = nothing . runRoute . Route.readMessage++-- | Send a private message to another user.+sendMessage :: MonadIO m+            => Username -- ^ The username to send the message to+            -> Text -- ^ The subject of the message being sent+            -> Text -- ^ The body of the message being sent+            -> RedditT m ()+sendMessage u s b = nothing $ runRoute $ Route.sendMessage u s b++-- | Send a private message (with a captcha).+sendMessageWithCaptcha :: MonadIO m+                       => Username -- ^ The username to send the message to+                       -> Text -- ^ The subject of the message being sent+                       -> Text -- ^ The body of the message being sent+                       -> CaptchaID -- ^ The identifier of the captcha being answered+                       -> Text -- ^ The answer to the specified captcha+                       -> RedditT m ()+sendMessageWithCaptcha u s b i c = nothing $ runRoute $ Route.sendMessage u s b `withCaptcha` (i, c)
+ src/Reddit/Actions/Moderation.hs view
@@ -0,0 +1,28 @@+module Reddit.Actions.Moderation where++import Reddit.Routes.Moderation+import Reddit.Routes.Run+import Reddit.Types.Error+import Reddit.Types.Listing+import Reddit.Types.Moderation+import Reddit.Types.Options+import Reddit.Types.Reddit+import Reddit.Types.Subreddit+import Reddit.Types.User++import Network.API.Builder.Error++-- | Get a list of existing bans on a subreddit.+--   User must be a moderator of the subreddit.+bans :: Options BanID -> SubredditName -> Reddit (Listing BanID Ban)+bans opts r = runRoute $ bansListing opts r++-- | Check to see if a user is banned from a subreddit. Logged-in user must+--   be a moderator of the subreddit+lookupBan :: Username -> SubredditName -> Reddit (Maybe Ban)+lookupBan u r = do+  Listing _ _ bs <- runRoute $ banLookup u r :: Reddit (Listing BanID Ban)+  case bs of+    [b] -> return $ Just b+    [] -> return Nothing+    _-> failWith (APIError InvalidResponseError)
+ src/Reddit/Actions/Post.hs view
@@ -0,0 +1,195 @@+-- | Contains post-related actions, like submitting a post, getting+--   information for an existing post, and performing moderator actions+--   on posts.+module Reddit.Actions.Post+  ( getPosts+  , getPosts'+  , getPostComments+  , getPostSubComments+  , getComments+  , getPostInfo+  , getPostsInfo+  , submitLink+  , submitLinkWithCaptcha+  , submitSelfPost+  , submitSelfPostWithCaptcha+  , setInboxReplies+  , savePost+  , unsavePost+  , editPost+  , deletePost+  , setPostFlair+  , removePost+  , markPostSpam+  , stickyPost+  , unstickyPost+  , setContestMode ) where++import qualified Reddit.Routes as Route+import Reddit.Routes.Run+import Reddit.Types+import Reddit.Types.Captcha+import Reddit.Types.Comment+import Reddit.Types.Empty+import Reddit.Types.Listing+import Reddit.Types.Reddit++import Control.Monad.IO.Class+import Data.Default+import Data.Text (Text)+import Network.API.Builder.Error (APIError(..))+import qualified Data.Char as Char+import qualified Data.Text as Text++-- | Given a 'PostID', 'getPostInfo' will return the full details for that post.+getPostInfo :: MonadIO m => PostID -> RedditT m Post+getPostInfo p = do+  res <- getPostsInfo [p]+  case res of+    Listing _ _ [post] -> return post+    _ -> failWith $ APIError InvalidResponseError++-- | Given a list of 'PostID's, 'getPostsInfo' will return another list containing+--   the full details for all the posts. Note that Reddit's+--   API imposes a limitation of 100 posts per request, so this function will fail immediately if given a list of more than 100 IDs.+getPostsInfo :: MonadIO m => [PostID] -> RedditT m PostListing+getPostsInfo ps =+  -- we can only get 100 posts at a time or the api shits itself+  if null $ drop 100 ps+    then do+      res <- runRoute $ Route.aboutPosts ps+      case res of+        Listing _ _ posts | sameLength posts ps ->+          return res+        _ -> failWith $ APIError InvalidResponseError+    else failWith $ APIError TooManyRequests+  where+    sameLength (_:xs) (_:ys) = sameLength xs ys+    sameLength [] [] = True+    sameLength _ _ = False++-- | Get a 'PostListing' for the 'Hot' posts on the site overall.+--   This maps to <http://reddit.com>.+getPosts :: MonadIO m => RedditT m PostListing+getPosts = getPosts' def Hot Nothing++-- | Get a 'PostListing' for a specified listing.+getPosts' :: MonadIO m => Options PostID -> ListingType -> Maybe SubredditName -> RedditT m PostListing+getPosts' o l r = runRoute $ Route.postsListing o r (Text.pack $ lower $ show l)+  where lower = map Char.toLower++-- | Save a post.+savePost :: MonadIO m => PostID -> RedditT m ()+savePost = nothing . runRoute . Route.savePost++-- | Remove a saved post from your "saved posts" list.+unsavePost :: MonadIO m => PostID -> RedditT m ()+unsavePost = nothing . runRoute . Route.unsavePost++-- | Submit a new link to Reddit.+submitLink :: MonadIO m+           => SubredditName -- ^ The subreddit to which you're posting the link+           -> Text -- ^ The title of the link post+           -> Text -- ^ The link that you're posting+           -> RedditT m PostID+submitLink r title url = do+  POSTWrapped res <- runRoute $ Route.submitLink r title url+  return res++-- | Submit a new link to Reddit (answering a Captcha to prove we aren't a robot).+submitLinkWithCaptcha :: MonadIO m+                      => SubredditName -- ^ The subreddit to which you're posting the link+                      -> Text -- ^ The title of the link post+                      -> Text -- ^ The link that you're posting+                      -> CaptchaID -- ^ The ID of the captcha we're answering+                      -> Text -- ^ The answer to the provided captcha+                      -> RedditT m PostID+submitLinkWithCaptcha r title url iden captcha = do+  POSTWrapped res <- runRoute $ Route.submitLink r title url `withCaptcha` (iden, captcha)+  return res++-- | Submit a new selfpost to Reddit.+submitSelfPost :: MonadIO m+               => SubredditName -- ^ The subreddit to which you're posting the selfpost+               -> Text -- ^ The title of the selfpost+               -> Text -- ^ The body of the selfpost+               -> RedditT m PostID+submitSelfPost r title postBody = do+  POSTWrapped res <- runRoute $ Route.submitSelfPost r title postBody+  return res++-- | Submit a new selfpost to Reddit (answering a Captcha to prove we aren't a robot).+submitSelfPostWithCaptcha :: MonadIO m+                          => SubredditName -- ^ The subreddit to which you're posting the selfpost+                          -> Text -- ^ The title of the selfpost+                          -> Text -- ^ The body of the selfpost+                          -> CaptchaID -- ^ The ID of the captcha we're answering+                          -> Text -- ^ The answer to the provided captcha+                          -> RedditT m PostID+submitSelfPostWithCaptcha r title postBody iden captcha = do+  POSTWrapped res <- runRoute $ Route.submitSelfPost r title postBody `withCaptcha` (iden, captcha)+  return res++-- | Deletes one of your own posts. Note that this is different from+--   removing a post as a moderator action.+deletePost :: MonadIO m => PostID -> RedditT m ()+deletePost = nothing . runRoute . Route.delete++-- | Set the link flair for a post you've submitted (or any post on a subreddit+--   that you moderate).+setPostFlair :: MonadIO m+             => SubredditName -- ^ The subreddit on which to set the flair+             -> PostID -- ^ The post whose flair should be set+             -> Text -- ^ The text label for the post's new flair+             -> Text -- ^ The CSS class for the post's new flair+             -> RedditT m ()+setPostFlair r p text css = nothing $ runRoute $ Route.postFlair r p text css++-- | Edit the text of a self-post.+editPost :: MonadIO m => PostID -> Text -> RedditT m ()+editPost thing text = nothing $ runRoute $ Route.edit thing text++-- | Get a post and all its comments.+getPostComments :: MonadIO m => PostID -> RedditT m PostComments+getPostComments p = runRoute $ Route.getComments p Nothing++-- | Get a post and a specific sub-tree of comments.+getPostSubComments :: MonadIO m => PostID -> CommentID -> RedditT m PostComments+getPostSubComments p c = runRoute $ Route.getComments p (Just c)++-- | Get the comments for a post. Ignore the actual post itself.+getComments :: MonadIO m => PostID -> RedditT m [CommentReference]+getComments p = do+  PostComments _ c <- getPostComments p+  return c++-- | Set the state of inbox replies for the specified thread.+setInboxReplies :: MonadIO m => Bool -> PostID -> RedditT m ()+setInboxReplies enabled = nothing . runRoute . Route.sendReplies enabled++-- | Set the state of contest for the specified thread as a moderator action.+setContestMode :: MonadIO m => Bool -> PostID -> RedditT m ()+setContestMode enabled = nothing . runRoute . Route.setContestMode enabled++-- | Removes a post (as a moderator action). Note that this is different+--   from deleting a post.+removePost :: MonadIO m => PostID -> RedditT m ()+removePost = nothing . runRoute . Route.removePost False++-- | Mark a post as spam as a moderator action.+markPostSpam :: MonadIO m => PostID -> RedditT m ()+markPostSpam = nothing . runRoute . Route.removePost True++-- | Sticky a post on the subreddit on which it's posted.+stickyPost :: MonadIO m+           => PostID -- ^ The post to be stickied+           -> Maybe Integer -- ^ The position to which it should be stickied+           -> RedditT m ()+stickyPost p n = nothing $ runRoute $ Route.stickyPost True p n++-- | Unsticky a post from the subreddit on which it's posted.+unstickyPost :: MonadIO m+           => PostID -- ^ The post to be unstickied+           -> Maybe Integer -- ^ The position from which it should be unstickied+           -> RedditT m ()+unstickyPost p n = nothing $ runRoute $ Route.stickyPost False p n
+ src/Reddit/Actions/Search.hs view
@@ -0,0 +1,23 @@+module Reddit.Actions.Search where++import Reddit.Routes.Run+import Reddit.Routes.Search+import Reddit.Types.Options+import Reddit.Types.Post+import Reddit.Types.Reddit+import Reddit.Types.Subreddit+import qualified Reddit.Types.SearchOptions as Search++import Data.Text (Text)++search :: Maybe SubredditName -> Options PostID -> Search.Order -> Text -> Reddit PostListing+search sub opts order query =+  runRoute $ searchRoute sub opts order "plain" query++luceneSearch :: Maybe SubredditName -> Options PostID -> Search.Order -> Text -> Reddit PostListing+luceneSearch sub opts order query =+  runRoute $ searchRoute sub opts order "lucene" query++cloudSearch :: Maybe SubredditName -> Options PostID -> Search.Order -> Text -> Reddit PostListing+cloudSearch sub opts order query =+  runRoute $ searchRoute sub opts order "cloudsearch" query
+ src/Reddit/Actions/Subreddit.hs view
@@ -0,0 +1,27 @@+-- | Contains actions for interacting with a Subreddit as a whole.+module Reddit.Actions.Subreddit+  ( getSubredditInfo+  , getSubredditSettings+  , setSubredditSettings ) where++import Reddit.Routes.Run+import Reddit.Types+import Reddit.Types.Empty+import Reddit.Types.Subreddit+import Reddit.Types.SubredditSettings+import qualified Reddit.Routes as Route++import Control.Monad.IO.Class++-- | Get the info for a specific subreddit. This info includes things like+--   sidebar contents, description and ID.+getSubredditInfo :: MonadIO m => SubredditName -> RedditT m Subreddit+getSubredditInfo = runRoute . Route.aboutSubreddit++-- | Get the settings for a subreddit that you moderate.+getSubredditSettings :: MonadIO m => SubredditName -> RedditT m SubredditSettings+getSubredditSettings = runRoute . Route.subredditSettings++-- | Modify the settings for a subreddit that you moderate.+setSubredditSettings :: MonadIO m => SubredditID -> SubredditSettings -> RedditT m ()+setSubredditSettings r s = nothing $ runRoute (Route.setSubredditSettings r s)
+ src/Reddit/Actions/Thing.hs view
@@ -0,0 +1,39 @@+-- | Contains actions which are applicable to both Posts and Comments,+--   like replying, deleting and reporting.+module Reddit.Actions.Thing+  ( Reddit.Actions.Thing.reply+  , Reddit.Actions.Thing.delete+  , Reddit.Actions.Thing.report ) where++import Reddit.Routes.Run+import Reddit.Types+import Reddit.Types.Empty+import Reddit.Types.Reddit+import qualified Reddit.Routes.Thing as Route++import Control.Monad.IO.Class+import Data.Text (Text)++-- | Reply to a something (a post \/ comment \/ message)+reply :: (MonadIO m, Thing a)+      => a -- ^ Thing to reply to+      -> Text -- ^ Response contents+      -> RedditT m CommentID+reply t b = do+  POSTWrapped res <- runRoute $ Route.reply t b+  return res++-- | Delete something you created. Note that this is different to removing+--   a post / comment as a moderator action. Deleting something you don't+--   own won't error (but naturally won't delete anything either).+delete :: (MonadIO m, Thing a)+       => a -- ^ Thing to delete+       -> RedditT m ()+delete = nothing . runRoute . Route.delete++-- | Report something.+report :: (MonadIO m, Thing a)+       => a -- ^ Thing to report+       -> Text -- ^ Reason for reporting+       -> RedditT m ()+report t r = nothing $ runRoute $ Route.report t r
+ src/Reddit/Actions/User.hs view
@@ -0,0 +1,80 @@+-- | Contains user-related actions, like finding friends or retrieving a+--   user's comments or information.+module Reddit.Actions.User+  ( getUserInfo+  , aboutMe+  , getUserComments+  , getUserComments'+  , isUsernameAvailable+  , getBlockedUsers+  , getFriends+  , lookupUserFlair+  , setUserFlair ) where++import Reddit.Routes.Run+import Reddit.Types.Comment+import Reddit.Types.Empty+import Reddit.Types.Flair hiding (user)+import Reddit.Types.Error+import Reddit.Types.Listing+import Reddit.Types.Options+import Reddit.Types.Reddit+import Reddit.Types.Subreddit+import Reddit.Types.User+import qualified Reddit.Routes.User as Route++import Control.Monad+import Control.Monad.IO.Class+import Data.Default+import Data.Text (Text)+import Network.API.Builder.Error+import qualified Data.Text as Text++-- | Get the information Reddit exposes on user behind the specified username+getUserInfo :: MonadIO m => Username -> RedditT m User+getUserInfo = runRoute . Route.aboutUser++-- | Get the listing of comments authored by the specified user.+getUserComments :: MonadIO m => Username -> RedditT m CommentListing+getUserComments = getUserComments' def++-- | Get the listing of comments authored by the specified user, with Options.+getUserComments' :: MonadIO m => Options CommentID -> Username -> RedditT m CommentListing+getUserComments' opts user = runRoute $ Route.userComments opts user++-- | Check whether the specified username is still available or has been taken.+isUsernameAvailable :: MonadIO m => Username -> RedditT m Bool+isUsernameAvailable = runRoute . Route.usernameAvailable++-- | Get information of the currently-logged-in user.+aboutMe :: MonadIO m => RedditT m User+aboutMe = runRoute Route.aboutMe++-- | Get users blocked by the currently-logged-in user.+getBlockedUsers :: MonadIO m => RedditT m [Relationship]+getBlockedUsers = do+  UserList rs <- runRoute Route.blocked+  return rs++-- | Get friends of the currently-logged-in user.+getFriends :: MonadIO m => RedditT m [Relationship]+getFriends = do+  UserList rs <- runRoute Route.friends+  return rs++-- | Check if a user has chosen (or been assign) user flair on a particular+--   subreddit. Requires moderator privileges on the specified subreddit.+lookupUserFlair :: MonadIO m => SubredditName -> Username -> RedditT m Flair+lookupUserFlair r u = do+  res <- liftM flistToListing $ runRoute (Route.lookupUserFlair r u)+  case res of+    Listing _ _ [f] -> return f+    _ -> failWith $ APIError InvalidResponseError++-- | Set a user's flair on the specified subreddit. Requires moderator+--   privileges on the specified subreddit.+setUserFlair :: MonadIO m => SubredditName -> Username -> Text -> Text -> RedditT m ()+setUserFlair r u txt cls =+  if Text.length txt > 64+    then fail "Flair text too long!"+    else nothing $ runRoute $ Route.setUserFlair r u txt cls
+ src/Reddit/Actions/Voting.hs view
@@ -0,0 +1,50 @@+-- | Contains actions for voting on posts and comments. There are functions+--   for upvoting ('upvotePost', 'upvoteComment'), downvoting ('downvotePost',+--   'downVoteComment') as well as removing votes that have already been cast+--   ('unvotePost', 'unvoteComment').+--+--   Please note that automated voting (i.e. by a bot, as opposed to being+--   specifically ordered to by a person) is strictly against the Reddit rules,+--   and is a very effective way of getting your bot shadowbanned.+module Reddit.Actions.Voting+  ( upvotePost+  , downvotePost+  , unvotePost+  , upvoteComment+  , downvoteComment+  , unvoteComment ) where++import Reddit.Routes.Run+import Reddit.Routes.Vote (VoteDirection(..))+import Reddit.Types+import Reddit.Types.Empty+import qualified Reddit.Routes as Route++import Control.Monad.IO.Class++vote :: (MonadIO m, Thing a) => VoteDirection -> a -> RedditT m ()+vote dir = nothing . runRoute . Route.vote dir++-- | Upvote a post.+upvotePost :: MonadIO m => PostID -> RedditT m ()+upvotePost = vote UpVote++-- | Downvote a post.+downvotePost :: MonadIO m => PostID -> RedditT m ()+downvotePost = vote DownVote++-- | Remove a vote from a post.+unvotePost :: MonadIO m => PostID -> RedditT m ()+unvotePost = vote RemoveVote++-- | Upvote a comment.+upvoteComment :: MonadIO m => CommentID -> RedditT m ()+upvoteComment = vote UpVote++-- | Downvote a comment.+downvoteComment :: MonadIO m => CommentID -> RedditT m ()+downvoteComment = vote RemoveVote++-- | Remove a previously-cast vote from a comment.+unvoteComment :: MonadIO m => CommentID -> RedditT m ()+unvoteComment = vote DownVote
+ src/Reddit/Actions/Wiki.hs view
@@ -0,0 +1,29 @@+-- | Contains subreddit wiki-related actions.+module Reddit.Actions.Wiki+  ( getWikiPage+  , editWikiPage ) where++import Reddit.Routes.Run+import Reddit.Types.Empty+import Reddit.Types.Reddit+import Reddit.Types.Subreddit+import Reddit.Types.Wiki+import qualified Reddit.Routes as Route++import Control.Monad.IO.Class+import Data.Text (Text)++-- | Get the specified wiki page on a particular subreddit. Requires+--   permission to view the specified wiki page.+getWikiPage :: MonadIO m => SubredditName -> Text -> RedditT m WikiPage+getWikiPage sub page = runRoute $ Route.wikiPage sub page++-- | Edit the specified wiki page on a particular subreddit. Requires+--   permission to edit the specified wiki page.+editWikiPage :: MonadIO m+             => SubredditName -- ^ Subreddit whose wiki to modify+             -> Text -- ^ The name of the page you're editing+             -> Text -- ^ The new markdown content of the page you're editing+             -> Text -- ^ The reason for the edit+             -> RedditT m ()+editWikiPage sub page content reason = nothing $ runRoute $ Route.editPage sub page content reason
+ src/Reddit/Login.hs view
@@ -0,0 +1,48 @@+module Reddit.Login+  ( login ) where++import Reddit.Types.Error+import Reddit.Types.Reddit++import Control.Concurrent (threadDelay)+import Control.Concurrent.STM.TVar+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Trans.Except+import Control.Monad.Trans.State+import Data.Text (Text)+import Network.API.Builder+import Network.HTTP.Conduit++loginRoute :: Text -> Text -> Route+loginRoute user pass = Route [ "api", "login" ]+                             [ "rem" =. True+                             , "user" =. user+                             , "passwd" =. pass ]+                             "POST"++getLoginDetails :: MonadIO m => Text -> Text -> RedditT m LoginDetails+getLoginDetails user pass = do+  resp <- RedditT $ sendRoute () $ loginRoute user pass+  let cj = responseCookieJar resp+  case unwrapJSON `fmap` receive resp of+    Left x@(APIError (RateLimitError wait _)) -> do+      RateLimits limiting _ <- RedditT $ liftState get >>= liftIO . readTVarIO+      if limiting+        then do+          liftIO $ threadDelay $ (fromIntegral wait + 5) * 1000000+          getLoginDetails user pass+        else RedditT $ ExceptT $ return $ Left x+    Left x -> RedditT $ ExceptT $ return $ Left x+    Right modhash -> return $ LoginDetails modhash cj+++-- | Make a login request with the given username and password.+login :: MonadIO m+      => Text -- ^ Username to login with+      -> Text -- ^ Password to login with+      -> RedditT m LoginDetails+login user pass = do+  RedditT $ baseURL loginBaseURL+  d <- getLoginDetails user pass+  RedditT $ baseURL mainBaseURL+  return d
+ src/Reddit/Parser.hs view
@@ -0,0 +1,28 @@+-- | Utilities for parsing JSON responses from the API+module Reddit.Parser+  ( ensureKind+  , stripPrefix ) where++import Control.Monad (guard)+import Data.Aeson.Types (Parser, Object, (.:))+import Data.Monoid+import Data.Text (Text)+import Prelude+import qualified Data.Text as Text++-- | Fail to parse unless the @Object@'s kind is what it should be.+ensureKind :: Object -> Text -> Parser ()+ensureKind o k = do+  kind <- o .: "kind"+  guard $ kind == k++-- | Parse an ID in either the "tX_XXXXXX" or simply "XXXXXX" format.+stripPrefix :: Text -> Text -> Parser Text+stripPrefix prefix string =+  case Text.breakOn "_" string of+    (t, i) | t == prefix ->+      case Text.stripPrefix "_" i of+        Just rest -> return rest+        Nothing -> mempty+    (i, "") -> return i+    _ -> mempty
+ src/Reddit/Routes.hs view
@@ -0,0 +1,13 @@+module Reddit.Routes+  ( module Routes ) where++import Reddit.Routes.Captcha as Routes+import Reddit.Routes.Comment as Routes+import Reddit.Routes.Flair as Routes+import Reddit.Routes.Message as Routes+import Reddit.Routes.Post as Routes+import Reddit.Routes.Subreddit as Routes+import Reddit.Routes.Thing as Routes+import Reddit.Routes.User as Routes+import Reddit.Routes.Vote as Routes+import Reddit.Routes.Wiki as Routes
+ src/Reddit/Routes/Captcha.hs view
@@ -0,0 +1,21 @@+module Reddit.Routes.Captcha where++import Reddit.Types.Captcha++import Network.API.Builder.Routes++needsCaptcha :: Route+needsCaptcha = Route [ "api", "needs_captcha.json" ]+                     [ ]+                     "GET"++newCaptcha :: Route+newCaptcha = Route [ "api", "new_captcha" ]+                   [ ]+                   "POST"++getCaptcha :: CaptchaID -> Route+getCaptcha (CaptchaID c) =+  Route [ "captcha", c ]+        [ ]+        "GET"
+ src/Reddit/Routes/Comment.hs view
@@ -0,0 +1,37 @@+module Reddit.Routes.Comment where++import Reddit.Types.Comment+import Reddit.Types.Options+import Reddit.Types.Post+import Reddit.Types.Subreddit++import Network.API.Builder.Routes++aboutComment :: CommentID -> Route+aboutComment pID = Route [ "api", "info" ]+                         [ "id" =. pID ]+                         "GET"++moreChildren :: PostID -> [CommentID] -> Route+moreChildren p cs = Route [ "api", "morechildren" ]+                          [ "link_id" =. p+                          , "children" =. map (\(CommentID x) -> x) cs ]+                          "POST"++newComments :: Options CommentID -> Maybe SubredditName -> Route+newComments opts r =+  Route url+        [ "before" =. before opts+        , "after" =. after opts+        , "limit" =. limit opts ]+        "GET"+  where+    url = case r of+      Just (R sub) -> [ "r", sub, "comments" ]+      Nothing -> [ "comments" ]++commentsInfo :: [CommentID] -> Route+commentsInfo cs =+  Route [ "api", "info" ]+        [ "id" =. cs ]+        "GET"
+ src/Reddit/Routes/Flair.hs view
@@ -0,0 +1,36 @@+module Reddit.Routes.Flair where++import Reddit.Types.Options+import Reddit.Types.Subreddit+import Reddit.Types.User++import Data.Text (Text)+import Network.API.Builder.Routes+import qualified Data.Text as Text++flairList :: Options UserID -> SubredditName -> Route+flairList opts (R r) =+  Route [ "r", r, "api", "flairlist" ]+        [ "after" =. after opts+        , "before" =. before opts+        , "limit" =. limit opts ]+        "GET"++addLinkFlairTemplate :: SubredditName -> Text -> Text -> Bool -> Route+addLinkFlairTemplate (R sub) css label editable =+  Route [ "r", sub, "api", "flairtemplate" ]+        [ "css_class" =. css+        , "flair_type" =. ("LINK_FLAIR" :: Text)+        , "text" =. label+        , "text_editable" =. editable ]+        "POST"++flairCSVRoute :: SubredditName -> [(Username, Text, Text)] -> Route+flairCSVRoute (R sub) sets =+  Route [ "r", sub, "api", "flaircsv" ]+        [ "flair_csv" =. Text.unlines (map f sets) ]+        "POST"+  where+    f (Username u, t, c) =+      Text.intercalate "," $ map (Text.pack . show) [u,t,c]+
+ src/Reddit/Routes/Message.hs view
@@ -0,0 +1,40 @@+module Reddit.Routes.Message where++import Reddit.Types.Options+import Reddit.Types.Message+import Reddit.Types.Thing+import Reddit.Types.User++import Data.Text (Text)+import Network.API.Builder.Routes++inbox :: Bool -> Options MessageKind -> Route+inbox shouldMark opts =+  Route [ "message", "inbox" ]+        [ "mark" =. shouldMark+        , "before" =. before opts+        , "after" =. after opts+        , "limit" =. limit opts ]+        "GET"++unread :: Bool -> Options MessageKind -> Route+unread shouldMark opts =+  Route [ "message", "unread" ]+        [ "mark" =. shouldMark+        , "before" =. before opts+        , "after" =. after opts+        , "limit" =. limit opts ]+        "GET"++readMessage :: Thing a => a -> Route+readMessage m = Route [ "api", "read_message" ]+                      [ "id" =. fullName m ]+                      "POST"++sendMessage :: Username -> Text -> Text -> Route+sendMessage (Username u) s b =+  Route [ "api", "compose" ]+        [ "to" =. u+        , "subject" =. s+        , "text" =. b ]+        "POST"
+ src/Reddit/Routes/Moderation.hs view
@@ -0,0 +1,22 @@+module Reddit.Routes.Moderation where++import Reddit.Types.Moderation+import Reddit.Types.Options+import Reddit.Types.Subreddit+import Reddit.Types.User++import Network.API.Builder.Routes++bansListing :: Options BanID -> SubredditName -> Route+bansListing opts (R sub) =+  Route [ "r", sub, "about", "banned" ]+        [ "before" =. before opts+        , "after" =. after opts+        , "limit" =. limit opts]+        "GET"++banLookup :: Username -> SubredditName -> Route+banLookup (Username u) (R sub) =+  Route [ "r", sub, "about", "banned" ]+        [ "user" =. u ]+        "GET"
+ src/Reddit/Routes/Post.hs view
@@ -0,0 +1,105 @@+module Reddit.Routes.Post where++import Reddit.Types.Options+import Reddit.Types.Comment (CommentID(..))+import Reddit.Types.Post (PostID(..))+import Reddit.Types.Subreddit (SubredditName(..))+import Reddit.Types.Thing++import Data.Text (Text)+import Network.API.Builder.Query+import Network.API.Builder.Routes++postsListing :: Options PostID -> Maybe SubredditName -> Text -> Route+postsListing opts r t =+  Route (endpoint r)+        [ "before" =. before opts+        , "after" =. after opts+        , "limit" =. limit opts ]+        "GET"+  where endpoint Nothing = [ t ]+        endpoint (Just (R name)) = [ "r", name, t ]++aboutPosts :: [PostID] -> Route+aboutPosts ps =+  Route [ "api", "info" ]+        [ "id" =. ps ]+        "GET"++savePost :: PostID -> Route+savePost p = Route [ "api", "save" ]+                   [ "id" =. p ]+                   "POST"++unsavePost :: PostID -> Route+unsavePost p = Route [ "api", "unsave" ]+                     [ "id" =. p ]+                     "POST"++submitLink :: SubredditName -> Text -> Text -> Route+submitLink (R name) title url =+  Route [ "api", "submit" ]+        [ "extension" =. ("json" :: Text)+        , "kind" =. ("link" :: Text)+        , "save" =. True+        , "resubmit" =. False+        , "sendreplies" =. True+        , "then" =. ("tb" :: Text)+        , "title" =. title+        , "url" =. url+        , "sr" =. name]+        "POST"++submitSelfPost :: SubredditName -> Text -> Text -> Route+submitSelfPost (R name) title text =+  Route [ "api", "submit" ]+        [ "extension" =. ("json" :: Text)+        , "kind" =. ("self" :: Text)+        , "save" =. True+        , "resubmit" =. False+        , "sendreplies" =. True+        , "then" =. ("tb" :: Text)+        , "title" =. title+        , "text" =. text+        , "sr" =. name]+        "POST"++getComments :: PostID -> Maybe CommentID -> Route+getComments (PostID p) c = Route [ "comments", p ]+                                 [ "comment" =. fmap f c ]+                                 "GET"+  where f (CommentID x) = x++sendReplies :: Bool -> PostID -> Route+sendReplies setting p = Route [ "api", "sendreplies" ]+                              [ "id" =. p+                              , "state" =. setting ]+                              "POST"++removePost :: (ToQuery a, Thing a) => Bool -> a -> Route+removePost isSpam p = Route [ "api", "remove" ]+                            [ "id" =. p+                            , "spam" =. isSpam ]+                            "POST"++stickyPost :: Bool -> PostID -> Maybe Integer -> Route+stickyPost on p n =+  Route [ "api", "set_subreddit_sticky" ]+        [ "id" =. p+        , "state" =. on+        , "num" =. n ]+        "POST"++setContestMode :: Bool -> PostID -> Route+setContestMode on p = Route [ "api", "set_contest_mode" ]+                            [ "id" =. p+                            , "state" =. on ]+                            "POST"++postFlair :: SubredditName -> PostID -> Text -> Text -> Route+postFlair (R sub) p text css =+  Route [ "r", sub, "api", "flair" ]+        [ "link" =. fullName p+        , "text" =. text+        , "css_class" =. css ]+        "POST"
+ src/Reddit/Routes/Run.hs view
@@ -0,0 +1,76 @@+module Reddit.Routes.Run+  ( runRoute ) where++import Reddit.Types.Error+import Reddit.Types.Reddit++import Control.Concurrent (threadDelay)+import Control.Concurrent.STM+import Control.Monad (liftM, when)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Trans.Except+import Control.Monad.Trans.State+import Data.Aeson (FromJSON(..))+import Data.ByteString.Lazy (ByteString)+import Data.Time.Clock+import Network.API.Builder.Routes (Route)+import Network.HTTP.Conduit+import Network.HTTP.Types+import qualified Network.API.Builder as API++runRoute :: (MonadIO m, FromJSON a) => Route -> RedditT m a+runRoute route = do+  RateLimits limiting _ <- RedditT $ API.liftState get >>= liftIO . readTVarIO+  if limiting+    then runRouteWithLimiting route+    else RedditT $ API.unwrapJSON `liftM` API.runRoute route++runRouteWithLimiting :: (MonadIO m, FromJSON a) => Route -> RedditT m a+runRouteWithLimiting route = do+  RateLimits _ rli <- RedditT $ API.liftState get >>= liftIO . readTVarIO+  case rli of+    Just r -> do+      when (needsReset r) $ waitForReset $ resetTime r+      requestAndUpdate+    Nothing -> requestAndUpdate+  where+    requestAndUpdate = do+      resp <- nest $ RedditT $ API.routeResponse route+      case resp of+        Left (API.APIError (RateLimitError resetIn _)) -> do+          updateFromZero resetIn+          runRouteWithLimiting route+        Left x -> RedditT $ ExceptT $ return $ Left x+        Right x -> do+          updateRateLimitInfo $ responseHeaders x+          decodeFromResponse x++decodeFromResponse :: (Monad m, FromJSON a) => Response ByteString -> RedditT m a+decodeFromResponse = RedditT . ExceptT . return . fmap API.unwrapJSON . API.receive++updateRateLimitInfo :: MonadIO m => ResponseHeaders -> RedditT m ()+updateRateLimitInfo hs = do+  time <- liftIO getCurrentTime+  case headersToRateLimitInfo hs time of+    Just rli ->+      RedditT $ do+        r <- API.liftState get+        liftIO $ atomically $ modifyTVar r (\(RateLimits b _) -> RateLimits b $ Just rli)+    Nothing -> return ()++updateFromZero :: MonadIO m => Integer -> RedditT m ()+updateFromZero resetIn = do+  time <- liftIO getCurrentTime+  let resetAt = addUTCTime (fromInteger resetIn) time+  RedditT $ do+    r <- API.liftState get+    liftIO $ atomically $ modifyTVar r (\(RateLimits b _) -> RateLimits b $ Just $ RateLimitInfo 0 0 resetAt)++waitForReset :: MonadIO m => UTCTime -> RedditT m ()+waitForReset dt = do+  time <- liftIO getCurrentTime+  let wait = floor $ diffUTCTime dt time+  liftIO $ threadDelay $ (wait + 5) * 1000000 -- wait five extra seconds to account for timing differences++needsReset :: RateLimitInfo -> Bool+needsReset = (<= 0) . remaining
+ src/Reddit/Routes/Search.hs view
@@ -0,0 +1,24 @@+module Reddit.Routes.Search where++import Reddit.Types.Options+import Reddit.Types.Post+import Reddit.Types.Subreddit+import qualified Reddit.Types.SearchOptions as Search++import Data.Maybe+import Data.Text (Text)+import Network.API.Builder.Routes++searchRoute :: Maybe SubredditName -> Options PostID -> Search.Order -> Text -> Text -> Route+searchRoute r opts sorder engine q =+  Route (path r)+        [ "after" =. after opts+        , "before" =. before opts+        , "restrict_sr" =. isJust r+        , "sort" =. sorder+        , "syntax" =. engine+        , "q" =. Just q ]+        "GET"+  where+    path (Just (R sub)) = [ "r", sub, "search" ]+    path Nothing = [ "search" ]
+ src/Reddit/Routes/Subreddit.hs view
@@ -0,0 +1,42 @@+module Reddit.Routes.Subreddit where++import Reddit.Types.Subreddit hiding (title)+import Reddit.Types.SubredditSettings++import Network.API.Builder.Routes++aboutSubreddit :: SubredditName -> Route+aboutSubreddit (R sub) = Route ["r", sub, "about"]+                               []+                               "GET"++subredditSettings :: SubredditName -> Route+subredditSettings (R sub) = Route ["r", sub, "about", "edit"]+                                  []+                                  "GET"++setSubredditSettings :: SubredditID -> SubredditSettings -> Route+setSubredditSettings sr settings =+  Route ["api", "site_admin"]+        [ "sr" =. sr+        , "description" =. sidebarText settings+        , "public_description" =. descriptionText settings+        , "title" =. title settings+        , "link_type" =. linkType settings+        , "comment_score_hide_mins" =. hideScoreMins settings+        , "submit_link_label" =. submitLinkLabel settings+        , "submit_text_label" =. submitTextLabel settings+        , "domain_css" =. domainCSS settings+        , "domain_sidebar" =. domainSidebar settings+        , "show_media" =. showMedia settings+        , "over_18" =. over18 settings+        , "language" =. language settings+        , "wiki_edit_karma" =. wikiEditKarma settings+        , "wiki_edit_age" =. wikiEditAge settings+        , "wikimode" =. wikiEditMode settings+        , "spam_comments" =. spamComments settings+        , "spam_selfposts" =. spamSelfposts settings+        , "spam_links" =. spamLinks settings+        , "public_traffic" =. publicTrafficStats settings+        , "type" =. subredditType settings ]+        "POST"
+ src/Reddit/Routes/Thing.hs view
@@ -0,0 +1,29 @@+module Reddit.Routes.Thing where++import Reddit.Types.Thing++import Data.Text (Text)+import Network.API.Builder.Routes++reply :: Thing a => a -> Text -> Route+reply thingID body = Route [ "api", "comment" ]+                           [ "parent" =. fullName thingID+                           , "text" =. body ]+                           "POST"++delete :: Thing a => a -> Route+delete t = Route [ "api", "del" ]+                 [ "id" =. fullName t ]+                 "POST"++edit :: Thing a => a -> Text -> Route+edit t newText = Route [ "api", "editusertext" ]+                       [ "thing_id" =. fullName t+                       , "text" =. newText ]+                       "POST"++report :: Thing a => a -> Text -> Route+report t r = Route [ "api", "report" ]+                   [ "thing_id" =. fullName t+                   , "reason" =. r ]+                   "POST"
+ src/Reddit/Routes/User.hs view
@@ -0,0 +1,56 @@+module Reddit.Routes.User where++import Reddit.Types.Comment (CommentID)+import Reddit.Types.Options+import Reddit.Types.Subreddit+import Reddit.Types.User++import Data.Text (Text)+import Network.API.Builder.Routes++aboutUser :: Username -> Route+aboutUser (Username user) = Route [ "user", user, "about.json" ]+                                  []+                                  "GET"++aboutMe :: Route+aboutMe = Route [ "api", "me.json" ]+                []+                "GET"++userComments :: Options CommentID -> Username -> Route+userComments opts (Username user) =+  Route [ "user", user, "comments" ]+        [ "limit" =. limit opts+        , "before" =. before opts+        , "after" =. after opts ]+        "GET"++usernameAvailable :: Username -> Route+usernameAvailable user = Route [ "api", "username_available.json" ]+                               [ "user" =. user]+                               "GET"++blocked :: Route+blocked = Route [ "prefs", "blocked" ]+                [ ]+                "GET"++friends :: Route+friends = Route [ "prefs", "friends" ]+                [ ]+                "GET"++lookupUserFlair :: SubredditName -> Username -> Route+lookupUserFlair (R r) u =+  Route [ "r", r, "api", "flairlist" ]+        [ "name" =. u ]+        "GET"++setUserFlair :: SubredditName -> Username -> Text -> Text -> Route+setUserFlair (R r) u txt cls =+  Route [ "r", r, "api", "flair" ]+        [ "name" =. u+        , "text" =. txt+        , "css_class" =. cls ]+        "POST"
+ src/Reddit/Routes/Vote.hs view
@@ -0,0 +1,22 @@+module Reddit.Routes.Vote where++import Reddit.Types.Thing++import Network.API.Builder.Query+import Network.API.Builder.Routes++data VoteDirection = UpVote+                   | RemoveVote+                   | DownVote+  deriving (Show, Read, Eq)++instance ToQuery VoteDirection where+  toQuery k UpVote = [(k, "1")]+  toQuery k RemoveVote = [(k, "0")]+  toQuery k DownVote = [(k, "-1")]++vote :: Thing a => VoteDirection -> a -> Route+vote direction tID = Route [ "api", "vote" ]+                           [ "id" =. Just (fullName tID)+                           , "dir" =. direction ]+                           "POST"
+ src/Reddit/Routes/Wiki.hs view
@@ -0,0 +1,21 @@+module Reddit.Routes.Wiki where++import Reddit.Types.Subreddit++import Data.Text (Text)+import Network.API.Builder.Routes++wikiPage :: SubredditName -> Text -> Route+wikiPage (R sub) page =+  Route [ "r", sub, "wiki", page ]+        [ ]+        "GET"++editPage :: SubredditName -> Text -> Text -> Text -> Route+editPage (R sub) page content reason =+  Route [ "r", sub, "api", "wiki", "edit" ]+        [ "page" =. page+        , "content" =. content+        --, "previous" =. previous+        , "reason" =. reason ]+        "POST"
+ src/Reddit/Types.hs view
@@ -0,0 +1,37 @@+module Reddit.Types+  ( CaptchaID(..)+  , Comment+  , CommentID(..)+  , CommentListing+  , Listing(..)+  , LoginDetails+  , Message+  , MessageID(..)+  , MessageKind(..)+  , Modhash+  , Options(..)+  , PaginationOption(..)+  , Post+  , PostContent(..)+  , PostID(..)+  , PostListing+  , Reddit+  , RedditError(..)+  , RedditT+  , Subreddit+  , SubredditName(..)+  , Thing+  , User+  , Username(..) ) where++import Reddit.Types.Captcha (CaptchaID(..))+import Reddit.Types.Comment (CommentID(..), Comment, CommentListing)+import Reddit.Types.Error (RedditError(..))+import Reddit.Types.Listing (Listing(..))+import Reddit.Types.Message (MessageID(..), Message, MessageKind(..))+import Reddit.Types.Options (PaginationOption(..), Options(..))+import Reddit.Types.Post (PostID(..), Post, PostListing, PostContent(..))+import Reddit.Types.Reddit (Reddit, RedditT, Modhash, LoginDetails)+import Reddit.Types.Subreddit (SubredditName(..), Subreddit)+import Reddit.Types.Thing (Thing)+import Reddit.Types.User (Username(..), User)
+ src/Reddit/Types/Captcha.hs view
@@ -0,0 +1,27 @@+module Reddit.Types.Captcha where++import Reddit.Types.Reddit++import Control.Applicative+import Data.Aeson+import Data.Monoid+import Data.Text (Text)+import Network.API.Builder+import Prelude++newtype CaptchaID = CaptchaID Text+  deriving (Read, Show, Eq, Ord)++instance FromJSON CaptchaID where+  parseJSON j = CaptchaID <$> parseJSON j++instance FromJSON (POSTWrapped CaptchaID) where+  parseJSON (Object o) =+    POSTWrapped <$> ((o .: "json") >>= (.: "data") >>= (.: "iden"))+  parseJSON _ = mempty++withCaptcha :: Route -> (CaptchaID, Text) -> Route+withCaptcha (Route pieces params meth) (CaptchaID i, c) =+  Route pieces (iden : captcha : params) meth+  where iden = ("iden" :: Text) =. i+        captcha = ("captcha" :: Text) =. c
+ src/Reddit/Types/Comment.hs view
@@ -0,0 +1,152 @@+module Reddit.Types.Comment where++import Reddit.Parser+import Reddit.Types.Listing+import Reddit.Types.Post hiding (author)+import Reddit.Types.Reddit+import Reddit.Types.Subreddit+import Reddit.Types.Thing+import Reddit.Types.User+import Reddit.Utilities++import Control.Applicative+import Data.Aeson+import Data.Aeson.Types (Parser)+import Data.Time.Clock+import Data.Time.Clock.POSIX+import Data.Monoid+import Data.Text (Text)+import Data.Traversable+import Network.API.Builder.Query+import Prelude+import qualified Data.Text as Text+import qualified Data.Vector as Vector++newtype CommentID = CommentID Text+  deriving (Show, Read, Eq, Ord)++instance FromJSON CommentID where+  parseJSON (String s) =+    CommentID <$> stripPrefix commentPrefix s+  parseJSON _ = mempty++instance Thing CommentID where+  fullName (CommentID cID) = Text.concat [commentPrefix, "_", cID]++instance ToQuery CommentID where+  toQuery k v = [(k, fullName v)]++instance FromJSON (POSTWrapped CommentID) where+  parseJSON (Object o) = do+    ts <- (o .: "json") >>= (.: "data") >>= (.: "things")+    case Vector.toList ts of+      [v] -> POSTWrapped <$> (v .: "data" >>= (.: "id"))+      _ -> mempty+  parseJSON _ = mempty++data CommentReference = Reference Integer [CommentID]+                      | Actual Comment+  deriving (Show, Read, Eq)++instance FromJSON CommentReference where+  parseJSON v@(Object o) = do+    k <- o .: "kind"+    case k of+      String "t1" -> Actual <$> parseJSON v+      String "more" ->+        Reference <$> ((o .: "data") >>= (.: "count"))+                  <*> ((o .: "data") >>= (.: "children"))+      _ -> mempty+  parseJSON _ = mempty++instance FromJSON (POSTWrapped [CommentReference]) where+  parseJSON (Object o) = do+    cs <- (o .: "json") >>= (.: "data") >>= (.: "things")+    POSTWrapped <$> parseJSON cs+  parseJSON _ = mempty++-- | @isReference c@ returns is true if @c@ is an actual comment, false otherwise+isActual :: CommentReference -> Bool+isActual (Actual _) = True+isActual _ = False++-- | @isReference c@ returns is true if @c@ is a reference, false otherwise+isReference :: CommentReference -> Bool+isReference (Reference _ _) = True+isReference _ = False++data Comment = Comment { commentID :: CommentID+                       , score :: Maybe Integer+                       , subredditID :: SubredditID+                       , subreddit :: SubredditName+                       , gilded :: Integer+                       , saved :: Bool+                       , author :: Username+                       , authorFlairCSSClass :: Maybe Text+                       , authorFlairText :: Maybe Text+                       , body :: Text+                       , bodyHTML :: Text+                       , replies :: Listing CommentID CommentReference+                       , created :: UTCTime+                       , edited :: Maybe UTCTime+                       , parentLink :: PostID+                       , inReplyTo :: Maybe CommentID }+  deriving (Show, Read, Eq)++instance Thing Comment where+  fullName c = fullName (commentID c)++instance FromJSON Comment where+  parseJSON (Object o) = do+    o `ensureKind` commentPrefix+    d <- o .: "data"+    Comment <$> d .: "id"+            <*> d .:? "score"+            <*> d .: "subreddit_id"+            <*> d .: "subreddit"+            <*> d .: "gilded"+            <*> d .: "saved"+            <*> d .: "author"+            <*> d .:? "author_flair_css_class"+            <*> d .:? "author_flair_text"+            <*> (unescape <$> d .: "body")+            <*> d .: "body_html"+            <*> d .: "replies"+            <*> (posixSecondsToUTCTime . fromInteger <$> d .: "created_utc")+            <*> ((fmap (posixSecondsToUTCTime . fromInteger) <$> d .: "edited") <|> pure Nothing)+            <*> (parseJSON =<< d .: "link_id")+            <*> (d .:? "parent_id" >>= \v -> traverse parseJSON v <|> pure Nothing)+  parseJSON _ = mempty++instance FromJSON (POSTWrapped Comment) where+  parseJSON (Object o) = do+    ts <- (o .: "json") >>= (.: "data") >>= (.: "things")+    case Vector.toList ts of+      [c] -> POSTWrapped <$> parseJSON c+      _ -> mempty+  parseJSON _ = mempty++treeSubComments :: CommentReference -> [CommentReference]+treeSubComments a@(Actual c) = a : concatMap treeSubComments ((\(Listing _ _ cs) -> cs) $ replies c)+treeSubComments (Reference _ rs) = map (\r -> Reference 1 [r]) rs++isDeleted :: Comment -> Bool+isDeleted = (== Username "[deleted]") . author++data PostComments = PostComments Post [CommentReference]+  deriving (Show, Read, Eq)++instance FromJSON PostComments where+  parseJSON (Array a) =+    case Vector.toList a of+      postListing:commentListing:_ -> do+        Listing _ _ [post] <- parseJSON postListing :: Parser (Listing PostID Post)+        Listing _ _ comments <- parseJSON commentListing :: Parser (Listing CommentID CommentReference)+        return $ PostComments post comments+      _ -> mempty+  parseJSON _ = mempty++type CommentListing = Listing CommentID Comment++commentPrefix :: Text+commentPrefix = "t1"
+ src/Reddit/Types/Empty.hs view
@@ -0,0 +1,26 @@+module Reddit.Types.Empty ( nothing ) where++import Control.Monad (liftM)+import Data.Aeson+import Data.Aeson.Types+import Data.Monoid+import Prelude+import qualified Data.HashMap.Strict as Hash++-- | More specific @void@ for forcing a @Empty@ @FromJSON@ instance+nothing :: Monad m => m Empty -> m ()+nothing = liftM $ const ()++data Empty = Empty+  deriving (Show, Read, Eq)++instance FromJSON Empty where+  parseJSON (Object o) =+    if Hash.null o+      then return Empty+      else do+        errs <- (o .: "json") >>= (.: "errors") :: Parser [Value]+        if null errs+          then return Empty+          else mempty+  parseJSON _ = mempty
+ src/Reddit/Types/Error.hs view
@@ -0,0 +1,53 @@+module Reddit.Types.Error+  (RedditError(..)) where++import Control.Applicative+import Data.Aeson+import Data.Monoid+import Data.Text (Text)+import Data.Vector ((!?))+import Network.API.Builder.Receive+import Prelude+import qualified Data.Vector as V++data RedditError = RedditError Object+                 | FailError Text+                 | InvalidResponseError+                 | CaptchaError Text+                 | CredentialsError+                 | RateLimitError Integer Text+                 | NoSubredditSpecified+                 | NoURLSpecified+                 | NoName+                 | NoText Text+                 | AlreadySubmitted+                 | CommentDeleted+                 | LinkDeleted+                 | BadSubredditName+                 | TooManyRequests+                 deriving (Show, Eq)++instance FromJSON RedditError where+  parseJSON (Object o) = do+    Array errors <- o .: "json" >>= (.: "errors")+    case errors !? 0 of+      Just (Array e) -> case V.toList e of+        String "WRONG_PASSWORD" : _ -> return CredentialsError+        String "USER_REQUIRED" : _ -> return CredentialsError+        String "RATELIMIT" : String d : _ ->+            RateLimitError <$> ((o .: "json") >>= (.: "ratelimit")) <*> pure d+        String "SUBREDDIT_REQUIRED" : _ -> return NoSubredditSpecified+        String "ALREADY_SUB" : _ -> return AlreadySubmitted+        String "NO_URL" : _ -> return NoURLSpecified+        String "NO_NAME" : _ -> return NoName+        String "NO_TEXT" : _ : String f : _ -> return $ NoText f+        String "COMMENT_DELETED" : _ -> return CommentDeleted+        String "DELETED_LINK" : _ -> return LinkDeleted+        String "BAD_SR_NAME" : _ -> return BadSubredditName+        String "BAD_CAPTCHA" : _ -> CaptchaError <$> (o .: "json" >>= (.: "captcha"))+        _ -> return $ RedditError o+      _ -> mempty+  parseJSON _ = mempty++instance ErrorReceivable RedditError where+  receiveError = useErrorFromJSON
+ src/Reddit/Types/Flair.hs view
@@ -0,0 +1,38 @@+module Reddit.Types.Flair where++import Reddit.Types.Listing+import Reddit.Types.User++import Control.Applicative+import Data.Aeson+import Data.Monoid+import Data.Text (Text)+import Prelude+++data Flair = Flair { user :: Username+                   , text :: Maybe Text+                   , cssClass :: Maybe Text }+  deriving (Show, Read, Eq)++instance FromJSON Flair where+  parseJSON (Object o) =+    Flair <$> o .: "user"+          <*> o .:? "flair_text"+          <*> o .:? "flair_css_class"+  parseJSON _ = mempty++data FList = FList [Flair] (Maybe UserID) (Maybe UserID)+  deriving (Show, Read, Eq)++instance FromJSON FList where+  parseJSON (Object o) =+    FList <$> o .: "users"+          <*> o .:? "next"+          <*> o .:? "prev"+  parseJSON _ = mempty++type FlairListing = Listing UserID Flair++flistToListing :: FList -> FlairListing+flistToListing (FList f b a) = Listing b a f
+ src/Reddit/Types/Listing.hs view
@@ -0,0 +1,49 @@+module Reddit.Types.Listing where++import Reddit.Parser++import Control.Applicative+import Data.Aeson+import Data.Traversable+import Data.Monoid+import Network.API.Builder.Query+import Prelude++data ListingType = Hot+                 | New+                 | Rising+                 | Controversial+                 | Top+  deriving (Show, Read, Eq)++instance ToQuery ListingType where+  toQuery k t = return $ (,) k $ case t of+    Hot -> "hot"+    New -> "new"+    Rising -> "rising"+    Controversial -> "controversial"+    Top -> "top"++data Listing t a = Listing { before :: Maybe t+                           , after :: Maybe t+                           , contents :: [a] }+  deriving (Show, Read, Eq)++instance Functor (Listing t) where+  fmap f (Listing b a x) = Listing b a (fmap f x)++instance Ord t => Monoid (Listing t a) where+  mappend (Listing a b cs) (Listing d e fs) =+    Listing (max a d) (min b e) (cs <> fs)+  mempty = Listing Nothing Nothing []++instance (FromJSON t, FromJSON a) => FromJSON (Listing t a) where+  parseJSON (Object o) = do+    o `ensureKind` "Listing"+    d <- o .: "data"+    Listing <$> (d .:? "before" >>= traverse parseJSON)+            <*> (d .:? "after" >>= traverse parseJSON)+            <*> (o .: "data" >>= (.: "children"))+  parseJSON (String "") = return $ Listing Nothing Nothing []+  parseJSON Null = return $ Listing Nothing Nothing []+  parseJSON _ = mempty
+ src/Reddit/Types/Message.hs view
@@ -0,0 +1,91 @@+module Reddit.Types.Message where++import Reddit.Parser+import Reddit.Types.Comment+import Reddit.Types.Listing+import Reddit.Types.Thing+import Reddit.Types.User+import Reddit.Utilities++import Control.Applicative+import Data.Aeson+import Data.Maybe+import Data.Monoid+import Data.Text (Text)+import Network.API.Builder.Query+import Prelude++data Message = Message { messageID :: MessageKind+                       , new :: Bool+                       , to :: Username+                       , from :: Maybe Username+                       , subject :: Text+                       , body :: Text+                       , bodyHTML :: Text+                       , replies :: Listing MessageKind Message }+  deriving (Show, Read, Eq)++instance FromJSON Message where+  parseJSON (Object o) = do+    d <- o .: "data"+    Message <$> d .: "name"+            <*> d .: "new"+            <*> d .: "dest"+            <*> d .:? "author"+            <*> (d .: "link_title" <|> d .: "subject")+            <*> (unescape <$> d .: "body")+            <*> (unescape <$> d .: "body_html")+            <*> (fromMaybe (Listing Nothing Nothing []) <$> d .:? "replies")+  parseJSON _ = mempty++instance Thing Message where+  fullName m = fullName $ messageID m++instance ToQuery Message where+  toQuery k v = [(k, fullName v)]++isPrivateMessage :: Message -> Bool+isPrivateMessage m =+  case messageID m of+    PrivateMessage _ -> True+    _ -> False++isCommentReply :: Message -> Bool+isCommentReply m =+  case messageID m of+    CommentMessage _ -> True+    _ -> False++data MessageID = MessageID Text+  deriving (Show, Read, Eq)++instance FromJSON MessageID where+  parseJSON (String s) =+    MessageID <$> stripPrefix messagePrefix s+  parseJSON _ = mempty++instance Thing MessageID where+  fullName (MessageID m) = mconcat [messagePrefix, "_", m]++instance ToQuery MessageID where+  toQuery k m = toQuery k (fullName m)++messagePrefix :: Text+messagePrefix = "t4"++data MessageKind = CommentMessage CommentID+                 | PrivateMessage MessageID+  deriving (Show, Read, Eq)++instance FromJSON MessageKind where+  parseJSON s =+    (CommentMessage <$> parseJSON s) <|>+    (PrivateMessage <$> parseJSON s)++instance Thing MessageKind where+  fullName (CommentMessage c) = fullName c+  fullName (PrivateMessage p) = fullName p++instance ToQuery MessageKind where+  toQuery k (CommentMessage c) = toQuery k c+  toQuery k (PrivateMessage p) = toQuery k p
+ src/Reddit/Types/Moderation.hs view
@@ -0,0 +1,45 @@+module Reddit.Types.Moderation where++import Reddit.Parser+import Reddit.Types.User+import Reddit.Types.Thing++import Control.Applicative+import Data.Aeson+import Data.Time.Clock+import Data.Time.Clock.POSIX+import Data.Monoid+import Data.Text (Text)+import Network.API.Builder.Query+import Prelude++newtype BanID = BanID Text+  deriving (Show, Read, Eq, Ord)++instance FromJSON BanID where+  parseJSON (String s) =+    BanID <$> stripPrefix banPrefix s+  parseJSON _ = mempty++instance ToQuery BanID where+  toQuery k v = [(k, fullName v)]++instance Thing BanID where+  fullName (BanID b) = mconcat [banPrefix, "_", b]++data Ban = Ban { username :: Username+               , userID :: UserID+               , note :: Text+               , since :: UTCTime }+  deriving (Show, Read, Eq)++instance FromJSON Ban where+  parseJSON (Object o) =+    Ban <$> o .: "name"+        <*> o .: "id"+        <*> o .: "note"+        <*> (posixSecondsToUTCTime . fromInteger <$> o .: "date")+  parseJSON _ = mempty++banPrefix :: Text+banPrefix = "rb"
+ src/Reddit/Types/Options.hs view
@@ -0,0 +1,22 @@+module Reddit.Types.Options where++import Data.Default++data PaginationOption a = Before a+                        | After a+  deriving (Show, Read, Eq)++data Options a = Options { pagination :: Maybe (PaginationOption a)+                         , limit :: Maybe Int }+  deriving (Show, Read, Eq)++before :: Options a -> Maybe a+before (Options (Just (Before a)) _) = Just a+before _ = Nothing++after :: Options a -> Maybe a+after (Options (Just (After a)) _) = Just a+after _ = Nothing++instance Default (Options a) where+  def = Options Nothing Nothing
+ src/Reddit/Types/Post.hs view
@@ -0,0 +1,95 @@+module Reddit.Types.Post where++import Reddit.Parser+import Reddit.Types.Listing+import Reddit.Types.Reddit+import Reddit.Types.Subreddit+import Reddit.Types.Thing+import Reddit.Types.User+import Reddit.Utilities++import Control.Applicative+import Data.Aeson+import Data.Time.Clock+import Data.Time.Clock.POSIX+import Data.Monoid+import Data.Text (Text)+import Network.API.Builder.Query+import Prelude++newtype PostID = PostID Text+  deriving (Show, Read, Eq, Ord)++instance FromJSON PostID where+  parseJSON (String s) =+    PostID <$> stripPrefix postPrefix s+  parseJSON _ = mempty++instance FromJSON (POSTWrapped PostID) where+  parseJSON (Object o) =+    POSTWrapped <$> ((o .: "json") >>= (.: "data") >>= (.: "id"))+  parseJSON _ = mempty++data Post = Post { postID :: PostID+                 , title :: Text+                 , permalink :: Text+                 , author :: Username+                 , score :: Integer+                 , created :: UTCTime+                 , content :: PostContent+                 , liked :: Maybe Bool+                 , flairText :: Maybe Text+                 , flairClass :: Maybe Text+                 , domain :: Text+                 , gilded :: Integer+                 , nsfw :: Bool+                 , subreddit :: SubredditName+                 , subredditID :: SubredditID }+  deriving (Show, Read, Eq)++instance FromJSON Post where+  parseJSON (Object o) = do+    o `ensureKind` postPrefix+    d <- o .: "data"+    Post <$> d .: "id"+         <*> d .: "title"+         <*> d .: "permalink"+         <*> d .: "author"+         <*> d .: "score"+         <*> (posixSecondsToUTCTime . fromInteger <$> d .: "created_utc")+         <*> (buildContent <$> d .: "is_self" <*> d .:? "selftext" <*> d .:? "selftext_html" <*> d .: "url")+         <*> d .:? "likes"+         <*> d .:? "link_flair_text"+         <*> d .:? "link_flair_css_class"+         <*> d .: "domain"+         <*> d .: "gilded"+         <*> d .: "over_18"+         <*> d .: "subreddit"+         <*> d .: "subreddit_id"+  parseJSON _ = mempty++data PostContent = SelfPost Text Text+                 | Link Text+                 | TitleOnly+  deriving (Show, Read, Eq)++buildContent :: Bool -> Maybe Text -> Maybe Text -> Maybe Text -> PostContent+buildContent False _ _ (Just url) = Link url+buildContent True (Just s) (Just sHTML) _ = SelfPost (unescape s) sHTML+buildContent True (Just "") Nothing _ = TitleOnly+buildContent _ _ _ _ = undefined++instance Thing Post where+  fullName p = mconcat [postPrefix , "_", pID]+    where (PostID pID) = postID p++instance Thing PostID where+  fullName (PostID pID) = mconcat [postPrefix , "_", pID]++instance ToQuery PostID where+  toQuery k v = [(k, fullName v)]++type PostListing = Listing PostID Post++postPrefix :: Text+postPrefix = "t3"
+ src/Reddit/Types/Reddit.hs view
@@ -0,0 +1,133 @@+module Reddit.Types.Reddit+  ( Reddit+  , RedditT(..)+  , nest+  , failWith+  , Modhash(..)+  , LoginDetails(..)+  , POSTWrapped(..)+  , ShouldRateLimit+  , RateLimits(RateLimits, should, info)+  , RateLimitInfo(..)+  , headersToRateLimitInfo+  , builder+  , mainBaseURL+  , loginBaseURL+  , addHeader+  , addAPIType ) where++import Reddit.Types.Error++import Control.Applicative+import Control.Concurrent.STM.TVar+import Control.Monad.IO.Class+import Control.Monad.Trans.Class+import Control.Monad.Trans.Except+import Control.Monad.Trans.Reader (ask)+import Control.Monad.Trans.State (get, put)+import Data.Aeson+import Data.Monoid+import Data.Text (Text)+import Data.Time.Clock+import Network.API.Builder+import Network.HTTP.Conduit hiding (path)+import Network.HTTP.Types+import Prelude+import Text.Read (readMaybe)+import qualified Data.ByteString.Char8 as BS+import qualified Data.Text as Text++type Reddit a = RedditT IO a++newtype RedditT m a = RedditT { unRedditT :: APIT (TVar RateLimits) RedditError m a }++instance Functor m => Functor (RedditT m) where+  fmap f (RedditT a) = RedditT (fmap f a)++instance (Functor m, Monad m) => Applicative (RedditT m) where+  pure a = RedditT (pure a)+  (RedditT f) <*> (RedditT a) = RedditT (f <*> a)++instance Monad m => Monad (RedditT m) where+  return a = RedditT (return a)+  (RedditT a) >>= f = RedditT (a >>= unRedditT . f)+  fail = failWith . APIError . FailError . Text.pack++instance MonadIO m => MonadIO (RedditT m) where+  liftIO a = RedditT (liftIO a)++instance MonadTrans RedditT where+  lift = RedditT . lift . lift . lift . lift++nest :: MonadIO m => RedditT m a -> RedditT m (Either (APIError RedditError) a)+nest (RedditT a) = do+  b <- RedditT $ liftBuilder get+  rl <- RedditT $ liftState get+  m <- RedditT $ liftManager ask+  (res, b', rl') <- lift $ runAPI b m rl a+  RedditT $ do+    liftBuilder $ put b'+    liftState $ put rl'+  return res++failWith :: Monad m => APIError RedditError -> RedditT m a+failWith = RedditT . throwE++newtype Modhash = Modhash Text+  deriving (Show, Read, Eq)++instance FromJSON Modhash where+  parseJSON (Object o) =+    Modhash <$> ((o .: "json") >>= (.: "data") >>= (.: "modhash"))+  parseJSON _ = mempty++data LoginDetails = LoginDetails Modhash CookieJar+  deriving (Show, Eq)++newtype POSTWrapped a = POSTWrapped a+  deriving (Show, Read, Eq)++instance Functor POSTWrapped where+  fmap f (POSTWrapped a) = POSTWrapped (f a)++data RateLimits =+  RateLimits { should :: ShouldRateLimit+             , info :: Maybe RateLimitInfo }+  deriving (Show, Read, Eq)++type ShouldRateLimit = Bool++data RateLimitInfo = RateLimitInfo { used :: Integer+                                   , remaining :: Integer+                                   , resetTime :: UTCTime }+  deriving (Show, Read, Eq)++headersToRateLimitInfo :: ResponseHeaders -> UTCTime -> Maybe RateLimitInfo+headersToRateLimitInfo hs now =+  RateLimitInfo <$> rlUsed <*> rlRemaining <*> rlResetTime'+  where (rlUsed, rlRemaining, rlResetTime) =+          trimap extract ("x-ratelimit-used", "x-ratelimit-remaining", "x-ratelimit-reset")+        rlResetTime' = fmap (\s -> addUTCTime (fromIntegral s) now) rlResetTime+        extract s = lookup s hs >>= readMaybe . BS.unpack+        trimap f (a, b, c) = (f a, f b, f c)++builder :: Builder+builder = Builder "Reddit"+                  mainBaseURL+                  addAPIType+                  (addHeader Nothing)++addHeader :: Maybe BS.ByteString -> Request -> Request+addHeader Nothing req = req { requestHeaders =+  ("User-Agent", "reddit-haskell 0.1.0.0 / intolerable") : requestHeaders req }+addHeader (Just hdr) req = req { requestHeaders =+  ("User-Agent", hdr) : requestHeaders req }++addAPIType :: Route -> Route+addAPIType (Route fs ps m) = Route fs ("api_type" =. ("json" :: Text) : ps) m++mainBaseURL :: Text+mainBaseURL = "https://api.reddit.com"++loginBaseURL :: Text+loginBaseURL = "https://ssl.reddit.com"
+ src/Reddit/Types/SearchOptions.hs view
@@ -0,0 +1,19 @@+module Reddit.Types.SearchOptions+  ( Order(..) ) where++import Network.API.Builder.Query++data Order = Relevance+           | New+           | Hot+           | Top+           | MostComments+  deriving (Show, Read, Eq)++instance ToQuery Order where+  toQuery k t = return $ (,) k $ case t of+    Relevance -> "relevance"+    New -> "new"+    Hot -> "hot"+    Top -> "top"+    MostComments -> "comments"
+ src/Reddit/Types/Subreddit.hs view
@@ -0,0 +1,67 @@+module Reddit.Types.Subreddit where++import Reddit.Parser+import Reddit.Types.Thing++import Control.Applicative+import Data.Aeson+import Data.Monoid+import Data.Text (Text)+import Network.API.Builder.Query+import Prelude+import qualified Data.Text as Text++newtype SubredditName = R Text+  deriving (Show, Read)++instance Eq SubredditName where+  R x == R y = Text.toCaseFold x == Text.toCaseFold y++instance Ord SubredditName where+  R x `compare` R y = Text.toCaseFold x `compare` Text.toCaseFold y++instance ToQuery SubredditName where+  toQuery k (R sub) = [(k, sub)]++instance FromJSON SubredditName where+  parseJSON j = R <$> parseJSON j++newtype SubredditID = SubredditID Text+  deriving (Show, Read, Eq, Ord)++instance FromJSON SubredditID where+  parseJSON (String s) =+    SubredditID <$> stripPrefix subredditPrefix s+  parseJSON _ = mempty++instance Thing SubredditID where+  fullName (SubredditID i) = mconcat [subredditPrefix, "_", i]++instance ToQuery SubredditID where+  toQuery k (SubredditID v) = [(k, v)]++data Subreddit =+  Subreddit { subredditID :: SubredditID+            , name :: SubredditName+            , title :: Text+            , subscribers :: Integer+            , userIsBanned :: Maybe Bool }+  deriving (Show, Eq)++instance FromJSON Subreddit where+  parseJSON (Object o) = do+    o `ensureKind` subredditPrefix+    d <- o .: "data"+    Subreddit <$> d .: "id"+              <*> (R <$> d .: "display_name")+              <*> d .: "title"+              <*> d .: "subscribers"+              <*> d .: "user_is_banned"+  parseJSON _ = mempty++instance Thing Subreddit where+  fullName sub = mconcat [subredditPrefix, "_", s]+    where SubredditID s = subredditID sub++subredditPrefix :: Text+subredditPrefix = "t5"
+ src/Reddit/Types/SubredditSettings.hs view
@@ -0,0 +1,206 @@+module Reddit.Types.SubredditSettings+  ( SubredditSettings(..)+  , ContentOptions(..)+  , SpamFilterStrength(..)+  , SubredditType(..)+  , WikiEditMode(..) ) where++import Reddit.Parser+import Reddit.Utilities++import Control.Applicative+import Data.Aeson+import Data.Default+import Data.Monoid hiding (Any(..))+import Data.Text (Text)+import Network.API.Builder.Query+import Prelude++data SubredditSettings = SubredditSettings { sidebarText :: Text+                                           , descriptionText :: Text+                                           , title :: Text+                                           , linkType :: ContentOptions+                                           , hideScoreMins :: Integer+                                           , submitLinkLabel :: Maybe Text+                                           , submitTextLabel :: Maybe Text+                                           , domainCSS :: Bool+                                           , domainSidebar :: Bool+                                           , showMedia :: Bool+                                           , over18 :: Bool+                                           , language :: Text+                                           , wikiEditKarma :: Integer+                                           , wikiEditAge :: Integer+                                           , wikiEditMode :: WikiEditMode+                                           , spamComments :: SpamFilterStrength+                                           , spamSelfposts :: SpamFilterStrength+                                           , spamLinks :: SpamFilterStrength+                                           , publicTrafficStats :: Bool+                                           , subredditType :: SubredditType }+  deriving (Show, Read, Eq)++instance FromJSON SubredditSettings where+  parseJSON (Object o) = do+    o `ensureKind` subredditSettingsPrefix+    d <- o .: "data"+    SubredditSettings <$> (unescape <$> d .: "description")+                      <*> d .: "public_description"+                      <*> d .: "title"+                      <*> d .: "content_options"+                      <*> d .: "comment_score_hide_mins"+                      <*> d .: "submit_link_label"+                      <*> d .: "submit_text_label"+                      <*> d .: "domain_css"+                      <*> d .: "domain_sidebar"+                      <*> d .: "show_media"+                      <*> d .: "over_18"+                      <*> d .: "language"+                      <*> d .: "wiki_edit_karma"+                      <*> d .: "wiki_edit_age"+                      <*> d .: "wikimode"+                      <*> d .: "spam_comments"+                      <*> d .: "spam_selfposts"+                      <*> d .: "spam_links"+                      <*> d .: "public_traffic"+                      <*> d .: "subreddit_type"+  parseJSON _ = mempty++instance ToJSON SubredditSettings where+  toJSON settings = object+    [ "description" .= sidebarText settings+    , "public_description" .= descriptionText settings+    , "title" .= title settings+    , "content_options" .= linkType settings+    , "comment_score_hide_mins" .= hideScoreMins settings+    , "submit_link_label" .= submitLinkLabel settings+    , "submit_text_label" .= submitTextLabel settings+    , "domain_css" .= domainCSS settings+    , "domain_sidebar" .= domainSidebar settings+    , "show_media" .= showMedia settings+    , "over_18" .= over18 settings+    , "language" .= language settings+    , "wiki_edit_karma" .= wikiEditKarma settings+    , "wiki_edit_age" .= wikiEditAge settings+    , "wikimode" .= wikiEditMode settings+    , "spam_comments" .= spamComments settings+    , "spam_selfposts" .= spamSelfposts settings+    , "spam_links" .= spamLinks settings+    , "public_traffic" .= publicTrafficStats settings+    , "subreddit_type" .= subredditType settings ]++data SubredditType = Public+                   | Private+                   | Restricted+                   | GoldRestricted+                   | Archived+  deriving (Show, Read, Eq)++subredditTypeText :: SubredditType -> Text+subredditTypeText Public = "public"+subredditTypeText Private = "private"+subredditTypeText Restricted = "restricted"+subredditTypeText GoldRestricted = "gold_restricted"+subredditTypeText Archived = "archived"++instance FromJSON SubredditType where+  parseJSON (String s) =+    case s of+      "public" -> return Public+      "private" -> return Private+      "restricted" -> return Restricted+      "gold_restricted" -> return GoldRestricted+      "archived" -> return Archived+      _ -> mempty+  parseJSON _ = mempty++instance ToJSON SubredditType where+  toJSON = String . subredditTypeText++instance Default SubredditType where+  def = Public++instance ToQuery SubredditType where+  toQuery k v = [(k, subredditTypeText v)]++data ContentOptions = Any+                    | Link+                    | Self+  deriving (Show, Read, Eq)++contentOptionsText :: ContentOptions -> Text+contentOptionsText Any = "any"+contentOptionsText Link = "link"+contentOptionsText Self = "self"++instance FromJSON ContentOptions where+  parseJSON (String s) =+    case s of+      "any" -> return Any+      "link" -> return Link+      "self" -> return Self+      _ -> mempty+  parseJSON _ = mempty++instance ToJSON ContentOptions where+  toJSON = String . contentOptionsText++instance ToQuery ContentOptions where+  toQuery k v = [(k, contentOptionsText v)]++instance Default ContentOptions where+  def = Any++data SpamFilterStrength = FilterLow+                        | FilterHigh+                        | FilterAll+  deriving (Show, Read, Eq)++instance FromJSON SpamFilterStrength where+  parseJSON (String s) =+    case s of+      "low" -> return FilterLow+      "high" -> return FilterHigh+      "all" -> return FilterAll+      _ -> mempty+  parseJSON _ = mempty++spamFilterStrengthText :: SpamFilterStrength -> Text+spamFilterStrengthText FilterLow = "low"+spamFilterStrengthText FilterHigh = "high"+spamFilterStrengthText FilterAll = "all"++instance ToJSON SpamFilterStrength where+  toJSON = String . spamFilterStrengthText++instance ToQuery SpamFilterStrength where+  toQuery k v = [(k, spamFilterStrengthText v)]++data WikiEditMode = Anyone+                  | ApprovedOnly+                  | ModOnly+  deriving (Show, Read, Eq)++instance FromJSON WikiEditMode where+  parseJSON (String s) =+    case s of+      "disabled" -> return ModOnly+      "modonly" -> return ApprovedOnly+      "anyone" -> return Anyone+      _ -> mempty+  parseJSON _ = mempty++wikiEditModeText :: WikiEditMode -> Text+wikiEditModeText ModOnly = "disabled"+wikiEditModeText Anyone = "anyone"+wikiEditModeText ApprovedOnly = "modonly"++instance ToJSON WikiEditMode where+  toJSON = String . wikiEditModeText++instance ToQuery WikiEditMode where+  toQuery k v = [(k, wikiEditModeText v)]++instance Default WikiEditMode where+  def = Anyone++subredditSettingsPrefix :: Text+subredditSettingsPrefix = "subreddit_settings"
+ src/Reddit/Types/Thing.hs view
@@ -0,0 +1,6 @@+module Reddit.Types.Thing where++import Data.Text (Text)++class Thing a where+  fullName :: a -> Text
+ src/Reddit/Types/User.hs view
@@ -0,0 +1,109 @@+module Reddit.Types.User where++import Reddit.Parser+import Reddit.Types.Thing++import Control.Applicative+import Data.Aeson+import Data.Monoid+import Data.Text (Text)+import Data.Time.Clock+import Data.Time.Clock.POSIX+import Network.API.Builder.Query+import Prelude+import qualified Data.Text as Text+import qualified Data.Vector as Vector++newtype Username = Username Text+  deriving (Show, Read, Ord)++instance Eq Username where+  Username x == Username y = Text.toCaseFold x == Text.toCaseFold y++instance FromJSON Username where+  parseJSON (String s) = return $ Username s+  parseJSON _ = mempty++instance ToQuery Username where+  toQuery k (Username user) = [(k, user)]++newtype UserID = UserID Text+  deriving (Show, Read, Eq, Ord)++instance FromJSON UserID where+  parseJSON (String s) =+    UserID <$> stripPrefix userPrefix s+  parseJSON _ = mempty++instance Thing UserID where+  fullName (UserID u) = mconcat [userPrefix, "_", u]++instance ToQuery UserID where+  toQuery k v = [(k, fullName v)]++data User =+  User { userID :: Text+       , userName :: Username+       , userCreated :: UTCTime+       , linkKarma :: Integer+       , commentKarma :: Integer+       , hasMail :: Maybe Bool+       , hasModMail :: Maybe Bool+       , isFriend :: Bool+       , userIsOver18 :: Maybe Bool+       , isMod :: Bool+       , hasGold :: Bool+       , hasVerifiedEmail :: Maybe Bool }+  deriving (Show, Eq)++instance FromJSON User where+  parseJSON (Object o) = do+    o `ensureKind` userPrefix+    d <- o .: "data"+    User <$> d .: "id"+         <*> d .: "name"+         <*> (posixSecondsToUTCTime . fromInteger <$> d .: "created_utc")+         <*> d .: "link_karma"+         <*> d .: "comment_karma"+         <*> d .:? "has_mail"+         <*> d .:? "has_mod_mail"+         <*> d .: "is_friend"+         <*> d .:? "over_18"+         <*> d .: "is_mod"+         <*> d .: "is_gold"+         <*> d .:? "has_verified_email"+  parseJSON _ = mempty++newtype UserList = UserList [Relationship]+  deriving (Show, Read, Eq)++instance FromJSON UserList where+  parseJSON (Object o) = do+    o `ensureKind` "UserList"+    UserList <$> ((o .: "data") >>= (.: "children"))+  parseJSON (Array a) =+    case Vector.toList a of+      [o] -> parseJSON o+      [o, _] -> parseJSON o+      _ -> mempty+  parseJSON _ = fail "wat"++data Relationship =+  Relationship { relationUsername :: Username+               , relationUserID :: UserID+               , relationSince :: UTCTime+               , relationNote :: Maybe Text }+  deriving (Show, Read, Eq)++instance FromJSON Relationship where+  parseJSON (Object o) =+    Relationship <$> o .: "name"+                 <*> o .: "id"+                 <*> (posixSecondsToUTCTime . fromInteger <$> o .: "date")+                 <*> (f <$> o .:? "note")+    where f (Just "") = Nothing+          f x = x+  parseJSON _ = fail "Relationship should be an object"++userPrefix :: Text+userPrefix = "t2"
+ src/Reddit/Types/Wiki.hs view
@@ -0,0 +1,34 @@+module Reddit.Types.Wiki where++import Reddit.Parser+import Reddit.Types.User+import Reddit.Utilities++import Control.Applicative+import Data.Aeson+import Data.Monoid+import Data.Text (Text)+import Data.Time.Clock+import Data.Time.Clock.POSIX+import Prelude++newtype RevisionID = RevisionID Text+  deriving (Show, Read, Eq)++data WikiPage = WikiPage { contentHTML :: Maybe Text+                         , contentMarkdown :: Text+                         , revisionDate :: UTCTime+                         , revisedBy :: Username+                         , canRevise :: Bool }+  deriving (Show, Read, Eq)++instance FromJSON WikiPage where+  parseJSON (Object o) = do+    o `ensureKind` "wikipage"+    d <- o .: "data"+    WikiPage <$> (fmap unescape <$> d .:? "content_html")+             <*> (unescape <$> d .: "content_md")+             <*> (posixSecondsToUTCTime . fromInteger <$> d .: "revision_date")+             <*> ((d .: "revision_by") >>= (.: "data") >>= (.: "name"))+             <*> d .: "may_revise"+  parseJSON _ = mempty
+ src/Reddit/Utilities.hs view
@@ -0,0 +1,17 @@+-- | Miscellaneous utilities for various parts of the library+module Reddit.Utilities+  ( unescape ) where++import Data.Text (Text)+import qualified Data.Text as Text++-- | Quick-'n'-dirty unescaping function for posts / wiki pages etc..+unescape :: Text -> Text+unescape = replace "&gt;" ">" . replace "&lt;" "<" . replace "&amp;" "&"++-- | Swap all instances of a certain string in another string+replace :: Text -- ^ String to replace+        -> Text -- ^ String to replace with+        -> Text -- ^ String to search+        -> Text+replace s r = Text.intercalate r . Text.splitOn s
+ test-anon/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ test-io/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ test/data/aboutMe_example.json view
@@ -0,0 +1,1 @@+{"kind": "t2", "data": {"has_mail": false, "name": "Intolerable", "is_friend": false, "created": 1287869810.0, "gold_creddits": 0, "modhash": "example modhash", "created_utc": 1287866210.0, "link_karma": 2399, "comment_karma": 44631, "over_18": true, "is_gold": false, "is_mod": true, "gold_expiration": null, "has_verified_email": true, "id": "4gf25", "has_mod_mail": false}}
+ test/data/getUserComments_example.json view
@@ -0,0 +1,1 @@+{"kind": "Listing", "data": {"modhash": "2ruxn0553100b3e83db4cbc2595c24d90a5845706f96b621fd", "children": [{"kind": "t1", "data": {"subreddit_id": "t5_2s580", "link_title": "The 141st Weekly Stupid Questions Thread", "banned_by": null, "link_id": "t3_2i6z0b", "link_author": "Intolerable", "likes": null, "replies": null, "user_reports": [], "saved": false, "id": "cl23alz", "gilded": 0, "report_reasons": null, "author": "Intolerable", "parent_id": "t1_cl22yu6", "score": 1, "approved_by": null, "controversiality": 0, "body": "Yes, no.", "edited": false, "author_flair_css_class": "rapier", "downs": 0, "body_html": "&lt;div class=\"md\"&gt;&lt;p&gt;Yes, no.&lt;/p&gt;\n&lt;/div&gt;", "subreddit": "DotA2", "score_hidden": false, "name": "t1_cl23alz", "created": 1412650062.0, "author_flair_text": "sneep sneep", "link_url": "http://www.reddit.com/r/DotA2/comments/2i6z0b/the_141st_weekly_stupid_questions_thread/", "created_utc": 1412621262.0, "ups": 1, "mod_reports": [], "num_reports": null, "distinguished": null}}, {"kind": "t1", "data": {"subreddit_id": "t5_2s580", "link_title": "How viable is AM blink dagger?", "banned_by": null, "link_id": "t3_2igcyx", "link_author": "vitormaceduh", "likes": null, "replies": null, "user_reports": [], "saved": false, "id": "cl1ycp0", "gilded": 0, "report_reasons": null, "author": "Intolerable", "parent_id": "t1_cl1y3na", "score": 5, "approved_by": null, "controversiality": 0, "body": "personally i go offlane and if i dont have bfury treads manta vit booster by 7 minutes i leave the game", "edited": false, "author_flair_css_class": "rapier", "downs": 0, "body_html": "&lt;div class=\"md\"&gt;&lt;p&gt;personally i go offlane and if i dont have bfury treads manta vit booster by 7 minutes i leave the game&lt;/p&gt;\n&lt;/div&gt;", "subreddit": "DotA2", "score_hidden": false, "name": "t1_cl1ycp0", "created": 1412640460.0, "author_flair_text": "sneep sneep", "link_url": "http://www.reddit.com/r/DotA2/comments/2igcyx/how_viable_is_am_blink_dagger/", "created_utc": 1412611660.0, "ups": 5, "mod_reports": [], "num_reports": null, "distinguished": null}}, {"kind": "t1", "data": {"subreddit_id": "t5_2s580", "link_title": "Are there support heroes like Omniknight?", "banned_by": null, "link_id": "t3_2ig5td", "link_author": "atat2", "likes": null, "replies": null, "user_reports": [], "saved": false, "id": "cl1x1a8", "gilded": 0, "report_reasons": null, "author": "Intolerable", "parent_id": "t1_cl1vdnm", "score": 7, "approved_by": null, "controversiality": 0, "body": "seer scales far too hard to be relegated to a support position", "edited": false, "author_flair_css_class": "rapier", "downs": 0, "body_html": "&lt;div class=\"md\"&gt;&lt;p&gt;seer scales far too hard to be relegated to a support position&lt;/p&gt;\n&lt;/div&gt;", "subreddit": "DotA2", "score_hidden": false, "name": "t1_cl1x1a8", "created": 1412637719.0, "author_flair_text": "sneep sneep", "link_url": "http://www.reddit.com/r/DotA2/comments/2ig5td/are_there_support_heroes_like_omniknight/", "created_utc": 1412608919.0, "ups": 7, "mod_reports": [], "num_reports": null, "distinguished": null}}, {"kind": "t1", "data": {"subreddit_id": "t5_2s580", "link_title": "Buff to QB and Basher on ranged?", "banned_by": null, "link_id": "t3_2ifqij", "link_author": "Zaoppy", "likes": null, "replies": null, "user_reports": [], "saved": false, "id": "cl1sahx", "gilded": 0, "report_reasons": null, "author": "Intolerable", "parent_id": "t3_2ifqij", "score": 3, "approved_by": null, "controversiality": 0, "body": "dont know how i would manage w/o qblade dusa", "edited": false, "author_flair_css_class": "rapier", "downs": 0, "body_html": "&lt;div class=\"md\"&gt;&lt;p&gt;dont know how i would manage w/o qblade dusa&lt;/p&gt;\n&lt;/div&gt;", "subreddit": "DotA2", "score_hidden": false, "name": "t1_cl1sahx", "created": 1412623323.0, "author_flair_text": "sneep sneep", "link_url": "http://www.reddit.com/r/DotA2/comments/2ifqij/buff_to_qb_and_basher_on_ranged/", "created_utc": 1412594523.0, "ups": 3, "mod_reports": [], "num_reports": null, "distinguished": null}}, {"kind": "t1", "data": {"subreddit_id": "t5_2s580", "link_title": "Item Discussion of the Day: Eye of Skadi (October 5th, 2014)", "banned_by": null, "link_id": "t3_2idjl7", "link_author": "VRCkid", "likes": null, "replies": null, "user_reports": [], "saved": false, "id": "cl1royq", "gilded": 0, "report_reasons": null, "author": "Intolerable", "parent_id": "t1_cl1rnjh", "score": 2, "approved_by": null, "controversiality": 0, "body": "sure, but so is leaving the game and uninstalling dota", "edited": false, "author_flair_css_class": "rapier", "downs": 0, "body_html": "&lt;div class=\"md\"&gt;&lt;p&gt;sure, but so is leaving the game and uninstalling dota&lt;/p&gt;\n&lt;/div&gt;", "subreddit": "DotA2", "score_hidden": false, "name": "t1_cl1royq", "created": 1412620001.0, "author_flair_text": "sneep sneep", "link_url": "http://www.reddit.com/r/DotA2/comments/2idjl7/item_discussion_of_the_day_eye_of_skadi_october/", "created_utc": 1412591201.0, "ups": 2, "mod_reports": [], "num_reports": null, "distinguished": null}}], "after": "t1_cl1royq", "before": null}}
+ test/data/getUserInfo_example.json view
@@ -0,0 +1,1 @@+{"kind": "t2", "data": {"name": "intolerable-bot", "is_friend": false, "created": 1398896967.0, "created_utc": 1398893367.0, "link_karma": 1, "comment_karma": 2668, "is_gold": false, "is_mod": false, "has_verified_email": true, "id": "gdifp"}}