diff --git a/hackernews.cabal b/hackernews.cabal --- a/hackernews.cabal +++ b/hackernews.cabal @@ -1,5 +1,5 @@ name: hackernews -version: 0.2.3.2 +version: 0.3.0.0 description: API for news.ycombinator.com license: MIT synopsis: API for Hacker News @@ -11,7 +11,7 @@ cabal-version: >=1.10 library - ghc-options: -Wall -threaded + ghc-options: -Wall -threaded -rtsopts exposed-modules: Web.HackerNews other-modules: Web.HackerNews.Types , Web.HackerNews.Client @@ -22,13 +22,16 @@ , Web.HackerNews.Comment , Web.HackerNews.Story , Web.HackerNews.Job + , Web.HackerNews.Item , Web.HackerNews.Util + , Web.HackerNews.Endpoint hs-source-dirs: src build-depends: HsOpenSSL >= 0.10.5 , aeson >= 0.8.0.1 , attoparsec >= 0.12.1.2 , base >= 4.7 && <4.8 , bytestring >= 0.10.4.0 + , either >= 4.3.1 , http-streams >= 0.7.2.2 , io-streams >= 1.1.4.6 , text >= 1.2.0.0 @@ -38,7 +41,7 @@ Test-Suite tests type: exitcode-stdio-1.0 - ghc-options: -rtsopts -threaded + ghc-options: -rtsopts -threaded hs-source-dirs: tests main-is: Test.hs build-depends: base diff --git a/src/Web/HackerNews.hs b/src/Web/HackerNews.hs --- a/src/Web/HackerNews.hs +++ b/src/Web/HackerNews.hs @@ -1,8 +1,15 @@ {-# LANGUAGE OverloadedStrings #-} +-- | +-- Module : Web.HackerNews +-- Copyright : (c) David Johnson, Konstantin Zudov, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX module Web.HackerNews ( -- * Hacker News Monad hackerNews -- * API Calls + , getItem , getStory , getComment , getPoll @@ -14,6 +21,9 @@ , getUpdates -- * Types , HackerNews + , HackerNewsError (..) + , Item (..) + , ItemId (..) , Comment (..) , CommentId (..) , Poll (..) @@ -31,54 +41,56 @@ , TopStories ) where -import Data.Monoid ((<>)) - import Web.HackerNews.Types -import Web.HackerNews.Util (toText) -import Web.HackerNews.Client +import Web.HackerNews.Client (HackerNews, hackerNews, HackerNewsError(..)) ------------------------------------------------------------------------------ +-- | Retrieve a `Item` by `ItemId` +getItem :: ItemId -> HackerNews Item +getItem = getEndpoint + +------------------------------------------------------------------------------ -- | Retrieve a `Story` by `StoryId` -getStory :: StoryId -> HackerNews (Maybe Story) -getStory (StoryId storyid) = buildHNRequest $ "item/" <> toText storyid +getStory :: StoryId -> HackerNews Story +getStory = getEndpoint ------------------------------------------------------------------------------ -- | Retrieve a `Comment` by `CommentId` -getComment :: CommentId -> HackerNews (Maybe Comment) -getComment (CommentId commentid) = buildHNRequest $ "item/" <> toText commentid +getComment :: CommentId -> HackerNews Comment +getComment = getEndpoint ------------------------------------------------------------------------------ -- | Retrieve a `Poll` by `PollId` -getPoll :: PollId -> HackerNews (Maybe Poll) -getPoll (PollId pollid) = buildHNRequest $ "item/" <> toText pollid +getPoll :: PollId -> HackerNews Poll +getPoll = getEndpoint ------------------------------------------------------------------------------ -- | Retrieve a `PollOpt` by `PollOptId` -getPollOpt :: PollOptId -> HackerNews (Maybe PollOpt) -getPollOpt (PollOptId polloptid) = buildHNRequest $ "item/" <> toText polloptid +getPollOpt :: PollOptId -> HackerNews PollOpt +getPollOpt = getEndpoint ------------------------------------------------------------------------------ -- | Retrieve a `User` by `UserId` -getUser :: UserId -> HackerNews (Maybe User) -getUser (UserId userid) = buildHNRequest $ "user/" <> userid +getUser :: UserId -> HackerNews User +getUser = getEndpoint ------------------------------------------------------------------------------ -- | Retrieve a Job -getJob :: JobId -> HackerNews (Maybe Job) -getJob (JobId jobid) = buildHNRequest $ "item/" <> toText jobid +getJob :: JobId -> HackerNews Job +getJob = getEndpoint ------------------------------------------------------------------------------ -- | Retrieve the Top Stories on Hacker News -getTopStories :: HackerNews (Maybe TopStories) -getTopStories = buildHNRequest "topstories" +getTopStories :: HackerNews TopStories +getTopStories = getEndpoint TopStoriesId ------------------------------------------------------------------------------ -- | Retrieve the largest ItemId -getMaxItem :: HackerNews (Maybe MaxItem) -getMaxItem = buildHNRequest "maxitem" +getMaxItem :: HackerNews MaxItem +getMaxItem = getEndpoint MaxItemId ------------------------------------------------------------------------------ -- | Retrieve the latest updates -getUpdates :: HackerNews (Maybe Update) -getUpdates = buildHNRequest "updates" +getUpdates :: HackerNews Update +getUpdates = getEndpoint UpdateId diff --git a/src/Web/HackerNews/Client.hs b/src/Web/HackerNews/Client.hs --- a/src/Web/HackerNews/Client.hs +++ b/src/Web/HackerNews/Client.hs @@ -1,60 +1,82 @@ -{-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} +-- | +-- Module : Web.HackerNews.Client +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX module Web.HackerNews.Client ( hackerNews , buildHNRequest , HackerNews + , HackerNewsError (..) ) where import Data.Aeson hiding (Result) import Data.Aeson.Parser (value) import Data.Attoparsec.ByteString (parseOnly) import Data.Either (rights) +import Control.Monad.Trans.Either +import Control.Exception (try, SomeException) import Control.Monad.IO.Class (liftIO) +import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Reader (ReaderT, ask, runReaderT) import Data.Monoid ((<>)) -import Data.Text (Text) import qualified Data.Text.Encoding as T +import Data.Text (Text) import Network.Http.Client import OpenSSL (withOpenSSL) import qualified System.IO.Streams as Streams ------------------------------------------------------------------------------ -- | Core Type -type HackerNews a = ReaderT Connection IO a +type HackerNews a = EitherT HackerNewsError (ReaderT Connection IO) a ------------------------------------------------------------------------------ +-- | Error Types +data HackerNewsError = + ConnectionError + | ParseError + | RequestError + deriving (Show, Eq) + +------------------------------------------------------------------------------ -- | HackerNews API request method -hackerNews :: (Show a, FromJSON a) => HackerNews a -> IO a +hackerNews :: FromJSON a => HackerNews a -> IO (Either HackerNewsError a) hackerNews requests = withOpenSSL $ do ctx <- baselineContextSSL - con <- openConnectionSSL ctx "hacker-news.firebaseio.com" 443 - result <- runReaderT requests con - closeConnection con - return result + con <- try (openConnectionSSL ctx "hacker-news.firebaseio.com" 443) :: IO (Either SomeException Connection) + case con of + Left _ -> return $ Left ConnectionError + Right conn -> do + result <- flip runReaderT conn $ runEitherT requests + closeConnection conn + return result ------------------------------------------------------------------------------ -- | Request Builder for API -buildHNRequest :: FromJSON a => Text -> HackerNews (Maybe a) +buildHNRequest :: FromJSON a => Text -> HackerNews a buildHNRequest url = do - con <- ask - liftIO $ do + con <- lift ask + bytes <- liftIO $ do req <- buildRequest $ do http GET $ "/v0/" <> T.encodeUtf8 url <> ".json" setHeader "Connection" "Keep-Alive" setAccept "application/json" sendRequest con req emptyBody - !bytes <- receiveResponse con $ const Streams.read - return $ case bytes of - Nothing -> Nothing - Just bs -> do - let xs = rights [parseOnly value bs, parseOnly json bs] - case xs of - [] -> Nothing - x : _ -> - case fromJSON x of - Success a -> Just a - _ -> Nothing + receiveResponse con $ const Streams.read + case bytes of + Nothing -> left RequestError + Just bs -> do + let xs = rights [parseOnly value bs, parseOnly json bs] + case xs of + [] -> left ParseError + x : _ -> + case fromJSON x of + Success jsonBody -> right jsonBody + _ -> left ParseError + + diff --git a/src/Web/HackerNews/Comment.hs b/src/Web/HackerNews/Comment.hs --- a/src/Web/HackerNews/Comment.hs +++ b/src/Web/HackerNews/Comment.hs @@ -1,33 +1,49 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +-- | +-- Module : Web.HackerNews.Comment +-- Copyright : (c) David Johnson, Konstantin Zudov 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX module Web.HackerNews.Comment where -import Control.Applicative ((<$>), (<*>)) -import Control.Monad (MonadPlus (mzero)) -import Data.Aeson (FromJSON (parseJSON), Value (Object), - (.:), (.:?), (.!=)) -import Data.Text (Text) -import Data.Time (UTCTime) +import Control.Applicative ((<$>), (<*>)) +import Control.Monad (MonadPlus (mzero)) +import Data.Aeson (FromJSON (parseJSON), Value (Object), + (.!=), (.:), (.:?)) +import Data.Text (Text) +import Data.Time (UTCTime) -import Web.HackerNews.Util (fromSeconds) +import Web.HackerNews.Endpoint (Endpoint (endpoint), itemEndpoint) +import Web.HackerNews.Util (fromSeconds) ------------------------------------------------------------------------------ --- | Types +-- | Comment Object data Comment = Comment { - commentBy :: Text - , commentId :: CommentId - , commentKids :: Maybe [Int] - , commentParent :: Int - , commentText :: Text - , commentTime :: UTCTime - , commentType :: Text + commentBy :: Text + , commentId :: CommentId + , commentKids :: Maybe [Int] + , commentParent :: Int + , commentText :: Text + , commentTime :: UTCTime + , commentType :: Text , commentDeleted :: Bool + , commentDead :: Bool } deriving Show +------------------------------------------------------------------------------ +-- | `CommentId` for a `Comment` Object newtype CommentId = CommentId Int deriving (Show, Eq) ------------------------------------------------------------------------------ +-- | Endpoint instances +instance Endpoint CommentId Comment where + endpoint (CommentId id') = itemEndpoint id' + +------------------------------------------------------------------------------ -- | JSON Instances instance FromJSON Comment where parseJSON (Object o) = @@ -39,6 +55,7 @@ <*> (fromSeconds <$> o .: "time") <*> o .: "type" <*> o .:? "deleted" .!= False + <*> o .:? "dead" .!= False parseJSON _ = mzero diff --git a/src/Web/HackerNews/Endpoint.hs b/src/Web/HackerNews/Endpoint.hs new file mode 100644 --- /dev/null +++ b/src/Web/HackerNews/Endpoint.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +-- | +-- Module : Web.HackerNews.Endpoint +-- Copyright : (c) David Johnson, Konstantin Zudov, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +module Web.HackerNews.Endpoint where + +import Data.Aeson (FromJSON) +import Data.Text (Text, append) + +import Web.HackerNews.Client (HackerNews, buildHNRequest) +import Web.HackerNews.Util (toText) + +------------------------------------------------------------------------------ +-- | Endpoint maps the id to the returned type on a type level +-- The function dependency @id -> resp@ specifies that @id@ uniquely determines @resp@ +class Endpoint id resp | id -> resp where + endpoint :: id -> Text -- ^ Turn @id@ into path that points to resource + +------------------------------------------------------------------------------ +-- | Endpoint for `Item` +itemEndpoint :: Int -> Text +itemEndpoint = append "item/" . toText + +------------------------------------------------------------------------------ +-- | Generic function for making requests +getEndpoint :: (Endpoint a b, FromJSON b) => a -> HackerNews b +getEndpoint id' = buildHNRequest $ endpoint id' diff --git a/src/Web/HackerNews/Item.hs b/src/Web/HackerNews/Item.hs new file mode 100644 --- /dev/null +++ b/src/Web/HackerNews/Item.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +-- | +-- Module : Web.Stripe.Stripe +-- Copyright : (c) David Johnson, Konstantin Zudov, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX +module Web.HackerNews.Item where + +import Control.Applicative ((<$>)) +import Control.Monad (MonadPlus (mzero)) +import Data.Aeson (FromJSON (parseJSON), Value (Object), + (.:)) +import Data.Text (Text) + +import Web.HackerNews.Comment (Comment) +import Web.HackerNews.Endpoint (Endpoint (endpoint), itemEndpoint) +import Web.HackerNews.Job (Job) +import Web.HackerNews.Poll (Poll, PollOpt) +import Web.HackerNews.Story (Story) + +------------------------------------------------------------------------------ +-- | Item Type +data Item = ItemComment Comment + | ItemPoll Poll + | ItemPollOpt PollOpt + | ItemStory Story + | ItemJob Job + deriving (Show) + +------------------------------------------------------------------------------ +-- | Item ID for a `Item` object +newtype ItemId = ItemId Int deriving (Show,Eq) + +------------------------------------------------------------------------------ +-- | Max Item ID for a `Item` +data MaxItemId = MaxItemId deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | Max Item Int +newtype MaxItem = MaxItem Int deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | Endpoint Instances for `MaxItemId` and `MaxItem` +instance Endpoint MaxItemId MaxItem where + endpoint _ = "maxitem" + +------------------------------------------------------------------------------ +-- | Endpoint Instances for `ItemId` & `Item` +instance Endpoint ItemId Item where + endpoint (ItemId id') = itemEndpoint id' + +------------------------------------------------------------------------------ +-- | JSON Instances +instance FromJSON Item where + parseJSON v@(Object o) = do + itemType <- o .: "type" + case (itemType :: Text) of + "job" -> ItemJob <$> parseJSON v + "story" -> ItemStory <$> parseJSON v + "comment" -> ItemComment <$> parseJSON v + "poll" -> ItemPoll <$> parseJSON v + "pollopt" -> ItemPollOpt <$> parseJSON v + _ -> mzero + parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | JSON MaxItem Instance +instance FromJSON MaxItem where + parseJSON = fmap MaxItem . parseJSON + diff --git a/src/Web/HackerNews/Job.hs b/src/Web/HackerNews/Job.hs --- a/src/Web/HackerNews/Job.hs +++ b/src/Web/HackerNews/Job.hs @@ -1,34 +1,50 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +-- | +-- Module : Web.HackerNews.Job +-- Copyright : (c) David Johnson, Konstantin Zudov, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX module Web.HackerNews.Job where -import Control.Applicative ((<*>), (<$>)) -import Control.Monad (MonadPlus (mzero)) -import Data.Aeson (FromJSON (parseJSON), Value (Object), - (.:), (.:?), (.!=)) -import Data.Text (Text) -import Data.Time (UTCTime) +import Control.Applicative ((<$>), (<*>)) +import Control.Monad (MonadPlus (mzero)) +import Data.Aeson (FromJSON (parseJSON), Value (Object), + (.!=), (.:), (.:?)) +import Data.Text (Text) +import Data.Time (UTCTime) -import Web.HackerNews.Util (fromSeconds) +import Web.HackerNews.Endpoint (Endpoint (endpoint), itemEndpoint) +import Web.HackerNews.Util (fromSeconds) ------------------------------------------------------------------------------ -- | Types data Job = Job { - jobBy :: Text - , jobId :: JobId - , jobScore :: Int - , jobText :: Text - , jobTime :: UTCTime - , jobTitle :: Text - , jobType :: Text - , jobUrl :: Text - , jobDeleted :: Bool + jobBy :: Text + , jobId :: JobId + , jobScore :: Int + , jobText :: Text + , jobTime :: UTCTime + , jobTitle :: Text + , jobType :: Text + , jobUrl :: Text + , jobDeleted :: Bool + , jobDead :: Bool } deriving (Show) +------------------------------------------------------------------------------ +-- | ID for a `Job` type newtype JobId = JobId Int deriving (Show, Eq) ------------------------------------------------------------------------------ +-- | Endpoint Instances +instance Endpoint JobId Job where + endpoint (JobId id') = itemEndpoint id' + +------------------------------------------------------------------------------ -- | JSON Instances instance FromJSON Job where parseJSON (Object o) = @@ -41,5 +57,6 @@ <*> o .: "type" <*> o .: "url" <*> o .:? "deleted" .!= False + <*> o .:? "dead" .!= False parseJSON _ = mzero diff --git a/src/Web/HackerNews/Person.hs b/src/Web/HackerNews/Person.hs --- a/src/Web/HackerNews/Person.hs +++ b/src/Web/HackerNews/Person.hs @@ -1,17 +1,23 @@ {-# LANGUAGE OverloadedStrings #-} +-- | +-- Module : Web.HackerNews.Person +-- Copyright : (c) David Johnson, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX module Web.HackerNews.Person where import Control.Applicative ((<$>), (<*>)) import Control.Monad (MonadPlus (mzero)) import Data.Aeson (FromJSON (parseJSON), Value (Object), - (.:), (.:?), (.!=)) + (.!=), (.:), (.:?)) import Data.Text (Text) import Data.Time (UTCTime) import Web.HackerNews.Util (fromSeconds) ------------------------------------------------------------------------------ --- | Types +-- | Person Object data Person = Person { personBy :: Text , personId :: PersonId @@ -22,8 +28,11 @@ , personType :: Text , personUrl :: Maybe Text , personDeleted :: Bool + , personDead :: Bool } deriving (Show, Eq) +------------------------------------------------------------------------------ +-- | Person ID for a `Person` Object newtype PersonId = PersonId Text deriving (Show, Eq) @@ -41,4 +50,5 @@ <*> o .: "type" <*> o .:? "url" <*> o .:? "deleted" .!= False + <*> o .:? "dead" .!= False parseJSON _ = mzero diff --git a/src/Web/HackerNews/Poll.hs b/src/Web/HackerNews/Poll.hs --- a/src/Web/HackerNews/Poll.hs +++ b/src/Web/HackerNews/Poll.hs @@ -1,17 +1,25 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +-- | +-- Module : Web.HackerNews.Poll +-- Copyright : (c) David Johnson, Konstantin Zudov, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX module Web.HackerNews.Poll where -import Control.Applicative ((<$>), (<*>)) -import Control.Monad (MonadPlus (mzero)) -import Data.Aeson (FromJSON (parseJSON), Value (Object), - (.:), (.!=), (.:?)) -import Data.Text (Text) -import Data.Time (UTCTime) +import Control.Applicative ((<$>), (<*>)) +import Control.Monad (MonadPlus (mzero)) +import Data.Aeson (FromJSON (parseJSON), Value (Object), + (.!=), (.:), (.:?)) +import Data.Text (Text) +import Data.Time (UTCTime) -import Web.HackerNews.Util (fromSeconds) +import Web.HackerNews.Endpoint (Endpoint (endpoint), itemEndpoint) +import Web.HackerNews.Util (fromSeconds) ------------------------------------------------------------------------------ --- | Types +-- | Poll Object data Poll = Poll { pollBy :: Text , pollId :: PollId @@ -23,8 +31,11 @@ , pollTitle :: Text , pollType :: Text , pollDeleted :: Bool + , pollDead :: Bool } deriving (Show, Eq) +------------------------------------------------------------------------------ +-- | Poll Opt Object data PollOpt = PollOpt { pollOptBy :: Text , pollOptId :: PollOptId @@ -34,18 +45,33 @@ , pollOptTime :: UTCTime , pollOptType :: Text , pollOptDeleted :: Bool + , pollOptDead :: Bool } deriving (Show, Eq) +------------------------------------------------------------------------------ +-- | Poll Option Id for a `PollOpt` newtype PollOptId = PollOptId Int deriving (Show, Eq) +------------------------------------------------------------------------------ +-- | Poll Id for a `Poll` newtype PollId = PollId Int deriving (Show, Eq) ------------------------------------------------------------------------------ --- | JSON Instances +-- | `Endpoint` Instance for `PollOptId` +instance Endpoint PollOptId PollOpt where + endpoint (PollOptId id') = itemEndpoint id' + +------------------------------------------------------------------------------ +-- | `Endpoint` Instance for `PollId` +instance Endpoint PollId Poll where + endpoint (PollId id') = itemEndpoint id' + +------------------------------------------------------------------------------ +-- | Poll JSON Instances instance FromJSON Poll where parseJSON (Object o) = Poll <$> o .: "by" @@ -58,8 +84,11 @@ <*> o .: "title" <*> o .: "type" <*> o .:? "deleted" .!= False + <*> o .:? "dead" .!= False parseJSON _ = mzero +------------------------------------------------------------------------------ +-- | Poll JSON Instances instance FromJSON PollOpt where parseJSON (Object o) = PollOpt <$> o .: "by" @@ -70,4 +99,5 @@ <*> (fromSeconds <$> o .: "time") <*> o .: "type" <*> o .:? "deleted" .!= False + <*> o .:? "dead" .!= False parseJSON _ = mzero diff --git a/src/Web/HackerNews/Story.hs b/src/Web/HackerNews/Story.hs --- a/src/Web/HackerNews/Story.hs +++ b/src/Web/HackerNews/Story.hs @@ -1,20 +1,28 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +-- | +-- Module : Web.HackerNews.Story +-- Copyright : (c) David Johnson, Konstantin Zudov, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX module Web.HackerNews.Story where -import Control.Applicative ((<$>), (<*>)) -import Control.Monad (MonadPlus (mzero)) -import Data.Aeson (FromJSON (parseJSON), Value (Object), - (.:), (.!=), (.:?)) -import Data.Text (Text) -import Data.Time (UTCTime) +import Control.Applicative ((<$>), (<*>)) +import Control.Monad (MonadPlus (mzero)) +import Data.Aeson (FromJSON (parseJSON), Value (Object), + (.!=), (.:), (.:?)) +import Data.Text (Text) +import Data.Time (UTCTime) -import Web.HackerNews.Util (fromSeconds) +import Web.HackerNews.Endpoint (Endpoint (endpoint), itemEndpoint) +import Web.HackerNews.Util (fromSeconds) ------------------------------------------------------------------------------ --- | Types +-- | Story Object data Story = Story { storyBy :: Text - , storyId :: Int + , storyId :: StoryId , storyKids :: [Int] , storyScore :: Int , storyTime :: UTCTime @@ -22,21 +30,39 @@ , storyType :: Text , storyUrl :: Text , storyDeleted :: Bool + , storyDead :: Bool } deriving Show +------------------------------------------------------------------------------ +-- | ID for a `Story` newtype StoryId = StoryId Int deriving (Show, Eq) -type TopStories = [Int] -type MaxItem = Int +------------------------------------------------------------------------------ +-- | `Story` ID +data TopStoriesId = TopStoriesId deriving (Show, Eq) ------------------------------------------------------------------------------ +-- | TopStories List +newtype TopStories = TopStories [Int] deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | Endpoint Instances for `StoryID` & `Story` +instance Endpoint StoryId Story where + endpoint (StoryId id') = itemEndpoint id' + +------------------------------------------------------------------------------ +-- | Endpoint Instances for `TopStoriesID` & `TopStories` +instance Endpoint TopStoriesId TopStories where + endpoint _ = "topstories" + +------------------------------------------------------------------------------ -- | JSON Instances instance FromJSON Story where parseJSON (Object o) = Story <$> o .: "by" - <*> o .: "id" + <*> (StoryId <$> o .: "id") <*> o .: "kids" <*> o .: "score" <*> (fromSeconds <$> o .: "time") @@ -44,5 +70,11 @@ <*> o .: "type" <*> o .: "url" <*> o .:? "deleted" .!= False + <*> o .:? "dead" .!= False parseJSON _ = mzero + +------------------------------------------------------------------------------ +-- | JSON instances `TopStories` +instance FromJSON TopStories where + parseJSON = fmap TopStories . parseJSON diff --git a/src/Web/HackerNews/Types.hs b/src/Web/HackerNews/Types.hs --- a/src/Web/HackerNews/Types.hs +++ b/src/Web/HackerNews/Types.hs @@ -1,11 +1,11 @@ -{-# LANGUAGE OverloadedStrings #-} +-- | +-- Module : Web.HackerNews.Types +-- Copyright : (c) David Johnson, Konstantin Zudov, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX module Web.HackerNews.Types ( module H - , StoryId (..) - , CommentId (..) - , PollId (..) - , PollOptId (..) - , UserId (..) ) where import Web.HackerNews.Comment as H @@ -13,7 +13,9 @@ import Web.HackerNews.Story as H import Web.HackerNews.User as H import Web.HackerNews.Update as H -import Web.HackerNews.Job as H +import Web.HackerNews.Job as H +import Web.HackerNews.Item as H +import Web.HackerNews.Endpoint as H diff --git a/src/Web/HackerNews/Update.hs b/src/Web/HackerNews/Update.hs --- a/src/Web/HackerNews/Update.hs +++ b/src/Web/HackerNews/Update.hs @@ -1,26 +1,46 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +-- | +-- Module : Web.HackerNews.Update +-- Copyright : (c) David Johnson, Konstantin Zudov, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX module Web.HackerNews.Update where -import Control.Applicative ((<$>), (<*>)) -import Control.Monad (MonadPlus (mzero)) -import Data.Aeson (FromJSON (parseJSON), Value (Object), - (.:), (.!=), (.:?)) -import Data.Text (Text) +import Control.Applicative ((<$>), (<*>)) +import Control.Monad (MonadPlus (mzero)) +import Data.Aeson (FromJSON (parseJSON), Value (Object), + (.!=), (.:), (.:?)) +import Data.Text (Text) +import Web.HackerNews.Endpoint (Endpoint (endpoint)) + ------------------------------------------------------------------------------ --- | Types +-- | Update Object data Update = Update { updateItems :: [Int] , updateProfiles :: [Text] , updateDeleted :: Bool + , updateDead :: Bool } deriving (Show, Eq) ------------------------------------------------------------------------------ +-- | Update ID for an `Updated` Object +data UpdateId = UpdateId deriving (Show, Eq) + +------------------------------------------------------------------------------ +-- | Endpoint Instances +instance Endpoint UpdateId Update where + endpoint _ = "updates" + +------------------------------------------------------------------------------ -- | JSON Instances instance FromJSON Update where parseJSON (Object o) = Update <$> o .: "items" <*> o .: "profiles" <*> o .:? "deleted" .!= False + <*> o .:? "dead" .!= False parseJSON _ = mzero diff --git a/src/Web/HackerNews/User.hs b/src/Web/HackerNews/User.hs --- a/src/Web/HackerNews/User.hs +++ b/src/Web/HackerNews/User.hs @@ -1,17 +1,26 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +-- | +-- Module : Web.HackerNews.User +-- Copyright : (c) David Johnson, Konstantin Zudov, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX module Web.HackerNews.User where -import Control.Applicative ((<*>), (<$>)) -import Control.Monad (MonadPlus (mzero)) -import Data.Aeson (FromJSON (parseJSON), Value (Object), - (.:), (.:?), (.!=)) -import Data.Text (Text) -import Data.Time (UTCTime) +import Control.Applicative ((<$>), (<*>)) +import Control.Monad (MonadPlus (mzero)) +import Data.Aeson (FromJSON (parseJSON), Value (Object), + (.!=), (.:), (.:?)) +import Data.Monoid ((<>)) +import Data.Text (Text) +import Data.Time (UTCTime) -import Web.HackerNews.Util (fromSeconds, monoidToMaybe) +import Web.HackerNews.Endpoint (Endpoint (endpoint)) +import Web.HackerNews.Util (fromSeconds, monoidToMaybe) ------------------------------------------------------------------------------ --- | Types +-- | `User` Object data User = User { userAbout :: Maybe Text , userCreated :: UTCTime @@ -20,13 +29,21 @@ , userKarma :: Int , userSubmitted :: [Int] , userDeleted :: Bool + , userDead :: Bool } deriving (Show) +------------------------------------------------------------------------------ +-- | User ID for a `User` Object newtype UserId = UserId Text deriving (Show, Eq) ------------------------------------------------------------------------------ +-- | Endpoint instances +instance Endpoint UserId User where + endpoint (UserId id') = "user/" <> id' + +------------------------------------------------------------------------------ -- | JSON Instances instance FromJSON User where parseJSON (Object o) = @@ -37,5 +54,6 @@ <*> o .: "karma" <*> o .: "submitted" <*> o .:? "deleted" .!= False + <*> o .:? "dead" .!= False parseJSON _ = mzero diff --git a/src/Web/HackerNews/Util.hs b/src/Web/HackerNews/Util.hs --- a/src/Web/HackerNews/Util.hs +++ b/src/Web/HackerNews/Util.hs @@ -1,10 +1,16 @@ +-- | +-- Module : Web.HackerNews.Util +-- Copyright : (c) David Johnson, Konstantin Zudov, 2014 +-- Maintainer : djohnson.m@gmail.com +-- Stability : experimental +-- Portability : POSIX module Web.HackerNews.Util where -import qualified Data.Text as T -import Data.Text (Text) +import Data.Monoid (Monoid, mempty) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Time (UTCTime) import Data.Time.Clock.POSIX (posixSecondsToUTCTime) -import Data.Time (UTCTime) -import Data.Monoid (Monoid, mempty) ------------------------------------------------------------------------------ -- | Convert `Integer` to `UTCTime` @@ -16,7 +22,8 @@ toText :: Show a => a -> Text toText = T.pack . show +------------------------------------------------------------------------------ -- | Turns empty monoids into Nothing --- | @Data.Maybe.listToMaybe@ generalized for monoids +-- `listToMaybe` generalized for monoids monoidToMaybe :: (Eq a, Monoid a) => a -> Maybe a monoidToMaybe m = if m == mempty then Nothing else Just m diff --git a/tests/Test.hs b/tests/Test.hs --- a/tests/Test.hs +++ b/tests/Test.hs @@ -1,34 +1,27 @@ {-# LANGUAGE OverloadedStrings #-} module Main where -import Data.Maybe (isJust) -import Test.Hspec (it, runIO, hspec, describe) +import Data.Either (isRight) +import Test.Hspec (it, runIO, hspec, describe, shouldSatisfy) import Web.HackerNews import Control.Applicative main :: IO () main = hspec $ do describe "Hacker News API Tests" $ do - (story, comment, user, job, poll, pollOpt, topStories, maxItem, updates) <- - runIO $ hackerNews $ (,,,,,,,,) <$> - getStory (StoryId 8863) <*> - getComment (CommentId 2921983) <*> - getUser (UserId "dmjio") <*> - getJob (JobId 8437631) <*> - getPoll (PollId 126809) <*> - getPollOpt (PollOptId 160705) <*> - getTopStories <*> - getMaxItem <*> + it "Retrieves all" $ do + result <- hackerNews $ (,,,,,,,,) <$> + getStory (StoryId 8863) <*> + getComment (CommentId 2921983) <*> + getUser (UserId "dmjio") <*> + getJob (JobId 8437631) <*> + getPoll (PollId 126809) <*> + getPollOpt (PollOptId 160705) <*> + getTopStories <*> + getMaxItem <*> getUpdates - it "Retrieves a Story" $ isJust story - it "Retrieves a Comment" $ isJust comment - it "Retrieves a User" $ isJust user - it "Retrieves a Job" $ isJust job - it "Retrieves a Poll" $ isJust poll - it "Retrieves a Pollopt" $ isJust pollOpt - it "Retrieves Top Stories" $ isJust topStories - it "Retrieves Max Item" $ isJust maxItem - it "Retrieves Updates" $ isJust updates + result `shouldSatisfy` isRight +