diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -52,6 +52,7 @@ main :: IO () main = do + mgr <- newManager tlsManagerSettings print =<< getItem mgr (ItemId 1000) print =<< getUser mgr (UserId "dmjio") print =<< getMaxItem mgr diff --git a/ghc-src/Web/HackerNews.hs b/ghc-src/Web/HackerNews.hs --- a/ghc-src/Web/HackerNews.hs +++ b/ghc-src/Web/HackerNews.hs @@ -71,7 +71,6 @@ , HackerNewsError (..) ) where -import Control.Monad.Trans.Except import Data.Bifunctor import Data.Monoid import Data.Proxy @@ -131,76 +130,99 @@ go (ConnectionError ex) = HNConnectionError $ cs (show ex) +mkClientEnv :: Manager -> ClientEnv +mkClientEnv = flip ClientEnv hackerNewsURL + -- | Retrieve `Item` getItem :: Manager -> ItemId -> IO (Either HackerNewsError Item) getItem mgr itemId = toError <$> do - runExceptT $ getItem' itemId mgr hackerNewsURL + runClientM + (getItem' itemId) + (mkClientEnv mgr) -- | Retrieve `User` getUser :: Manager -> UserId -> IO (Either HackerNewsError User) getUser mgr userId = toError <$> do - runExceptT $ getUser' userId mgr hackerNewsURL + runClientM + (getUser' userId) + (ClientEnv mgr hackerNewsURL) -- | Retrieve `MaxItem` getMaxItem :: Manager -> IO (Either HackerNewsError MaxItem) getMaxItem mgr = toError <$> do - runExceptT $ getMaxItem' mgr hackerNewsURL + runClientM + getMaxItem' + (ClientEnv mgr hackerNewsURL) -- | Retrieve `TopStories` getTopStories :: Manager -> IO (Either HackerNewsError TopStories) getTopStories mgr = toError <$> do - runExceptT $ getTopStories' mgr hackerNewsURL + runClientM + getTopStories' + (mkClientEnv mgr) -- | Retrieve `NewStories` getNewStories :: Manager -> IO (Either HackerNewsError NewStories) getNewStories mgr = toError <$> do - runExceptT $ getNewStories' mgr hackerNewsURL + runClientM + getNewStories' + (mkClientEnv mgr) -- | Retrieve `BestStories` getBestStories :: Manager -> IO (Either HackerNewsError BestStories) getBestStories mgr = toError <$> do - runExceptT $ getBestStories' mgr hackerNewsURL + runClientM + getBestStories' + (mkClientEnv mgr) -- | Retrieve `AskStories` getAskStories :: Manager -> IO (Either HackerNewsError AskStories) getAskStories mgr = toError <$> do - runExceptT $ getAskStories' mgr hackerNewsURL + runClientM + getAskStories' + (mkClientEnv mgr) -- | Retrieve `ShowStories` getShowStories :: Manager -> IO (Either HackerNewsError ShowStories) getShowStories mgr = toError <$> do - runExceptT $ getShowStories' mgr hackerNewsURL + runClientM + getShowStories' + (mkClientEnv mgr) -- | Retrieve `JobStories` getJobStories :: Manager -> IO (Either HackerNewsError JobStories) getJobStories mgr = toError <$> do - runExceptT $ getJobStories' mgr hackerNewsURL + runClientM + getJobStories' + (mkClientEnv mgr) -- | Retrieve `Updates` getUpdates :: Manager -> IO (Either HackerNewsError Updates) getUpdates mgr = toError <$> do - runExceptT $ getUpdates' mgr hackerNewsURL + runClientM + getUpdates' + (mkClientEnv mgr) -getItem' :: ItemId -> Manager -> BaseUrl -> ClientM Item -getUser' :: UserId -> Manager -> BaseUrl -> ClientM User -getMaxItem' :: Manager -> BaseUrl -> ClientM MaxItem -getTopStories' :: Manager -> BaseUrl -> ClientM TopStories -getNewStories' :: Manager -> BaseUrl -> ClientM NewStories -getBestStories' :: Manager -> BaseUrl -> ClientM BestStories -getAskStories' :: Manager -> BaseUrl -> ClientM AskStories -getShowStories' :: Manager -> BaseUrl -> ClientM ShowStories -getJobStories' :: Manager -> BaseUrl -> ClientM JobStories -getUpdates' :: Manager -> BaseUrl -> ClientM Updates +getItem' :: ItemId -> ClientM Item +getUser' :: UserId -> ClientM User +getMaxItem' :: ClientM MaxItem +getTopStories' :: ClientM TopStories +getNewStories' :: ClientM NewStories +getBestStories' :: ClientM BestStories +getAskStories' :: ClientM AskStories +getShowStories' :: ClientM ShowStories +getJobStories' :: ClientM JobStories +getUpdates' :: ClientM Updates getItem' :<|> getUser' diff --git a/ghc-tests/Test.hs b/ghc-tests/Test.hs --- a/ghc-tests/Test.hs +++ b/ghc-tests/Test.hs @@ -3,67 +3,14 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Main where -import Control.Applicative import Data.Aeson import Data.Either (isRight) -import Generics.SOP.Arbitrary -import Generics.SOP.Universe import Network.HTTP.Client import Network.HTTP.Client.TLS import Test.Hspec (it, hspec, describe, shouldSatisfy, shouldBe) import Test.QuickCheck import Test.QuickCheck.Instances () import Web.HackerNews - -instance Generic Item -instance Generic Updates -instance Generic User -instance Generic UserName -instance Generic UserId -instance Generic Delay -instance Generic Created -instance Generic Karma -instance Generic About -instance Generic Submitted - -instance Arbitrary Item where arbitrary = garbitrary -instance Arbitrary User where arbitrary = garbitrary -instance Arbitrary Updates where arbitrary = garbitrary - -instance Arbitrary UserName where arbitrary = garbitrary -instance Arbitrary UserId where arbitrary = garbitrary -instance Arbitrary Delay where arbitrary = garbitrary -instance Arbitrary Created where arbitrary = garbitrary -instance Arbitrary Karma where arbitrary = garbitrary -instance Arbitrary About where arbitrary = garbitrary -instance Arbitrary Submitted where arbitrary = garbitrary - -instance Arbitrary ItemId where arbitrary = garbitrary -instance Generic ItemId -instance Arbitrary Deleted where arbitrary = garbitrary -instance Generic Deleted -instance Arbitrary ItemType where arbitrary = garbitrary -instance Generic ItemType where -instance Arbitrary Time where arbitrary = garbitrary -instance Generic Time -instance Arbitrary ItemText where arbitrary = garbitrary -instance Generic ItemText -instance Arbitrary Dead where arbitrary = garbitrary -instance Generic Dead -instance Arbitrary Parent where arbitrary = garbitrary -instance Generic Parent -instance Arbitrary Kids where arbitrary = garbitrary -instance Generic Kids -instance Arbitrary URL where arbitrary = garbitrary -instance Generic URL -instance Arbitrary Score where arbitrary = garbitrary -instance Generic Score -instance Arbitrary Title where arbitrary = garbitrary -instance Generic Title -instance Arbitrary Parts where arbitrary = garbitrary -instance Generic Parts -instance Arbitrary Descendants where arbitrary = garbitrary -instance Generic Descendants main :: IO () main = do diff --git a/ghcjs-tests/Test.hs b/ghcjs-tests/Test.hs --- a/ghcjs-tests/Test.hs +++ b/ghcjs-tests/Test.hs @@ -8,66 +8,13 @@ import Data.Aeson import Data.Either (isRight) import Data.JSString -import Generics.SOP.Arbitrary -import Generics.SOP.Universe import System.Exit import Test.Hspec (it, hspec, describe, shouldSatisfy, shouldBe) import Test.Hspec.Core.Runner (hspecResult, Summary(..)) import Test.QuickCheck -import Test.QuickCheck.Instances () import Web.HackerNews.Types import Web.HackerNews - -instance Generic Item -instance Generic Updates -instance Generic User -instance Generic UserName -instance Generic UserId -instance Generic Delay -instance Generic Created -instance Generic Karma -instance Generic About -instance Generic Submitted - -instance Arbitrary Item where arbitrary = garbitrary -instance Arbitrary User where arbitrary = garbitrary -instance Arbitrary Updates where arbitrary = garbitrary - -instance Arbitrary UserName where arbitrary = garbitrary -instance Arbitrary UserId where arbitrary = garbitrary -instance Arbitrary Delay where arbitrary = garbitrary -instance Arbitrary Created where arbitrary = garbitrary -instance Arbitrary Karma where arbitrary = garbitrary -instance Arbitrary About where arbitrary = garbitrary -instance Arbitrary Submitted where arbitrary = garbitrary - -instance Arbitrary ItemId where arbitrary = garbitrary -instance Generic ItemId -instance Arbitrary Deleted where arbitrary = garbitrary -instance Generic Deleted -instance Arbitrary ItemType where arbitrary = garbitrary -instance Generic ItemType where -instance Arbitrary Time where arbitrary = garbitrary -instance Generic Time -instance Arbitrary ItemText where arbitrary = garbitrary -instance Generic ItemText -instance Arbitrary Dead where arbitrary = garbitrary -instance Generic Dead -instance Arbitrary Parent where arbitrary = garbitrary -instance Generic Parent -instance Arbitrary Kids where arbitrary = garbitrary -instance Generic Kids -instance Arbitrary URL where arbitrary = garbitrary -instance Generic URL -instance Arbitrary Score where arbitrary = garbitrary -instance Generic Score -instance Arbitrary Title where arbitrary = garbitrary -instance Generic Title -instance Arbitrary Parts where arbitrary = garbitrary -instance Generic Parts -instance Arbitrary Descendants where arbitrary = garbitrary -instance Generic Descendants main :: IO () main = do diff --git a/hackernews.cabal b/hackernews.cabal --- a/hackernews.cabal +++ b/hackernews.cabal @@ -1,5 +1,5 @@ name: hackernews -version: 1.0.0.0 +version: 1.1.0.0 description: API for news.ycombinator.com license: MIT synopsis: API for Hacker News @@ -23,13 +23,13 @@ if impl (ghcjs) build-depends: base - , hackernews == 1.0.* + , hackernews == 1.1.* , ghcjs-base hs-source-dirs: ghcjs-examples else build-depends: base - , hackernews == 1.0.* + , hackernews == 1.1.* , http-client-tls , http-client hs-source-dirs: ghc-examples @@ -39,15 +39,13 @@ if impl(ghcjs) hs-source-dirs: ghcjs-tests build-depends: base - , hackernews == 1.0.* + , hackernews == 1.1.* , ghcjs-base , hspec , hspec-core - , basic-sop - , generics-sop , quickcheck-instances , aeson - , QuickCheck + , QuickCheck else buildable: False default-language: Haskell2010 @@ -56,47 +54,47 @@ exposed-modules: Web.HackerNews , Web.HackerNews.Types hs-source-dirs: src - build-depends: servant == 0.8.* + build-depends: + servant == 0.9.* + , QuickCheck + , quickcheck-instances if impl(ghcjs) ghcjs-options: -Wall hs-source-dirs: ghcjs-src - build-depends: aeson == 0.9.* + build-depends: aeson , attoparsec == 0.13.* , base < 5 , ghcjs-base , string-conversions == 0.4.* , text == 1.2.* - , transformers == 0.4.* else ghc-options: -Wall hs-source-dirs: ghc-src build-depends: aeson , base < 5 - , servant-client == 0.8.* - , http-client == 0.4.* + , servant-client == 0.9.* + , http-client == 0.5.* , string-conversions == 0.4.* , http-types == 0.9.* , text == 1.2.* - , transformers == 0.5.* default-language: Haskell2010 Test-Suite ghc-tests type: exitcode-stdio-1.0 + if impl(ghcjs) + buildable: False default-language: Haskell2010 main-is: Test.hs ghc-options: -rtsopts -threaded -Wall hs-source-dirs: ghc-tests build-depends: aeson , base - , basic-sop - , generics-sop == 0.2.* - , hackernews == 1.0.* - , hspec == 2.2.* - , http-client-tls == 0.2.* + , hackernews == 1.1.* + , hspec == 2.3.* + , http-client-tls , http-client - , QuickCheck == 2.8.* - , quickcheck-instances == 0.3.* - , transformers + , QuickCheck + , quickcheck-instances source-repository head type: git 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 @@ -20,9 +20,12 @@ import GHC.Generics import Servant.API +import Test.QuickCheck +import Test.QuickCheck.Instances () + -- | The item and profile changes are at data Updates = Updates { - items :: [Int] + items :: [ItemId] -- ^ Updated `Item`s , profiles :: [UserName] -- ^ Updated `UserName`s @@ -31,34 +34,37 @@ instance ToJSON Updates instance FromJSON Updates +instance Arbitrary Updates where + arbitrary = Updates <$> arbitrary <*> arbitrary + -- | The current largest item id is at . -- You can walk backward from here to discover all items. -newtype MaxItem = MaxItem Int - deriving (Show, Eq, ToJSON, FromJSON, Generic) +newtype MaxItem = MaxItem ItemId + deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary) -- | -newtype TopStories = TopStories [Int] - deriving (Show, Eq, ToJSON, FromJSON, Generic) +newtype TopStories = TopStories [ItemId] + deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary) -- | -newtype NewStories = NewStories [Int] - deriving (Show, Eq, ToJSON, FromJSON, Generic) +newtype NewStories = NewStories [ItemId] + deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary) -- | -newtype BestStories = BestStories [Int] - deriving (Show, Eq, ToJSON, FromJSON, Generic) +newtype BestStories = BestStories [ItemId] + deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary) -- | -newtype AskStories = AskStories [Int] - deriving (Show, Eq, ToJSON, FromJSON, Generic) +newtype AskStories = AskStories [ItemId] + deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary) -- | -newtype ShowStories = ShowStories [Int] - deriving (Show, Eq, ToJSON, FromJSON, Generic) +newtype ShowStories = ShowStories [ItemId] + deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary) -- | -newtype JobStories = JobStories [Int] - deriving (Show, Eq, ToJSON, FromJSON, Generic) +newtype JobStories = JobStories [ItemId] + deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary) -- | Users are identified by case-sensitive ids, and live under -- . @@ -79,6 +85,11 @@ -- ^ List of the user's stories, polls and comments. } deriving (Show, Eq, Generic) +instance Arbitrary User where + arbitrary = + User <$> arbitrary <*> arbitrary <*> arbitrary + <*> arbitrary <*> arbitrary <*> arbitrary + instance ToJSON User where toJSON = genericToJSON defaultOptions { fieldLabelModifier = map toLower . drop 4 @@ -91,40 +102,43 @@ -- | The user's karma. newtype Karma = Karma Int - deriving (Show, Eq, ToJSON, FromJSON, Generic) + deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary) -- | The user's unique username. Case-sensitive. Required. newtype UserId = UserId T.Text - deriving (Show, Eq, ToJSON, FromJSON, ToHttpApiData, Generic) + deriving (Show, Eq, ToJSON, FromJSON, ToHttpApiData, Generic, Arbitrary) -- | Delay in minutes between a comment's creation and its visibility to other users. newtype Delay = Delay Int - deriving (Show, Eq, ToJSON, FromJSON, Generic) + deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary) -- | Creation date of the user, in Unix Time. newtype Created = Created Int - deriving (Show, Eq, ToJSON, FromJSON, Generic) + deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary) -- | The user's optional self-description. HTML. newtype About = About T.Text - deriving (Show, Eq, ToJSON, FromJSON, Generic) + deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary) -- | List of the user's stories, polls and comments. -newtype Submitted = Submitted [Int] - deriving (Show, Eq, ToJSON, FromJSON, Generic) +newtype Submitted = Submitted [ItemId] + deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary) -- | The item's unique id. newtype ItemId = ItemId Int - deriving (Show, Eq, ToJSON, FromJSON, ToHttpApiData, Generic) + deriving (Show, Eq, ToJSON, FromJSON, ToHttpApiData, Generic, Arbitrary) -- | `true` if the item is deleted. -newtype Deleted = Deleted Int - deriving (Show, Eq, ToJSON, FromJSON, Generic) +newtype Deleted = Deleted Bool + deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary) -- | The type of item. One of "job", "story", "comment", "poll", or "pollopt" data ItemType = Job | Story | Comment | Poll | PollOpt - deriving (Show, Eq, Generic) + deriving (Show, Eq, Generic, Enum) +instance Arbitrary ItemType where + arbitrary = elements [ Job .. ] + instance ToJSON ItemType where toJSON = genericToJSON defaultOptions { constructorTagModifier = map toLower } @@ -135,48 +149,48 @@ -- | The username of the item's author. newtype UserName = UserName T.Text - deriving (Show, Eq, ToJSON, FromJSON, Generic) + deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary) -- | The comment, story or poll text. HTML. newtype ItemText = ItemText T.Text - deriving (Show, Eq, ToJSON, FromJSON, Generic) + deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary) -- | `true` if the item is dead. newtype Dead = Dead Bool - deriving (Show, Eq, ToJSON, FromJSON, Generic) + deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary) -- | The item's parent. For comments, either another comment or the relevant story. -- For pollopts, the relevant poll. -newtype Parent = Parent Int - deriving (Show, Eq, ToJSON, FromJSON, Generic) +newtype Parent = Parent ItemId + deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary) -- | Creation date of the item, in Unix Time. newtype Time = Time Integer - deriving (Show, Eq, ToJSON, FromJSON, Generic) + deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary) -- | The ids of the item's comments, in ranked display order. -newtype Kids = Kids [Int] - deriving (Show, Eq, ToJSON, FromJSON, Generic) +newtype Kids = Kids [ItemId] + deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary) -- | The URL of the story. newtype URL = URL T.Text - deriving (Show, Eq, ToJSON, FromJSON, Generic) + deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary) -- | The story's score, or the votes for a pollopt. newtype Score = Score Int - deriving (Show, Eq, ToJSON, FromJSON, Generic) + deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary) -- | The title of the story, poll or job. newtype Title = Title T.Text - deriving (Show, Eq, ToJSON, FromJSON, Generic) + deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary) -- | A list of related pollopts, in display order. -newtype Parts = Parts [Int] - deriving (Show, Eq, ToJSON, FromJSON, Generic) +newtype Parts = Parts [ItemId] + deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary) -- | In the case of stories or polls, the total comment count. newtype Descendants = Descendants Int - deriving (Show, Eq, ToJSON, FromJSON, Generic) + deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary) -- | Stories, comments, jobs, Ask HNs and even polls are just items. -- They're identified by their ids, which are unique integers, and live under @@ -197,6 +211,13 @@ , itemParts :: Maybe Parts , itemDescendants :: Maybe Descendants } deriving (Show, Eq, Generic) + +instance Arbitrary Item where + arbitrary = Item <$> arbitrary <*> arbitrary <*> arbitrary + <*> arbitrary <*> arbitrary <*> arbitrary + <*> arbitrary <*> arbitrary <*> arbitrary + <*> arbitrary <*> arbitrary <*> arbitrary + <*> arbitrary <*> arbitrary instance ToJSON Item where toJSON = genericToJSON