diff --git a/hackernews.cabal b/hackernews.cabal --- a/hackernews.cabal +++ b/hackernews.cabal @@ -1,5 +1,5 @@ name: hackernews -version: 0.1.0.1 +version: 0.2.0.1 description: API for news.ycombinator.com license: MIT synopsis: API for Hacker News @@ -23,16 +23,17 @@ , Web.HackerNews.Story , Web.HackerNews.Util hs-source-dirs: src - build-depends: HsOpenSSL >= 0.10.5 - , aeson - , attoparsec >= 0.12.1.2 - , base >=4.7 && <4.8 - , bytestring >= 0.10.4.0 + 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 , hspec >= 1.11.4 - , http-streams - , io-streams >= 1.1.4.6 - , text >= 1.2.0.0 - , time >= 1.4.2 + , http-streams >= 0.7.2.2 + , io-streams >= 1.1.4.6 + , text >= 1.2.0.0 + , time >= 1.4.2 + , transformers >= 0.3.0.0 default-language: Haskell2010 Test-Suite tests @@ -43,6 +44,7 @@ , hackernews , hspec , hspec >= 1.11.4 + , transformers default-language: Haskell2010 ghc-options: -Wall diff --git a/src/Web/HackerNews.hs b/src/Web/HackerNews.hs --- a/src/Web/HackerNews.hs +++ b/src/Web/HackerNews.hs @@ -1,7 +1,9 @@ {-# LANGUAGE OverloadedStrings #-} module Web.HackerNews - ( -- * API Calls - getStory + ( -- * Hacker News Monad + hackerNews + -- * API Calls + , getStory , getComment , getPoll , getPollOpt @@ -9,7 +11,8 @@ , getTopStories , getMaxItem , getUpdates - -- * Types + -- * Types + , HackerNews , Comment (..) , CommentId (..) , Poll (..) @@ -29,45 +32,45 @@ import Web.HackerNews.Types import Web.HackerNews.Util (toText) -import Web.HackerNews.Client (getItem) +import Web.HackerNews.Client ------------------------------------------------------------------------------ -- | Retrieve a `Story` by `StoryId` -getStory :: StoryId -> IO (Maybe Story) -getStory (StoryId storyid) = getItem $ "item/" <> toText storyid +getStory :: StoryId -> HackerNews (Maybe Story) +getStory (StoryId storyid) = buildHNRequest $ "item/" <> toText storyid ------------------------------------------------------------------------------ -- | Retrieve a `Comment` by `CommentId` -getComment :: CommentId -> IO (Maybe Comment) -getComment (CommentId commentid) = getItem $ "item/" <> toText commentid +getComment :: CommentId -> HackerNews (Maybe Comment) +getComment (CommentId commentid) = buildHNRequest $ "item/" <> toText commentid ------------------------------------------------------------------------------ -- | Retrieve a `Poll` by `PollId` -getPoll :: PollId -> IO (Maybe Poll) -getPoll (PollId pollid) = getItem $ "item/" <> toText pollid +getPoll :: PollId -> HackerNews (Maybe Poll) +getPoll (PollId pollid) = buildHNRequest $ "item/" <> toText pollid ------------------------------------------------------------------------------ -- | Retrieve a `PollOpt` by `PollOptId` -getPollOpt :: PollOptId -> IO (Maybe PollOpt) -getPollOpt (PollOptId polloptid) = getItem $ "item/" <> toText polloptid +getPollOpt :: PollOptId -> HackerNews (Maybe PollOpt) +getPollOpt (PollOptId polloptid) = buildHNRequest $ "item/" <> toText polloptid ------------------------------------------------------------------------------ -- | Retrieve a `User` by `UserId` -getUser :: UserId -> IO (Maybe User) -getUser (UserId userid) = getItem $ "user/" <> userid +getUser :: UserId -> HackerNews (Maybe User) +getUser (UserId userid) = buildHNRequest $ "user/" <> userid ------------------------------------------------------------------------------ -- | Retrieve the Top Stories on Hacker News -getTopStories :: IO (Maybe TopStories) -getTopStories = getItem "topstories" +getTopStories :: HackerNews (Maybe TopStories) +getTopStories = buildHNRequest "topstories" ------------------------------------------------------------------------------ -- | Retrieve the largest ItemId -getMaxItem :: IO (Maybe MaxItem) -getMaxItem = getItem "maxitem" +getMaxItem :: HackerNews (Maybe MaxItem) +getMaxItem = buildHNRequest "maxitem" ------------------------------------------------------------------------------ -- | Retrieve the latest updates -getUpdates :: IO (Maybe Update) -getUpdates = getItem "updates" +getUpdates :: HackerNews (Maybe Update) +getUpdates = buildHNRequest "updates" 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,11 +1,18 @@ +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} -module Web.HackerNews.Client ( getItem ) where +module Web.HackerNews.Client + ( hackerNews + , buildHNRequest + , HackerNews + ) where import Data.Aeson hiding (Result) import Data.Aeson.Parser (value) import Data.Attoparsec.ByteString (parseOnly) import Data.Either (rights) +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Trans.Reader (ReaderT, ask, runReaderT) import Data.Monoid ((<>)) import Data.Text (Text) import qualified Data.Text.Encoding as T @@ -14,28 +21,40 @@ import qualified System.IO.Streams as Streams ------------------------------------------------------------------------------ +-- | Core Type +type HackerNews a = ReaderT Connection IO a + +------------------------------------------------------------------------------ -- | HackerNews API request method -getItem - :: FromJSON a - => Text - -> IO (Maybe a) -getItem url = withOpenSSL $ do - ctx <- baselineContextSSL - con <- openConnectionSSL ctx "hacker-news.firebaseio.com" 443 - req <- buildRequest $ do - http GET $ "/v0/" <> T.encodeUtf8 url <> ".json" - setAccept "application/json" - sendRequest con req emptyBody - bytes <- receiveResponse con $ const $ Streams.read - closeConnection con - 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 +hackerNews :: (Show a, FromJSON a) => HackerNews a -> IO a +hackerNews requests = + withOpenSSL $ do + ctx <- baselineContextSSL + con <- openConnectionSSL ctx "hacker-news.firebaseio.com" 443 + result <- flip runReaderT con requests + closeConnection con + return result + +------------------------------------------------------------------------------ +-- | Request Builder for API +buildHNRequest :: FromJSON a => Text -> HackerNews (Maybe a) +buildHNRequest url = do + con <- ask + 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 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 @@ -27,6 +27,9 @@ = StoryId Int deriving (Show, Eq) +type TopStories = [Int] +type MaxItem = Int + ------------------------------------------------------------------------------ -- | JSON Instances instance FromJSON Story where 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 @@ -6,8 +6,6 @@ , PollId (..) , PollOptId (..) , UserId (..) - , MaxItem - , TopStories ) where import Web.HackerNews.Comment as H @@ -16,8 +14,7 @@ import Web.HackerNews.User as H import Web.HackerNews.Update as H -type MaxItem = Int -type TopStories = [Int] + diff --git a/tests/Test.hs b/tests/Test.hs --- a/tests/Test.hs +++ b/tests/Test.hs @@ -1,28 +1,32 @@ +{-# LANGUAGE OverloadedStrings #-} module Main where import Data.Maybe (isJust) import Test.Hspec (it, runIO, hspec, describe) import Web.HackerNews +import Control.Applicative main :: IO () main = hspec $ do describe "Hacker News API Tests" $ do - story <- runIO $ getStory (StoryId 8863) - it "Retrieves a Story" $ isJust story - comment <- runIO $ getComment (CommentId 2921983) - it "Retrieves a Comment" $ isJust comment - user <- runIO $ getUser (UserId "dmjio") - it "Retrieves a User" $ isJust user - poll <- runIO $ getPoll (PollId 126809) - it "Retrieves a Poll" $ isJust poll - pollOpt <- runIO $ getPollOpt (PollOptId 160705) - it "Retrieves a Pollopt" $ isJust pollOpt - topStories <- runIO getTopStories + (story, comment, user, poll, pollOpt, topStories, maxItem, updates) <- + runIO $ hackerNews $ (,,,,,,,) <$> + getStory (StoryId 8863) <*> + getComment (CommentId 2921983) <*> + getUser (UserId "dmjio") <*> + 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 Poll" $ isJust poll + it "Retrieves a Pollopt" $ isJust pollOpt it "Retrieves Top Stories" $ isJust topStories - maxItem <- runIO getMaxItem - it "Retrieves Max Item" $ isJust maxItem - updates <- runIO getUpdates - it "Retrieves Updates" $ isJust updates + it "Retrieves Max Item" $ isJust maxItem + it "Retrieves Updates" $ isJust updates