packages feed

hsreadability (empty) → 1.0.0.0

raw patch · 10 files changed

+963/−0 lines, 10 filesdep +HUnitdep +aesondep +authenticate-oauthsetup-changed

Dependencies added: HUnit, aeson, authenticate-oauth, base, bytestring, data-default, file-embed, hsreadability, http-conduit, http-types, test-framework, test-framework-hunit, text, xsd

Files

+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2015 Alexey Shmalko++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ hsreadability.cabal view
@@ -0,0 +1,56 @@+name:                hsreadability+version:             1.0.0.0+synopsis:            Access to the Readability API.++description:         This package provides Haskell bindings to the+                     <http://www.readability.com/> API.++license:             MIT+license-file:        LICENSE+author:              Alexey Shmalko <rasen.dubi@gmail.com>+maintainer:          Alexey Shmalko <rasen.dubi@gmail.com>+homepage:            http://github.com/rasendubi/hsreadability+bug-reports:         http://github.com/rasendubi/hsreadability/issues+category:            Network APIs, Web+build-type:          Simple+extra-source-files:  tests/files/parser_article.json+                   , tests/files/confidence_response.json+cabal-version:       >=1.10++tested-with:         GHC == 7.6, GHC == 7.8++source-repository head+  type:     git+  location: git://github.com/rasendubi/hsreadability.git++library+  exposed-modules:     Network.Readability+                     , Network.Readability.Parser+                     , Network.Readability.Reader+                     , Network.Readability.Shortener+  build-depends:       base >=4.6 && <4.8+                     , aeson >=0.6.2 && <0.9+                     , text+                     , data-default+                     , http-conduit >=2.0 && <2.2+                     , bytestring >=0.9 && <0.11+                     , authenticate-oauth >=1.5 && <1.6+                     , http-types >=0.8 && <0.9+                     , xsd >= 0.1 && <0.6+  hs-source-dirs:      src+  default-language:    Haskell2010+  ghc-options:         -Wall++test-suite test-hsreadability+  type:                exitcode-stdio-1.0+  main-is:             Main.hs+  build-depends:       base >=4.6 && <4.8+                     , hsreadability+                     , aeson >=0.6.2 && <0.9+                     , text+                     , HUnit >=1.2 && <1.3+                     , file-embed >=0.0 && <0.1+                     , test-framework >=0.8 && <0.9+                     , test-framework-hunit >=0.3 && < 0.4+  hs-source-dirs:      tests+  default-language:    Haskell2010
+ src/Network/Readability.hs view
@@ -0,0 +1,10 @@+-- | This module merely reexports other modules for ease of use.+module Network.Readability+    ( module Network.Readability.Parser+    , module Network.Readability.Reader+    , module Network.Readability.Shortener+    ) where++import Network.Readability.Parser+import Network.Readability.Reader+import Network.Readability.Shortener
+ src/Network/Readability/Parser.hs view
@@ -0,0 +1,179 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}+-- | This module is an interface to the Readability's Parser API.+--+-- To get more info, visit <https://www.readability.com/developers/api/parser>.+module Network.Readability.Parser+    ( ParserToken(..)++    -- * Parse article+    , Article(..)+    , parse+    , parseByUrl+    , parseById++    -- * Article status+    , ArticleStatus(..)+    , Status(..)+    , getContentStatus+    , getContentStatusByUrl+    , getContentStatusById++    -- * Confidence+    , Confidence(..)+    , getConfidence+    ) where++import Control.Applicative ((<$>))++import qualified Data.ByteString.Char8 as BS++import Data.Text (Text)+import Data.Aeson (FromJSON, eitherDecode)+import Data.Aeson.TH (deriveFromJSON, defaultOptions, fieldLabelModifier)++import Network.HTTP.Conduit (method, parseUrl, responseBody, responseHeaders, setQueryString, withManager, httpLbs)++-- | This is a Readability Parser API key.+--+-- You can get one at <https://www.readability.com/settings/account>.+newtype ParserToken = ParserToken BS.ByteString deriving (Eq, Show)++data Article = Article+    { content :: Maybe Text           -- ^ The main content of the article (in HTML)+    , domain :: Maybe Text            -- ^ Domain name of article host+    , author :: Maybe Text+    , url :: Text                     -- ^ URL of the article+    , short_url :: Maybe Text         -- ^ Shortened URL provided by Readability Shortener+    , title :: Maybe Text+    , excerpt :: Maybe Text+    , direction :: Maybe Text         -- ^ Text direction of article+    , word_count :: Integer+    , total_pages :: Maybe Integer    -- ^ Total number of pages in article+    , date_published :: Maybe Text+    , dek :: Maybe Text+    , lead_image_url :: Maybe Text+    , next_page_id :: Maybe Text+    , rendered_pages :: Maybe Int+    } deriving (Show, Eq)++$(deriveFromJSON defaultOptions ''Article)++-- | This type represent confidence with which Readability Parser recognizes content of article.+data Confidence = Confidence+    { conf_url :: Text           -- ^ Article URL+    , conf_confidence :: Double  -- ^ Parser's confidence+    } deriving (Show, Eq)++$(deriveFromJSON defaultOptions{ fieldLabelModifier = drop (length ("conf_" :: String)) } ''Confidence)++-- | Represents article status+data ArticleStatus = ArticleStatus+    { as_article_id :: BS.ByteString  -- ^ Article id+    , as_article_status :: Status     -- ^ Article status+    } deriving (Show, Eq)++data Status+    = Invalid           -- ^ Unable to parse this URL for some reason+    | Unretrieved       -- ^ Readability knows of this article but hasn't yet retrieved its content,+                        --   or the cache expired+    | ProvidedByUser    -- ^ The content of this URL has been retrieved from at least one user+    | ValidatedByUsers  -- ^ The content was retrieved from multiple users and is validated+    | Fetched           -- ^ The content of this URL was fetched manually, and it has been cached+    deriving (Show, Eq)++apiPrefix :: String+apiPrefix = "https://readability.com/api/content/v1"++-- | Parses content of the article by URL.+--+-- This is a shortcut for 'parse'.+parseByUrl :: ParserToken -> BS.ByteString -> Maybe Int -> IO (Either String Article)+parseByUrl token articleUrl maximumPages = parse token (Just articleUrl) Nothing maximumPages++-- | Parses content of the article by article id.+--+-- This is a shortcut for 'parse'.+parseById :: ParserToken -> BS.ByteString -> Maybe Int -> IO (Either String Article)+parseById token articleId maximumPages = parse token Nothing (Just articleId) maximumPages++-- | Parses content of the given article and returns its description.+--+-- This is a @GET@ request to @/parser@ endpoint.+parse :: ParserToken         -- ^ Your Parser API token+      -> Maybe BS.ByteString -- ^ The article URL+      -> Maybe BS.ByteString -- ^ The article id+      -> Maybe Int           -- ^ The maximum number of pages to parse+      -> IO (Either String Article)+parse (ParserToken token) articleUrl articleId maximumPages = readabilityRequest "/parser" params+    where+        params =+            [ ("token", Just token)+            ]+            ++ maybeParam "url" articleUrl+            ++ maybeParam "id" articleId+            ++ maybeShowParam "max_pages" maximumPages++-- | Gets article's status by URL.+--+-- This functions is a shortcut for 'getContentStatus'.+getContentStatusByUrl :: ParserToken -> BS.ByteString -> IO (Maybe ArticleStatus)+getContentStatusByUrl token articleUrl = getContentStatus token (Just articleUrl) Nothing++-- | Gets article's status by id.+--+-- This functions is a shortcut for 'getContentStatus'.+getContentStatusById :: ParserToken -> BS.ByteString -> IO (Maybe ArticleStatus)+getContentStatusById token articleId = getContentStatus token Nothing (Just articleId)++-- | Gets article's status.+--+-- This is a @HEAD@ request to @/parser@ endpoint.+getContentStatus :: ParserToken               -- ^ Your Parser API key+                 -> Maybe BS.ByteString       -- ^ Article URL+                 -> Maybe BS.ByteString       -- ^ Article id+                 -> IO (Maybe ArticleStatus)+getContentStatus (ParserToken token) articleUrl articleId = contentStatusRequest params+    where+        params =+            [ ("token", Just token)+            ]+            ++ maybeParam "url" articleUrl+            ++ maybeParam "id" articleId++contentStatusRequest :: [(BS.ByteString, Maybe BS.ByteString)] -> IO (Maybe ArticleStatus)+contentStatusRequest params = do+    query <- setQueryString params <$> parseUrl (apiPrefix ++ "/parser")+    response <- withManager $ httpLbs query{ method = "HEAD" }+    let headers = responseHeaders response+    return $ do+        article_id <- lookup "X-Article-Id" headers+        article_status <- parseStatus =<< lookup "X-Article-Status" headers+        return $ ArticleStatus article_id article_status++-- | Gets parser's confidence by URL.+--+-- This a @GET@ request to @/confidence@+getConfidence :: BS.ByteString          -- ^ Article URL+              -> IO (Either String Confidence)+getConfidence article_url = readabilityRequest "/confidence" [ ("url", Just article_url) ]++readabilityRequest :: FromJSON a => String -> [(BS.ByteString, Maybe BS.ByteString)] -> IO (Either String a)+readabilityRequest api params = do+    request <- setQueryString params <$> parseUrl (apiPrefix ++ api)+    response <- withManager $ httpLbs request+    return $ eitherDecode $ responseBody response++maybeShowParam :: (Show a) => BS.ByteString -> Maybe a -> [(BS.ByteString, Maybe BS.ByteString)]+maybeShowParam name = maybeParam name . Just . BS.pack . show++maybeParam :: BS.ByteString -> Maybe BS.ByteString -> [(BS.ByteString, Maybe BS.ByteString)]+maybeParam name = maybe [] $ \x -> [(name, Just x)]++parseStatus :: BS.ByteString -> Maybe Status+parseStatus "INVALID" = Just Invalid+parseStatus "UNRETRIEVED" = Just Unretrieved+parseStatus "PROVIDED_BY_USER" = Just ProvidedByUser+parseStatus "VALIDATED_BY_USERS" = Just ValidatedByUsers+parseStatus "FETCHED" = Just Fetched+parseStatus _ = Nothing
+ src/Network/Readability/Reader.hs view
@@ -0,0 +1,553 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TupleSections #-}+-- | This module is an interface to the Readability's Reader API.+--+-- To get more info, visit <https://www.readability.com/developers/api/reader>.+--+-- Before performing any request, you should receive OAuth credentials. To do that,+-- this module provides 'newOAuth' as well as 'xauth' for XAuth authorizations.+--+-- The full XAuth authorization process will be like:+--+-- @+-- let auth = newAuth+--         { oauthConsumerKey = "consumer key" -- usually, your username+--         , oauthConsumerSecret = "consumer token"+--         }+-- credential <- xauth auth "username" "password"+-- @+--+-- Then you should pass auth and credential to any function in this module.+--+-- It's preferable not doing authentication every single time. The best way is to+-- store received credential, so you can use it later.+--+-- If you don't have Reader Keys, visit <https://www.readability.com/settings/account>.+module Network.Readability.Reader+    (+    -- * Authentication+    -- ** OAuth+      OAuth+    , newOAuth+    , oauthConsumerKey+    , oauthConsumerSecret+    , xauth++    -- ** OAuth Endoints+    , oauthAuthorizeEndpoint+    , oauthRequestTokenEndpoint+    , oauthAccessTokenEndpoint++    -- * Article+    -- ** Types+    , Article(..)+    -- ** Requests+    , getArticle++    -- * Bookmarks+    -- ** Types+    , BookmarksFilters(..)+    , defaultBookmarksFilters+    , BookmarksResponse(..)+    , BookmarksConditions(..)+    , BookmarksMeta(..)+    , Bookmark(..)+    , BookmarkLocation(..)+    , Order(..)++    -- ** Requests+    , getBookmarks+    , addBookmark+    , getBookmark+    , updateBookmark+    , deleteBookmark+    , getBookmarkTags+    , addBookmarkTags+    , deleteBookmarkTag++    -- * Tags+    -- ** Types+    , TagsResponse(..)+    , Tag(..)+    -- ** Requests+    , getTags+    , getTag+    , deleteTag++    -- * User+    -- ** Types+    , User(..)+    -- ** Requests+    , getUser+    ) where++import Control.Applicative ((<$>), (<*>))++import Data.Aeson (FromJSON(..), Value(String), eitherDecode)+import Data.Aeson.TH (defaultOptions, deriveFromJSON, fieldLabelModifier)+import Data.Maybe (catMaybes)+import Data.Default (Default(def))++import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy.Char8 as BL++import Network.HTTP.Conduit (Response, httpLbs, parseUrl, responseBody, responseHeaders,+        setQueryString, urlEncodedBody, withManager, method)+import Network.HTTP.Types (parseQuery)++import Text.XML.XSD.DateTime (DateTime)++import qualified Web.Authenticate.OAuth as OAuth (newOAuth)+import Web.Authenticate.OAuth (OAuth, Credential, emptyCredential, newCredential,+        oauthServerName, oauthAuthorizeUri, oauthConsumerKey, oauthConsumerSecret,+        oauthRequestUri, oauthAccessTokenUri, signOAuth)++import Network.Readability.Parser (Article(..))++apiPrefix :: String+apiPrefix = "https://readability.com/api/rest/v1"++-- | OAuth endpoint+oauthAuthorizeEndpoint, oauthRequestTokenEndpoint, oauthAccessTokenEndpoint :: String+oauthAuthorizeEndpoint    = apiPrefix ++ "/oauth/authorize/"+oauthRequestTokenEndpoint = apiPrefix ++ "/oauth/request_token/"+oauthAccessTokenEndpoint  = apiPrefix ++ "/oauth/access_token/"++-- | Default value for OAuth datatype. You must specify at least consumer key and secret.+--+-- Example usage:+--+-- @+-- myAuth = newOAuth+--     { oauthConsumerKey = "consumer key"+--     , oauthConsumerSecret = "consumer secret"+--     }+-- @+newOAuth :: OAuth+newOAuth = OAuth.newOAuth+    { oauthServerName = "www.readability.com"+    , oauthAuthorizeUri = oauthAuthorizeEndpoint+    , oauthRequestUri = oauthRequestTokenEndpoint+    , oauthAccessTokenUri = oauthAccessTokenEndpoint+    }++-- | XAuth is used to receive OAuth token using owner's username and password directly.+--+-- In most cases, you should do your best to support OAuth proper.+xauth :: OAuth                 -- ^ OAuth client+      -> BS.ByteString         -- ^ Owner username+      -> BS.ByteString         -- ^ Owner password+      -> IO (Maybe Credential) -- ^ Token and secret+xauth oauth username password = do+    r <- parseUrl (oauthAccessTokenUri oauth)+    let bodyParams =+            [ ("x_auth_username", username)+            , ("x_auth_password", password)+            , ("x_auth_method", "client_auth")+            ]+    let request = urlEncodedBody bodyParams r+    signedRequest <- signOAuth oauth emptyCredential request+    response <- withManager $ httpLbs signedRequest+    let res = parseQuery . BL.toStrict . responseBody $ response+    return $ do+        token <- lookup "oauth_token" res+        secret <- lookup "oauth_token_secret" res+        newCredential <$> token <*> secret++getRequest :: (FromJSON a)+           => OAuth+           -> Credential+           -> String+           -> [(BS.ByteString, Maybe BS.ByteString)]+           -> IO (Either String a)+getRequest oauth cred path params = do+    req <- parseUrl $ apiPrefix ++ path+    signedRequest <- signOAuth oauth cred $ setQueryString params req+    response <- withManager $ httpLbs signedRequest+    return $ eitherDecode $ responseBody $ response++postRequest' :: OAuth+             -> Credential+             -> String+             -> [(BS.ByteString, BS.ByteString)]+             -> IO (Response BL.ByteString)+postRequest' oauth cred path params = do+    req <- parseUrl $ apiPrefix ++ path+    signedRequest <- signOAuth oauth cred $ urlEncodedBody params req+    withManager $ httpLbs signedRequest++postRequest :: (FromJSON a)+            => OAuth+            -> Credential+            -> String+            -> [(BS.ByteString, BS.ByteString)]+            -> IO (Either String a)+postRequest oauth cred path params = do+    response <- postRequest' oauth cred path params+    return $ eitherDecode $ responseBody response++deleteRequest :: OAuth+              -> Credential+              -> String+              -> IO (Response BL.ByteString)+deleteRequest oauth cred path = do+    req <- parseUrl $ apiPrefix ++ path+    signedRequest <- signOAuth oauth cred $ req{ method = "DELETE" }+    withManager $ httpLbs signedRequest++-- | Gets article by id.+--+-- This is a @GET@ request to @\/articles\/{articleId}@ endpoint.+getArticle :: OAuth         -- ^ Client OAuth+           -> Credential    -- ^ Access token and secret+           -> BS.ByteString -- ^ Article id+           -> IO (Either String Article)+getArticle oauth cred articleId =+    getRequest oauth cred ("/articles/" ++ BS.unpack articleId) []++-- This type represents various filters for performing 'getBookmarks' request.+--+-- Note: this type has 'Default' instance as well as 'defaultBookmarksFilters',+-- so that you don't have to type in every field. Use update record syntax like this:+--+-- @+-- myfilters = def { bfFavorite = Just True }+-- -- or+-- myfilters = defaultBookmarksFilters { bfFavorite = Just True }+-- @+data BookmarksFilters = BookmarksFilters+    { bfArchive :: Maybe Bool -- ^ Archieved status+    , bfFavorite :: Maybe Bool+    , bfDomain :: Maybe String+    , bfAddedSince :: Maybe DateTime+    , bfAddedUntil :: Maybe DateTime+    , bfOpenedSince :: Maybe DateTime+    , bfOpenedUntil :: Maybe DateTime+    , bfArchivedSince :: Maybe DateTime+    , bfArchivedUntil :: Maybe DateTime+    , bfFavoritedSince :: Maybe DateTime+    , bfFavoritedUntil :: Maybe DateTime+    , bfUpdatedSince :: Maybe DateTime+    , bfUpdatedUntil :: Maybe DateTime+    } deriving (Show, Eq)++instance Default BookmarksFilters where+    def = BookmarksFilters+        { bfArchive = def+        , bfFavorite = def+        , bfDomain = def+        , bfAddedSince = def+        , bfAddedUntil = def+        , bfOpenedSince = def+        , bfOpenedUntil = def+        , bfArchivedSince = def+        , bfArchivedUntil = def+        , bfFavoritedSince = def+        , bfFavoritedUntil = def+        , bfUpdatedSince = def+        , bfUpdatedUntil = def+        }++-- | This is a default value for 'BookmarksFilters'. All fields are set to 'Nothing'.+defaultBookmarksFilters :: BookmarksFilters+defaultBookmarksFilters = def++bookmarkFiltersToParams :: BookmarksFilters -> [(BS.ByteString, Maybe BS.ByteString)]+bookmarkFiltersToParams BookmarksFilters{..} = catMaybes+    [ boolParam   "archive"         bfArchive+    , boolParam   "favorite"        bfFavorite+    , stringParam "domain"          bfDomain+    , param       "added_since"     bfAddedSince+    , param       "added_until"     bfAddedUntil+    , param       "opened_since"    bfOpenedSince+    , param       "opened_until"    bfOpenedUntil+    , param       "archived_since"  bfArchivedSince+    , param       "archived_until"  bfArchivedUntil+    , param       "favorited_since" bfFavoritedSince+    , param       "favorited_until" bfFavoritedUntil+    , param       "updated_since"   bfUpdatedSince+    , param       "updated_until"   bfUpdatedUntil+    ]++boolParam :: BS.ByteString -> Maybe Bool -> Maybe (BS.ByteString, Maybe BS.ByteString)+boolParam name = fmap $ (name,) . Just . bshow . fromEnum++boolParam' :: BS.ByteString -> Maybe Bool -> Maybe (BS.ByteString, BS.ByteString)+boolParam' name = fmap $ (name,) . bshow . fromEnum++stringParam :: BS.ByteString -> Maybe String -> Maybe (BS.ByteString, Maybe BS.ByteString)+stringParam name = fmap $ (name,) . Just . BS.pack++param :: (Show a) => BS.ByteString -> Maybe a -> Maybe (BS.ByteString, Maybe BS.ByteString)+param name = fmap $ (name,) . Just . bshow++param' :: (Show a) => BS.ByteString -> Maybe a -> Maybe (BS.ByteString, BS.ByteString)+param' name = fmap $ (name,) . bshow++stringListParam :: BS.ByteString -> [String] -> Maybe (BS.ByteString, Maybe BS.ByteString)+stringListParam _ [] = Nothing+stringListParam name xs = Just . (name,) . Just . BS.intercalate "," $ fmap BS.pack xs++bshow :: Show a => a -> BS.ByteString+bshow = BS.pack . show++data Order+    = DateAddedAsc    -- ^ Sort by date added, asceding+    | DateAddedDesc   -- ^ Sort by date added, desceding (this is default)+    | DateUpdatedAsc  -- ^ Sort by date updated, asceding+    | DateUpdatedDesc -- ^ Sort by date updated, desceding+    deriving (Eq)++instance Show Order where+    show DateAddedAsc = "date_added"+    show DateAddedDesc = "-date_added"+    show DateUpdatedAsc = "date_updated"+    show DateUpdatedDesc = "-date_updated"++instance FromJSON Order where+    parseJSON (String "date_added") = return DateAddedAsc+    parseJSON (String "-date_added") = return DateAddedDesc+    parseJSON (String "date_updated") = return DateUpdatedAsc+    parseJSON (String "-date_updated") = return DateUpdatedDesc+    parseJSON _ = fail "Cant't parse Order"++data BookmarksConditions = BookmarksConditions+    { bc_archive :: Maybe Int+    , bc_favorite :: Maybe Int+    , bc_domain :: Maybe Text+    , bc_added_since :: Maybe Text+    , bc_added_until :: Maybe Text+    , bc_opened_since :: Maybe Text+    , bc_opened_until :: Maybe Text+    , bc_archived_since :: Maybe Text+    , bc_archived_until :: Maybe Text+    , bc_favorited_since :: Maybe Text+    , bc_favorited_until :: Maybe Text+    , bc_updated_since :: Maybe Text+    , bc_updated_until :: Maybe Text+    , bc_order :: Maybe Order+    , bc_user :: Maybe Text+    , bc_page :: Maybe Integer+    , bc_per_page :: Maybe Integer+    , bc_exclude_accessibility :: Maybe Text+    } deriving (Eq, Show)++$(deriveFromJSON defaultOptions{ fieldLabelModifier = drop (length ("bc_" :: String)) } ''BookmarksConditions)++data BookmarksMeta = BookmarksMeta+    { bmeta_num_pages :: Maybe Integer+    , bmeta_page :: Maybe Integer+    , bmeta_item_count_total :: Maybe Integer+    , bmeta_item_count :: Maybe Integer+    } deriving (Eq, Show)++$(deriveFromJSON defaultOptions{ fieldLabelModifier = drop (length ("bmeta_" :: String)) } ''BookmarksMeta)++data Tag = Tag+    { t_text :: Text+    , t_id :: Integer+    , t_applied_count :: Maybe Integer+    , t_bookmark_ids :: Maybe [Integer]+    } deriving (Eq, Show)++$(deriveFromJSON defaultOptions{ fieldLabelModifier = drop (length ("t_" :: String)) } ''Tag)++data Bookmark = Bookmark+    { b_user_id :: Integer+    , b_read_percent :: Text+    , b_date_updated :: Text+    , b_favorite :: Bool+    , b_archive :: Bool+    , b_article :: Article+    , b_id :: Integer+    , b_date_archived :: Maybe Text+    , b_date_opened :: Maybe Text+    , b_date_added :: Maybe Text+    , b_date_favorited :: Maybe Text+    , b_article_href :: Text+    , b_tags :: [Tag]+    } deriving (Eq, Show)++$(deriveFromJSON defaultOptions{ fieldLabelModifier = drop (length ("b_" :: String)) } ''Bookmark)++data BookmarksResponse = BookmarksResponse+    { br_conditions :: BookmarksConditions+    , br_meta :: BookmarksMeta+    , br_bookmarks :: [Bookmark]+    } deriving (Eq, Show)++$(deriveFromJSON defaultOptions{ fieldLabelModifier = drop (length ("br_" :: String)) } ''BookmarksResponse)++-- | Get all user bookmarks.+--+-- This is a @GET@ request to @\/bookmarks@.+getBookmarks :: OAuth+             -> Credential+             -> BookmarksFilters+             -> Maybe Order+             -> Maybe Integer -- ^ Page+             -> Maybe Integer -- ^ Per page+             -> Maybe Bool -- ^ Only deleted+             -> [String] -- ^ Tags+             -> IO (Either String BookmarksResponse)+getBookmarks oauth credential bfilter mOrder mPage mPerPage mOnlyDeleted tags =+    getRequest oauth credential "/bookmarks" $+        bookmarkFiltersToParams bfilter ++ catMaybes+            [ param "order" mOrder+            , param "page" mPage+            , param "per_page" mPerPage+            , boolParam "only_deleted" mOnlyDeleted+            , stringListParam "tags" tags+            ]++data BookmarkLocation = BookmarkLocation+    { blLocation :: Maybe BS.ByteString+    , blArticleLocation :: Maybe BS.ByteString+    } deriving (Eq, Show)++-- | Add bookmark.+--+-- This is a @POST@ request to @/bookmarks@.+addBookmark :: OAuth+            -> Credential+            -> BS.ByteString -- ^ Article URL+            -> Maybe Bool    -- ^ Favorite+            -> Maybe Bool    -- ^ Archive+            -> Maybe Bool    -- ^ Allow duplicates+            -> IO BookmarkLocation+addBookmark oauth cred articleUrl mFavorite mArchive mAllowDuplicates = do+    response <- postRequest' oauth cred "/bookmarks" $ catMaybes+        [ Just ("url", articleUrl)+        , boolParam' "favorite" mFavorite+        , boolParam' "archive" mArchive+        , boolParam' "allow_duplicates" mAllowDuplicates+        ]+    let headers = responseHeaders response+    return $ BookmarkLocation (lookup "Location" headers) (lookup "X-Article-Location" headers)++-- | Get bookmark by id.+--+-- This is a @GET@ request to @\/bookmarks\/{bookmarkId}@.+getBookmark :: OAuth+            -> Credential+            -> Integer    -- ^ Bookmark id+            -> IO (Either String Bookmark)+getBookmark oauth cred bookmarkId =+    getRequest oauth cred ("/bookmarks/" ++ show bookmarkId) []++-- | Update bookmark.+--+-- This a @POST@ request to @\/bookmarks\/{bookmarkId}@.+updateBookmark :: OAuth+               -> Credential+               -> Integer      -- ^ Bookmark id+               -> Maybe Bool   -- ^ Favorite+               -> Maybe Bool   -- ^ Archive+               -> Maybe Double -- ^ Read percent+               -> IO (Either String Bookmark)+updateBookmark oauth cred bookmarkId mFavorite mArchive mReadPercent =+    postRequest oauth cred ("/bookmarks/" ++ show bookmarkId) $ catMaybes+        [ boolParam' "favorite" mFavorite+        , boolParam' "archive" mArchive+        , param' "read_percent" mReadPercent+        ]++-- | Delete bookmark by id.+--+-- This is a @DELETE@ request to @\/bookmarks\/{bookmarkId}@.+deleteBookmark :: OAuth+               -> Credential+               -> Integer    -- ^ Bookmark id+               -> IO (Response BL.ByteString)+deleteBookmark oauth cred bookmarkId =+    deleteRequest oauth cred ("/bookmarks/" ++ show bookmarkId)++data TagsResponse = TagsResponse { tr_tags :: [Tag] } deriving (Eq, Show)++$(deriveFromJSON defaultOptions{ fieldLabelModifier = drop (length ("tr_" :: String)) } ''TagsResponse)++-- | Get bookmark tags+--+-- This is a @GET@ request to @\/bookmarks\/{bookmarkId}\/tags@.+getBookmarkTags :: OAuth+                -> Credential+                -> Integer    -- ^ Bookmark id+                -> IO (Either String TagsResponse)+getBookmarkTags oauth cred bookmarkId =+    getRequest oauth cred ("/bookmarks/" ++ show bookmarkId ++ "/tags") []++-- | Add tags to bookmark.+--+-- This is a @POST@ request to @\/bookmarks\/{bookmarkId}\/tags@.+addBookmarkTags :: OAuth+                -> Credential+                -> Integer    -- ^ Bookmark id+                -> [Text]   -- ^ Tags+                -> IO (Either String TagsResponse)+addBookmarkTags oauth cred bookmarkId tags = +    postRequest oauth cred ("/bookmarks/" ++ show bookmarkId ++ "/tags") $+        [ ("tags", T.encodeUtf8 $ T.intercalate "," tags) ]++-- | Delete given tag from bookmark.+--+-- This is a @DELETE@ request to @\/bookmark\/{bookmarkId}\/tags\/{tagId}@.+deleteBookmarkTag :: OAuth+                  -> Credential+                  -> Integer    -- ^ Bookmark id+                  -> Integer    -- ^ Tag id+                  -> IO (Response BL.ByteString)+deleteBookmarkTag oauth cred bookmarkId tagId =+    deleteRequest oauth cred ("/bookmarks/" ++ show bookmarkId ++ "/tags/" ++ show tagId)++-- | Retrieve all user tags.+--+-- This is a @GET@ request to @/tags@.+getTags :: OAuth+        -> Credential+        -> IO (Either String TagsResponse)+getTags oauth cred = getRequest oauth cred "/tags" []++-- | Retrieve tag by id.+--+-- This is a @GET@ request to @\/tags\/{tagId}@.+getTag :: OAuth+       -> Credential+       -> Integer+       -> IO (Either String Tag)+getTag oauth cred tagId = getRequest oauth cred ("/tags/" ++ show tagId) []++-- | Delete tag by id.+--+-- This is a @DELETE@ request to @\/tags\/{tagId}@.+deleteTag :: OAuth+          -> Credential+          -> Integer+          -> IO (Response BL.ByteString)+deleteTag oauth cred tagId = deleteRequest oauth cred ("/tags/" ++ show tagId)++data User = User+    { u_username :: Text+    , u_first_name :: Maybe Text+    , u_second_name :: Maybe Text+    , u_date_joined :: Maybe Text+    , u_has_active_subscriptions :: Maybe Bool+    , u_reading_limit :: Maybe Integer+    , u_email_into_address :: Maybe Text+    , u_kindle_email_address :: Maybe Text+    , u_tags :: [Tag]+    } deriving (Eq, Show)++$(deriveFromJSON defaultOptions{ fieldLabelModifier = drop (length ("u_" :: String)) } ''User)++-- | Retrieve current user info.+--+-- This is a @GET@ request to @\/user\/_current@.+getUser :: OAuth+        -> Credential+        -> IO (Either String User)+getUser oauth cred = getRequest oauth cred "/user/_current" []
+ src/Network/Readability/Shortener.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}+-- | This module is an interface to the Readability's Shortener API.+--+-- To get more info, visit <https://www.readability.com/developers/api/shortener>.+module Network.Readability.Shortener+    ( Article(..)++      -- * Shorten and retrieve URL+    , ShortenerMeta(..)+    , ShortenerResponse(..)+    , shortenUrl+    , retrieveUrl+    ) where++import qualified Data.ByteString.Char8 as BS++import Data.Text (Text)+import Data.Aeson (eitherDecode)+import Data.Aeson.TH (deriveFromJSON, defaultOptions, fieldLabelModifier)++import Network.HTTP.Conduit (parseUrl, responseBody, withManager, httpLbs, urlEncodedBody)++import Network.Readability.Parser (Article(..))++-- | Contains main data+data ShortenerMeta = ShortenerMeta+    { smeta_article :: Maybe Article+    , smeta_url :: Maybe Text+    , smeta_rdd_url :: Text         -- ^ The shortened URL+    , smeta_id :: Text              -- ^ The id of shortened URL+    , smeta_full_url :: Maybe Text  -- ^ The Article URL+    } deriving (Show)++-- | Response from Shortener API+data ShortenerResponse = ShortenerResponse+    { se_meta :: ShortenerMeta+    , se_messages :: [Text]         -- ^ The response messages+    , se_success :: Bool+    } deriving (Show)++$(deriveFromJSON defaultOptions{ fieldLabelModifier = drop (length ("smeta_" :: String)) } ''ShortenerMeta)+$(deriveFromJSON defaultOptions{ fieldLabelModifier = drop (length ("se_" :: String)) } ''ShortenerResponse)++apiPrefix :: String+apiPrefix = "https://readability.com/api/shortener/v1/urls"++-- | Create a new shortened URL+--+-- This is a @POST@ request to @/urls@.+shortenUrl :: String -> IO (Either String ShortenerResponse)+shortenUrl source_url  = shortenUrlRequest $ BS.pack source_url++shortenUrlRequest :: BS.ByteString -> IO (Either String ShortenerResponse)+shortenUrlRequest source_url = do+    initRequest <- parseUrl apiPrefix+    let request = urlEncodedBody [("url", source_url)] initRequest+    response <- withManager $ httpLbs request+    return $ eitherDecode $ responseBody response++-- | Retrieve a single shortened URL+--+-- This is a @GET@ request to @\/urls\/{urlId}@.+retrieveUrl :: String -> IO (Either String ShortenerResponse)+retrieveUrl = retrieveUrlRequest++retrieveUrlRequest :: String -> IO (Either String ShortenerResponse)+retrieveUrlRequest url_id = do+    request <- parseUrl (apiPrefix ++ "/" ++ url_id)+    response <- withManager $ httpLbs request+    return $ eitherDecode $ responseBody response
+ tests/Main.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+module Main(main) where++import Data.FileEmbed (embedFile)+import Data.Aeson (decodeStrict)++import System.Exit (exitFailure)++import Network.Readability.Parser++import Test.Framework (defaultMain)+import Test.Framework.Providers.HUnit++import Test.HUnit++main = defaultMain tests++tests =+    [ testCase "decode parser response 1" test_parser_json1+    , testCase "decode example confidence response" test_confidence_parser+    ]++test_parser_json1 = assertEqual "decode example /parser response"+    (Just Article+        { content = Just "<div class=\"article-text\">\n<p>I'm idling outside Diamante's, [snip] ...</p></div>"+        , domain = Just "www.gq.com"+        , author = Just "Rafi Kohan"+        , url = "http://www.gq.com/sports/profiles/201202/david-diamante-interview-cigar-lounge-brooklyn-new-jersey-nets?currentPage=all"+        , short_url = Just "http://rdd.me/g3jcb1sr"+        , title = Just "Blowing Smoke with Boxing's Big Voice"+        , excerpt = Just "I'm idling outside Diamante's, a cigar lounge in Fort Greene, waiting for David Diamante, and soon I smell him coming. It's late January but warm. A motorcycle growls down the Brooklyn side street,&hellip;"+        , direction = Just "ltr"+        , word_count = 2892+        , total_pages = Just 1+        , date_published = Nothing+        , dek = Just "Announcer <strong>David Diamante</strong>, the new voice of the New Jersey (soon Brooklyn) Nets, has been calling boxing matches for years. On the side, he owns a cigar lounge in the heart of Brooklyn. We talk with Diamante about his new gig and the fine art of cigars"+        , lead_image_url = Just "http://www.gq.com/images/entertainment/2012/02/david-diamante/diamante-628.jpg"+        , next_page_id = Nothing+        , rendered_pages = Just 1+        })+    (decodeStrict $(embedFile "tests/files/parser_article.json"))++-- readability examples provide invalid JSON for this case+-- .7 in examples should be 0.7+test_confidence_parser = assertEqual "decode example /confidence response"+    (Just Confidence+        { conf_url = "http://www.gq.com/article/12"+        , conf_confidence = 0.7+        })+    (decodeStrict $(embedFile "tests/files/confidence_response.json"))
+ tests/files/confidence_response.json view
@@ -0,0 +1,4 @@+{+    "url": "http://www.gq.com/article/12",+    "confidence": 0.7+}
+ tests/files/parser_article.json view
@@ -0,0 +1,17 @@+{+    "content": "<div class=\"article-text\">\n<p>I'm idling outside Diamante's, [snip] ...</p></div>",+    "domain": "www.gq.com",+    "author": "Rafi Kohan",+    "url": "http://www.gq.com/sports/profiles/201202/david-diamante-interview-cigar-lounge-brooklyn-new-jersey-nets?currentPage=all",+    "short_url": "http://rdd.me/g3jcb1sr",+    "title": "Blowing Smoke with Boxing's Big Voice",+    "excerpt": "I'm idling outside Diamante's, a cigar lounge in Fort Greene, waiting for David Diamante, and soon I smell him coming. It's late January but warm. A motorcycle growls down the Brooklyn side street,&hellip;",+    "direction": "ltr",+    "word_count": 2892,+    "total_pages": 1,+    "date_published": null,+    "dek": "Announcer <strong>David Diamante</strong>, the new voice of the New Jersey (soon Brooklyn) Nets, has been calling boxing matches for years. On the side, he owns a cigar lounge in the heart of Brooklyn. We talk with Diamante about his new gig and the fine art of cigars",+    "lead_image_url": "http://www.gq.com/images/entertainment/2012/02/david-diamante/diamante-628.jpg",+    "next_page_id": null,+    "rendered_pages": 1+}