├── stack.yaml
├── Setup.lhs
├── ghcjs-examples
    └── Example.hs
├── .gitignore
├── shell.nix
├── default.nix
├── stack-ghcjs.yaml
├── extras
    ├── hspec-expectations-0.8.2.nix
    ├── hspec-discover-2.3.2.nix
    ├── hspec-2.3.2.nix
    ├── http-client-tls-0.3.3.nix
    ├── hspec-core-2.3.2.nix
    ├── http-api-data-0.3.1.nix
    ├── servant-0.9.0.1.nix
    └── servant-client-0.9.0.1.nix
├── ghc-examples
    └── Example.hs
├── jsbits
    └── options.js
├── .travis.yml
├── LICENSE
├── hackernews.nix
├── ghc-tests
    └── Test.hs
├── ghcjs-tests
    └── Test.hs
├── hackernews.cabal
├── README.md
├── ghcjs-src
    └── Web
    │   └── HackerNews.hs
├── ghc-src
    └── Web
    │   └── HackerNews.hs
└── src
    └── Web
        └── HackerNews
            └── Types.hs


/stack.yaml:
--------------------------------------------------------------------------------
1 | resolver: lts-7.3
2 | 


--------------------------------------------------------------------------------
/Setup.lhs:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env runhaskell
2 | > import Distribution.Simple
3 | > main = defaultMain
4 | 


--------------------------------------------------------------------------------
/ghcjs-examples/Example.hs:
--------------------------------------------------------------------------------
1 | module Main where
2 | 
3 | main :: IO ()
4 | main = putStrLn "hi"
5 | 


--------------------------------------------------------------------------------
/.gitignore:
--------------------------------------------------------------------------------
1 | .cabal-sandbox
2 | .stack-work
3 | cabal.sandbox.config
4 | dist
5 | result
6 | result-2
7 | *~
8 | 


--------------------------------------------------------------------------------
/shell.nix:
--------------------------------------------------------------------------------
1 | { nixpkgs ? import <nixpkgs> {}, compiler ? "ghc802" }:
2 |   (import ./default.nix { inherit nixpkgs compiler; }).env
3 | 


--------------------------------------------------------------------------------
/default.nix:
--------------------------------------------------------------------------------
 1 | { compiler ? "ghc802" }:
 2 | let
 3 |   config = { allowBroken = true; };
 4 |   pkgs = import <nixpkgs> { inherit config; };
 5 | in with pkgs.haskell.lib;
 6 | rec {
 7 |    hackernews = dontCheck (pkgs.haskell.packages.${compiler}.callPackage ./hackernews.nix { inherit compiler pkgs; });
 8 |    release = sdistTarball hackernews;
 9 | }
10 | 


--------------------------------------------------------------------------------
/stack-ghcjs.yaml:
--------------------------------------------------------------------------------
 1 | resolver: lts-7.2
 2 | compiler: ghcjs-0.2.1.9007002_ghc-8.0.1
 3 | compiler-check: match-exact
 4 | 
 5 | setup-info:
 6 |   ghcjs:
 7 |     source:
 8 |       ghcjs-0.2.1.9007002_ghc-8.0.1:
 9 |           url: http://ghcjs.tolysz.org/ghc-8.0-2016-10-01-lts-7.2-9007002.tar.gz
10 |           sha1: a41ae415328e2b257d40724d13d1386390c26322
11 | 


--------------------------------------------------------------------------------
/extras/hspec-expectations-0.8.2.nix:
--------------------------------------------------------------------------------
 1 | { mkDerivation, base, call-stack, HUnit, nanospec, stdenv }:
 2 | mkDerivation {
 3 |   pname = "hspec-expectations";
 4 |   version = "0.8.2";
 5 |   sha256 = "1vxl9zazbaapijr6zmcj72j9wf7ka1pirrjbwddwwddg3zm0g5l1";
 6 |   libraryHaskellDepends = [ base call-stack HUnit ];
 7 |   testHaskellDepends = [ base call-stack HUnit nanospec ];
 8 |   doCheck = false;
 9 |   homepage = "https://github.com/hspec/hspec-expectations#readme";
10 |   description = "Catchy combinators for HUnit";
11 |   license = stdenv.lib.licenses.mit;
12 | }
13 | 


--------------------------------------------------------------------------------
/ghc-examples/Example.hs:
--------------------------------------------------------------------------------
 1 | {-# LANGUAGE OverloadedStrings #-}
 2 | module Main where
 3 | 
 4 | import Network.HTTP.Client
 5 | import Network.HTTP.Client.TLS
 6 | 
 7 | import Web.HackerNews
 8 | 
 9 | main :: IO ()
10 | main = do
11 |  mgr <- newManager tlsManagerSettings
12 |  print =<< getItem mgr (ItemId 1000)
13 |  print =<< getUser mgr (UserId "dmjio")
14 |  print =<< getMaxItem mgr
15 |  print =<< getTopStories mgr
16 |  print =<< getNewStories mgr
17 |  print =<< getBestStories mgr
18 |  print =<< getAskStories mgr
19 |  print =<< getShowStories mgr
20 |  print =<< getJobStories mgr
21 |  print =<< getUpdates mgr
22 | 


--------------------------------------------------------------------------------
/extras/hspec-discover-2.3.2.nix:
--------------------------------------------------------------------------------
 1 | { mkDerivation, base, directory, filepath, hspec-meta, stdenv }:
 2 | mkDerivation {
 3 |   pname = "hspec-discover";
 4 |   version = "2.3.2";
 5 |   sha256 = "0pz3izwdicvg2p5ahqjd5msxv4x5iwa2y30y0jwhnza13nwwjdpx";
 6 |   isLibrary = true;
 7 |   isExecutable = true;
 8 |   libraryHaskellDepends = [ base directory filepath ];
 9 |   executableHaskellDepends = [ base directory filepath ];
10 |   testHaskellDepends = [ base directory filepath hspec-meta ];
11 |   doCheck = false;
12 |   homepage = "http://hspec.github.io/";
13 |   description = "Automatically discover and run Hspec tests";
14 |   license = stdenv.lib.licenses.mit;
15 | }
16 | 


--------------------------------------------------------------------------------
/jsbits/options.js:
--------------------------------------------------------------------------------
 1 | "use strict";
 2 | var system = require('system');
 3 | if (system.args.length !== 2) {
 4 |     console.log('Usage: phantomjsOpen.js URL');
 5 |     phantom.exit(1);
 6 | }
 7 | 
 8 | var page = require('webpage').create();
 9 | 
10 | page.onError = function (msg, trace) {
11 |   if (msg.match("error").length > 0) {
12 |     phantom.exit(1);
13 |   }
14 | };
15 | 
16 | page.open(system.args[1], function (status) {
17 |     page.onConsoleMessage = function (msg) {
18 | 	if (msg.match("done")) {
19 | 	    phantom.exit(0);
20 | 	} else if (msg.match("error")) {
21 | 	    phantom.exit(1);
22 | 	} else {
23 | 	    console.log(msg);
24 | 	}
25 |     };
26 |     if (status !== "success") {
27 |         console.log("Unable to open " + system.args[1]);
28 |         phantom.exit(1);
29 |     }
30 | });
31 | 


--------------------------------------------------------------------------------
/.travis.yml:
--------------------------------------------------------------------------------
 1 | language: nix
 2 | 
 3 | matrix:
 4 |   fast_finish: true
 5 |   include:
 6 |     - env: GHCVER=ghcjsHEAD
 7 |     - env: GHCVER=ghcHEAD
 8 |     - env: GHCVER=ghc802
 9 |     - env: GHCVER=ghc801
10 |     - env: GHCVER=ghc7103
11 |     - env: GHCVER=ghc7102
12 |     - env: GHCVER=ghc784
13 |     - env: GHCVER=ghc783
14 |     - env: GHCVER=ghc763
15 |   allow_failures:
16 |     - env: GHCVER=ghcjs
17 |     - env: GHCVER=ghcjsHEAD
18 |     - env: GHCVER=ghcHEAD
19 |     - env: GHCVER=ghc801
20 |     - env: GHCVER=ghc7103
21 |     - env: GHCVER=ghc7102
22 |     - env: GHCVER=ghc784
23 |     - env: GHCVER=ghc783
24 |     - env: GHCVER=ghc763
25 | 
26 | before_install:
27 |   - nix-channel --list
28 |   - nix-channel --update
29 | 
30 | script:
31 |   - nix-build -A hackernews --argstr compiler $GHCVER
32 |   - ./build/phantomjs.sh
33 | 


--------------------------------------------------------------------------------
/extras/hspec-2.3.2.nix:
--------------------------------------------------------------------------------
 1 | { mkDerivation, base, call-stack, directory, hspec-core
 2 | , hspec-discover, hspec-expectations, hspec-meta, HUnit, QuickCheck
 3 | , stdenv, stringbuilder, transformers
 4 | }:
 5 | mkDerivation {
 6 |   pname = "hspec";
 7 |   version = "2.3.2";
 8 |   sha256 = "1d1g0cgm56yjzq5xd186w7kz5548dyp938cs59f99k45snfgclp8";
 9 |   libraryHaskellDepends = [
10 |     base call-stack hspec-core hspec-discover hspec-expectations HUnit
11 |     QuickCheck transformers
12 |   ];
13 |   testHaskellDepends = [
14 |     base call-stack directory hspec-core hspec-discover
15 |     hspec-expectations hspec-meta HUnit QuickCheck stringbuilder
16 |     transformers
17 |   ];
18 |   doCheck = false;
19 |   homepage = "http://hspec.github.io/";
20 |   description = "A Testing Framework for Haskell";
21 |   license = stdenv.lib.licenses.mit;
22 | }
23 | 


--------------------------------------------------------------------------------
/extras/http-client-tls-0.3.3.nix:
--------------------------------------------------------------------------------
 1 | { mkDerivation, base, bytestring, case-insensitive, connection
 2 | , cryptonite, data-default-class, exceptions, hspec, http-client
 3 | , http-types, memory, network, stdenv, tls, transformers
 4 | }:
 5 | mkDerivation {
 6 |   pname = "http-client-tls";
 7 |   version = "0.3.3";
 8 |   sha256 = "0r50h7lhrwmxcmiq5nw1rxnpda3k6mhz4jsd86m56ymai5lnf77c";
 9 |   libraryHaskellDepends = [
10 |     base bytestring case-insensitive connection cryptonite
11 |     data-default-class exceptions http-client http-types memory network
12 |     tls transformers
13 |   ];
14 |   testHaskellDepends = [ base hspec http-client http-types ];
15 |   doCheck = false;
16 |   homepage = "https://github.com/snoyberg/http-client";
17 |   description = "http-client backend using the connection package and tls library";
18 |   license = stdenv.lib.licenses.mit;
19 | }
20 | 


--------------------------------------------------------------------------------
/extras/hspec-core-2.3.2.nix:
--------------------------------------------------------------------------------
 1 | { mkDerivation, ansi-terminal, async, base, call-stack, deepseq
 2 | , hspec-expectations, hspec-meta, HUnit, process, QuickCheck
 3 | , quickcheck-io, random, setenv, silently, stdenv, tf-random, time
 4 | , transformers
 5 | }:
 6 | mkDerivation {
 7 |   pname = "hspec-core";
 8 |   version = "2.3.2";
 9 |   sha256 = "1fa16mldzr4fjz8h7x1afrp8k8ngjh79wwxi6wlffkas8w3msv8w";
10 |   libraryHaskellDepends = [
11 |     ansi-terminal async base call-stack deepseq hspec-expectations
12 |     HUnit QuickCheck quickcheck-io random setenv tf-random time
13 |     transformers
14 |   ];
15 |   testHaskellDepends = [
16 |     ansi-terminal async base call-stack deepseq hspec-expectations
17 |     hspec-meta HUnit process QuickCheck quickcheck-io random setenv
18 |     silently tf-random time transformers
19 |   ];
20 |   doCheck = false;
21 |   homepage = "http://hspec.github.io/";
22 |   description = "A Testing Framework for Haskell";
23 |   license = stdenv.lib.licenses.mit;
24 | }
25 | 


--------------------------------------------------------------------------------
/extras/http-api-data-0.3.1.nix:
--------------------------------------------------------------------------------
 1 | { mkDerivation, base, bytestring, containers, directory, doctest
 2 | , filepath, hashable, hspec, HUnit, QuickCheck
 3 | , quickcheck-instances, stdenv, text, time, time-locale-compat
 4 | , unordered-containers, uri-bytestring, uuid, uuid-types
 5 | }:
 6 | mkDerivation {
 7 |   pname = "http-api-data";
 8 |   version = "0.3.1";
 9 |   sha256 = "1iwlmnv0xkqm925pjwazff86ji496b7b9wzzg21aqr70mabniaym";
10 |   libraryHaskellDepends = [
11 |     base bytestring containers hashable text time time-locale-compat
12 |     unordered-containers uri-bytestring uuid-types
13 |   ];
14 |   testHaskellDepends = [
15 |     base bytestring directory doctest filepath hspec HUnit QuickCheck
16 |     quickcheck-instances text time unordered-containers uuid
17 |   ];
18 |   doCheck = false;
19 |   homepage = "http://github.com/fizruk/http-api-data";
20 |   description = "Converting to/from HTTP API data like URL pieces, headers and query parameters";
21 |   license = stdenv.lib.licenses.bsd3;
22 | }
23 | 


--------------------------------------------------------------------------------
/extras/servant-0.9.0.1.nix:
--------------------------------------------------------------------------------
 1 | { mkDerivation, aeson, attoparsec, base, base-compat, bytestring
 2 | , case-insensitive, directory, doctest, filemanip, filepath, hspec
 3 | , http-api-data, http-media, http-types, mmorph, mtl, network-uri
 4 | , QuickCheck, quickcheck-instances, stdenv, string-conversions
 5 | , text, url, vault
 6 | }:
 7 | mkDerivation {
 8 |   pname = "servant";
 9 |   version = "0.9.0.1";
10 |   sha256 = "0km3vbbvmxk0f11g703n9p53pn78198r0czcyxps3xl4bryajzwr";
11 |   libraryHaskellDepends = [
12 |     aeson attoparsec base base-compat bytestring case-insensitive
13 |     http-api-data http-media http-types mmorph mtl network-uri
14 |     string-conversions text vault
15 |   ];
16 |   testHaskellDepends = [
17 |     aeson attoparsec base base-compat bytestring directory doctest
18 |     filemanip filepath hspec QuickCheck quickcheck-instances
19 |     string-conversions text url
20 |   ];
21 |   homepage = "http://haskell-servant.readthedocs.org/";
22 |   description = "A family of combinators for defining webservices APIs";
23 |   license = stdenv.lib.licenses.bsd3;
24 | }
25 | 


--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
 1 | The MIT License (MIT)
 2 | 
 3 | Copyright (c) 2014 David Johnson
 4 | 
 5 | Permission is hereby granted, free of charge, to any person obtaining a copy
 6 | of this software and associated documentation files (the "Software"), to deal
 7 | in the Software without restriction, including without limitation the rights
 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
 9 | copies of the Software, and to permit persons to whom the Software is
10 | furnished to do so, subject to the following conditions:
11 | 
12 | The above copyright notice and this permission notice shall be included in
13 | all copies or substantial portions of the Software.
14 | 
15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
21 | THE SOFTWARE.


--------------------------------------------------------------------------------
/extras/servant-client-0.9.0.1.nix:
--------------------------------------------------------------------------------
 1 | { mkDerivation, aeson, attoparsec, base, base64-bytestring
 2 | , bytestring, deepseq, exceptions, hspec, http-api-data
 3 | , http-client, http-client-tls, http-media, http-types, HUnit, mtl
 4 | , network, network-uri, QuickCheck, safe, servant, servant-server
 5 | , stdenv, string-conversions, text, transformers
 6 | , transformers-compat, wai, warp
 7 | }:
 8 | mkDerivation {
 9 |   pname = "servant-client";
10 |   version = "0.9.0.1";
11 |   sha256 = "1s33hmd6xjyrqv3bjjc1ymwbqx08hkap720pcbm7pxlv61a2x5ix";
12 |   libraryHaskellDepends = [
13 |     aeson attoparsec base base64-bytestring bytestring exceptions
14 |     http-api-data http-client http-client-tls http-media http-types mtl
15 |     network-uri safe servant string-conversions text transformers
16 |     transformers-compat
17 |   ];
18 |   testHaskellDepends = [
19 |     aeson base bytestring deepseq hspec http-api-data http-client
20 |     http-media http-types HUnit network QuickCheck servant
21 |     servant-server text transformers transformers-compat wai warp
22 |   ];
23 |   doCheck = false;
24 |   homepage = "http://haskell-servant.readthedocs.org/";
25 |   description = "automatical derivation of querying functions for servant webservices";
26 |   license = stdenv.lib.licenses.bsd3;
27 | }
28 | 


--------------------------------------------------------------------------------
/hackernews.nix:
--------------------------------------------------------------------------------
 1 | { mkDerivation, aeson, base, http-client, servant
 2 | , servant-client, http-client-tls, hspec-core, hspec
 3 | , stdenv, text, transformers, compiler, QuickCheck, semigroups
 4 | , quickcheck-instances, pkgs, http-types, string-conversions
 5 | }:
 6 | let
 7 |  isGhcjs = compiler == "ghcjs" || compiler == "ghcjsHEAD";
 8 |  phantomjs  = pkgs.nodePackags.phantomjs;
 9 |  ghcjs-base = pkgs.haskell.packages.ghcjs.ghcjs-base;
10 |  ghc-deps = [
11 |     aeson base http-client servant servant-client text
12 |     transformers http-client-tls http-types string-conversions
13 |     quickcheck-instances QuickCheck
14 |    ];
15 |  ghcjs-deps = [ hspec-core QuickCheck semigroups
16 |                 ghcjs-base aeson base text
17 |                 transformers hspec servant quickcheck-instances
18 |                 string-conversions ];
19 |  ghcjs-testdeps = [ phantomjs ] ++ ghcjs-deps;
20 |  ghc-testdeps   = [ base hspec http-client-tls transformers
21 |                     quickcheck-instances
22 |                   ];
23 |  testDeps =
24 |    if isGhcjs
25 |      then ghcjs-testdeps
26 |      else ghc-testdeps;
27 |  exeDeps =
28 |    if isGhcjs
29 |      then [ base ghcjs-base ]
30 |      else [ base http-client-tls http-client ];
31 |  libDeps =
32 |    if isGhcjs
33 |      then ghcjs-deps
34 |      else ghc-deps;
35 | in mkDerivation {
36 |   pname = "hackernews";
37 |   version = "1.4.0.0";
38 |   src = ./.;
39 |   isExecutable = true;
40 |   isLibrary = true;
41 |   jailbreak = isGhcjs;
42 |   libraryHaskellDepends = libDeps;
43 |   executableHaskellDepends = exeDeps;
44 |   testHaskellDepends = testDeps;
45 |   description = "API for Hacker News";
46 |   license = stdenv.lib.licenses.mit;
47 | }
48 | 


--------------------------------------------------------------------------------
/ghc-tests/Test.hs:
--------------------------------------------------------------------------------
 1 | {-# LANGUAGE OverloadedStrings    #-}
 2 | {-# LANGUAGE ScopedTypeVariables  #-}
 3 | {-# OPTIONS_GHC -fno-warn-orphans #-}
 4 | module Main where
 5 | 
 6 | import Data.Aeson
 7 | import Data.Either               (isRight)
 8 | import Network.HTTP.Client
 9 | import Network.HTTP.Client.TLS
10 | import Test.Hspec                (it, hspec, describe, shouldSatisfy, shouldBe)
11 | import Test.QuickCheck
12 | import Test.QuickCheck.Instances ()
13 | import Web.HackerNews
14 | 
15 | main :: IO ()
16 | main = do
17 |  mgr <- newManager tlsManagerSettings
18 |  hspec $ do
19 |   describe "HackerNews API tests" $ do
20 |     it "should round trip Updates JSON" $ property $ \(x :: Updates) ->
21 |        Just x == decode (encode x)
22 |     it "should round trip Item JSON" $ property $ \(x :: Item) ->
23 |        Just x == decode (encode x)
24 |     it "should round trip User JSON" $ property $ \(x :: User) ->
25 |        Just x == decode (encode x)
26 |     it "should retrieve item" $ do
27 |       (`shouldSatisfy` isRight) =<< getItem mgr (ItemId 1000)
28 |     it "should return NotFound " $ do
29 |       Left x <- getItem mgr (ItemId 0)
30 |       x `shouldBe` NotFound
31 |     it "should retrieve user" $ do
32 |       (`shouldSatisfy` isRight) =<< getUser mgr (UserId "dmjio")
33 |     it "should retrieve max item" $ do
34 |       (`shouldSatisfy` isRight) =<< getMaxItem mgr
35 |     it "should retrieve top stories" $ do
36 |       (`shouldSatisfy` isRight) =<< getTopStories mgr
37 |     it "should retrieve new stories" $ do
38 |       (`shouldSatisfy` isRight) =<< getNewStories mgr
39 |     it "should retrieve best stories" $ do
40 |       (`shouldSatisfy` isRight) =<< getBestStories mgr
41 |     it "should retrieve ask stories" $ do
42 |       (`shouldSatisfy` isRight) =<< getAskStories mgr
43 |     it "should retrieve show stories" $ do
44 |       (`shouldSatisfy` isRight) =<< getShowStories mgr
45 |     it "should retrieve job stories" $ do
46 |       (`shouldSatisfy` isRight) =<< getJobStories mgr
47 |     it "should retrieve updates" $ do
48 |       (`shouldSatisfy` isRight) =<< getUpdates mgr
49 | 
50 | 
51 | 
52 | 
53 | 
54 | 
55 | 
56 | 
57 | 
58 | 
59 | 


--------------------------------------------------------------------------------
/ghcjs-tests/Test.hs:
--------------------------------------------------------------------------------
 1 | {-# LANGUAGE OverloadedStrings    #-}
 2 | {-# LANGUAGE ScopedTypeVariables  #-}
 3 | {-# OPTIONS_GHC -fno-warn-orphans #-}
 4 | {-# LANGUAGE RecordWildCards      #-}
 5 | module Main where
 6 | 
 7 | import Control.Applicative
 8 | import Data.Aeson
 9 | import Data.Either               (isRight)
10 | import Data.JSString
11 | import System.Exit
12 | import Test.Hspec (it, hspec, describe, shouldSatisfy, shouldBe)
13 | import Test.Hspec.Core.Runner (hspecResult, Summary(..))
14 | import Test.QuickCheck
15 | 
16 | import Web.HackerNews.Types
17 | import Web.HackerNews
18 | 
19 | main :: IO ()
20 | main = do
21 |  Summary{..} <- hspecResult $ do
22 |   describe "HackerNews API tests" $ do
23 |     it "should round trip Updates JSON" $ property $ \(x :: Updates) ->
24 |        Just x == decode (encode x)
25 |     it "should round trip Item JSON" $ property $ \(x :: Item) ->
26 |        Just x == decode (encode x)
27 |     it "should round trip User JSON" $ property $ \(x :: User) ->
28 |        Just x == decode (encode x)
29 |     it "should retrieve item" $ do
30 |       (`shouldSatisfy` isRight) =<< getItem (ItemId 1000)
31 |     it "should return NotFound " $ do
32 |       Left x <- getItem (ItemId 0)
33 |       x `shouldBe` NotFound
34 |     it "should retrieve user" $ do
35 |       (`shouldSatisfy` isRight) =<< getUser (UserId "dmjio")
36 |     it "should retrieve max item" $ do
37 |       (`shouldSatisfy` isRight) =<< getMaxItem
38 |     it "should retrieve top stories" $ do
39 |       (`shouldSatisfy` isRight) =<< getTopStories
40 |     it "should retrieve new stories" $ do
41 |       (`shouldSatisfy` isRight) =<< getNewStories
42 |     it "should retrieve best stories" $ do
43 |       (`shouldSatisfy` isRight) =<< getBestStories
44 |     it "should retrieve ask stories" $ do
45 |       (`shouldSatisfy` isRight) =<< getAskStories
46 |     it "should retrieve show stories" $ do
47 |       (`shouldSatisfy` isRight) =<< getShowStories
48 |     it "should retrieve job stories" $ do
49 |       (`shouldSatisfy` isRight) =<< getJobStories
50 |     it "should retrieve updates" $ do
51 |       (`shouldSatisfy` isRight) =<< getUpdates
52 |  case summaryFailures of
53 |    x | x > 0 -> putStrLn "error"
54 |      | otherwise -> putStrLn "done"
55 | 
56 | 
57 | 
58 | 


--------------------------------------------------------------------------------
/hackernews.cabal:
--------------------------------------------------------------------------------
  1 | name:                hackernews
  2 | version:             1.4.0.0
  3 | description:         API for news.ycombinator.com
  4 | license:             MIT
  5 | synopsis:            API for Hacker News
  6 | license-file:        LICENSE
  7 | author:              David Johnson
  8 | maintainer:          code@dmj.io
  9 | category:            Web
 10 | build-type:          Simple
 11 | cabal-version:       >=1.10
 12 | extra-source-files:
 13 |     jsbits/options.js
 14 |     README.md
 15 |     LICENSE
 16 |     ghc-examples/Example.hs
 17 |     ghcjs-examples/Example.hs
 18 |     ghc-tests/Test.hs
 19 |     ghcjs-tests/Test.hs
 20 | executable hackernews-example
 21 |   main-is: Example.hs
 22 |   default-language: Haskell2010
 23 |   if impl (ghcjs)
 24 |     build-depends:
 25 |         base
 26 |       , hackernews
 27 |       , ghcjs-base
 28 |     hs-source-dirs: ghcjs-examples
 29 |   else
 30 |     build-depends:
 31 |          base
 32 |        , hackernews
 33 |        , http-client-tls
 34 |        , http-client
 35 |     hs-source-dirs: ghc-examples
 36 | 
 37 | executable ghcjs-tests
 38 |   main-is: Test.hs
 39 |   if impl(ghcjs)
 40 |     hs-source-dirs: ghcjs-tests
 41 |     build-depends: base
 42 |                , hackernews
 43 |                , ghcjs-base
 44 |                , hspec
 45 |                , hspec-core
 46 |                , quickcheck-instances
 47 |                , aeson
 48 |                , QuickCheck
 49 |   else
 50 |     buildable: False
 51 |   default-language: Haskell2010
 52 | 
 53 | library
 54 |   exposed-modules:  Web.HackerNews
 55 |                   , Web.HackerNews.Types
 56 |   hs-source-dirs: src
 57 |   build-depends:
 58 |       servant >= 0.9 && < 0.13
 59 |     , QuickCheck
 60 |     , quickcheck-instances
 61 |   if impl(ghcjs)
 62 |     ghcjs-options:  -Wall
 63 |     hs-source-dirs: ghcjs-src
 64 |     build-depends:  aeson
 65 |                   , attoparsec == 0.13.*
 66 |                   , base < 5
 67 |                   , ghcjs-base
 68 |                   , string-conversions == 0.4.*
 69 |                   , text == 1.2.*
 70 |   else
 71 |     ghc-options:  -Wall
 72 |     hs-source-dirs: ghc-src
 73 |     build-depends: aeson
 74 |                  , base < 5
 75 |                  , servant-client >= 0.9 && < 0.13
 76 |                  , http-client == 0.5.*
 77 |                  , string-conversions == 0.4.*
 78 |                  , http-types >= 0.9
 79 |                  , text == 1.2.*
 80 |   default-language:    Haskell2010
 81 | 
 82 | Test-Suite ghc-tests
 83 |   type:                exitcode-stdio-1.0
 84 |   if impl(ghcjs)
 85 |     buildable: False
 86 |   default-language:    Haskell2010
 87 |   main-is:             Test.hs
 88 |   ghc-options:         -rtsopts -threaded -Wall
 89 |   hs-source-dirs:      ghc-tests
 90 |   build-depends:       aeson
 91 |                      , base
 92 |                      , hackernews
 93 |                      , hspec
 94 |                      , http-client-tls
 95 |                      , http-client
 96 |                      , QuickCheck
 97 |                      , quickcheck-instances
 98 | 
 99 | source-repository head
100 |   type:     git
101 |   location: https://github.com/dmjio/hackernews
102 | 


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
  1 | hackernews
  2 | ==========
  3 | ![Hackage](https://img.shields.io/hackage/v/hackernews.svg)
  4 | ![Hackage Dependencies](https://img.shields.io/hackage-deps/v/hackernews.svg)
  5 | ![Haskell Programming Language](https://img.shields.io/badge/language-Haskell-blue.svg)
  6 | ![MIT License](http://img.shields.io/badge/license-MIT-brightgreen.svg)
  7 | [![Build Status](https://travis-ci.org/dmjio/hackernews.svg?branch=master)](https://travis-ci.org/dmjio/hackernews)
  8 | 
  9 | Hacker News API for Haskell
 10 | 
 11 | ### Documentation
 12 | <https://github.com/HackerNews/API>
 13 | 
 14 | Now it supports GHCJS and can be used in the browser! Just install it using:
 15 | ```bash
 16 | cabal install --ghcjs
 17 | ```
 18 | 
 19 | ### Tests
 20 | ```bash
 21 | cabal configure && cabal test
 22 | ```
 23 | 
 24 | ```bash
 25 | HackerNews API tests
 26 |   should round trip Updates JSON
 27 |   should round trip Item JSON
 28 |   should round trip User JSON
 29 |   should retrieve item
 30 |   should retrieve user
 31 |   should retrieve max item
 32 |   should retrieve top stories
 33 |   should retrieve new stories
 34 |   should retrieve best stories
 35 |   should retrieve ask stories
 36 |   should retrieve show stories
 37 |   should retrieve job stories
 38 |   should retrieve updates
 39 | 
 40 |   Finished in 1.2129 seconds
 41 |   13 examples, 0 failures
 42 | ```
 43 | 
 44 | ### Usage
 45 | ```haskell
 46 | module Main where
 47 | 
 48 | import Network.HTTP.Client
 49 | import Network.HTTP.Client.TLS
 50 | 
 51 | import Web.HackerNews
 52 | 
 53 | main :: IO ()
 54 | main = do
 55 |  mgr <- newManager tlsManagerSettings
 56 |  print =<< getItem mgr (ItemId 1000)
 57 |  print =<< getUser mgr (UserId "dmjio")
 58 |  print =<< getMaxItem mgr
 59 |  print =<< getTopStories mgr
 60 |  print =<< getNewStories mgr
 61 |  print =<< getBestStories mgr
 62 |  print =<< getAskStories mgr
 63 |  print =<< getShowStories mgr
 64 |  print =<< getJobStories mgr
 65 |  print =<< getUpdates mgr
 66 | ```
 67 | 
 68 | ```bash
 69 | Right ( Item {
 70 | 	 itemId = Just (ItemId 1000)
 71 |    , itemDeleted = Nothing
 72 |    , itemType = Story
 73 |    , itemBy = Just (UserName "python_kiss")
 74 |    , itemTime = Just (Time 1172394646)
 75 |    , itemText = Nothing
 76 |    , itemDead = Nothing
 77 |    , itemParent = Nothing
 78 |    , itemKids = Nothing
 79 |    , itemURL = Just (URL "http://www.netbusinessblog.com/2007/02/19/how-important-is-the-dot-com/")
 80 |    , itemScore = Just (Score 4)
 81 |    , itemTitle = Just (Title "How Important is the .com TLD?")
 82 |    , itemParts = Nothing
 83 |    , itemDescendants = Just (Descendants 0)
 84 |    })
 85 | Right (User {userId = UserId "dmjio"
 86 | 		   , userDelay = Nothing
 87 | 		   , userCreated = Created 1375807763
 88 | 		   , userKarma = Karma 7
 89 | 		   , userAbout = Nothing
 90 | 		   , userSubmitted = Just (Submitted [11966297,9355613, ...])
 91 | 		   })
 92 | Right (MaxItem 12695220)
 93 | Right (TopStories [12694004,12692190,12691597,...])
 94 | Right (NewStories [12695214,12695213,12695195,...])
 95 | Right (BestStories [12649414,12637126,12684980, ...])
 96 | Right (AskStories [12694706,12694401,12694038, ...])
 97 | Right (ShowStories [12694004,12692190,12695037, ...])
 98 | Right (JobStories [12693320,12691627,12690539,...])
 99 | Right (Updates { items = [12694916,12694478,12693674,..],
100 | 				 profiles = [UserName "stefano", UserName "chillydawg", ...]
101 | 			   })
102 | 
103 | ```
104 | 


--------------------------------------------------------------------------------
/ghcjs-src/Web/HackerNews.hs:
--------------------------------------------------------------------------------
  1 | {-# LANGUAGE ScopedTypeVariables #-}
  2 | {-# LANGUAGE OverloadedStrings   #-}
  3 | ------------------------------------------------------------------------------
  4 | -- |
  5 | -- Module      : Web.HackerNews
  6 | -- Copyright   : (c) David Johnson, 2014-2025
  7 | -- Maintainer  : code@dmj.io
  8 | -- Stability   : experimental
  9 | -- Portability : POSIX
 10 | --
 11 | ------------------------------------------------------------------------------
 12 | module Web.HackerNews
 13 |        ( -- * API functions
 14 |          getItem
 15 |        , getUser
 16 |        , getMaxItem
 17 |        , getTopStories
 18 |        , getNewStories
 19 |        , getBestStories
 20 |        , getAskStories
 21 |        , getShowStories
 22 |        , getJobStories
 23 |        , getUpdates
 24 |        -- * Core Types
 25 |        , Item        (..)
 26 |        , User        (..)
 27 |        , Updates     (..)
 28 |        , MaxItem     (..)
 29 |        , TopStories  (..)
 30 |        , NewStories  (..)
 31 |        , BestStories (..)
 32 |        , AskStories  (..)
 33 |        , ShowStories (..)
 34 |        , JobStories  (..)
 35 |        --- * Supporting Types
 36 |        , UserId      (..)
 37 |        , ItemId      (..)
 38 |        , Deleted     (..)
 39 |        , ItemType    (..)
 40 |        , UserName    (..)
 41 |        , Time        (..)
 42 |        , ItemText    (..)
 43 |        , Dead        (..)
 44 |        , Parent      (..)
 45 |        , Kids        (..)
 46 |        , URL         (..)
 47 |        , Score       (..)
 48 |        , Title       (..)
 49 |        , Parts       (..)
 50 |        , Descendants (..)
 51 |        , Delay       (..)
 52 |        , Created     (..)
 53 |        , Karma       (..)
 54 |        , About       (..)
 55 |        , Submitted   (..)
 56 |        ) where
 57 | 
 58 | ------------------------------------------------------------------------------
 59 | import Data.Aeson
 60 | import Data.Monoid
 61 | import JavaScript.Web.XMLHttpRequest
 62 | import Data.String.Conversions
 63 | import Data.JSString
 64 | import Data.JSString.Text
 65 | 
 66 | import Web.HackerNews.Types
 67 | 
 68 | -- | Retrieve `Item`
 69 | getItem :: ItemId -> IO (Either HackerNewsError Item)
 70 | getItem (ItemId x) = issueAjax (Just "item") $ textToJSString $ cs (show x)
 71 | 
 72 | -- | Retrieve `User`
 73 | getUser :: UserId -> IO (Either HackerNewsError User)
 74 | getUser (UserId u) = issueAjax (Just "user") (textToJSString u)
 75 | 
 76 | -- | Retrieve `MaxItem`
 77 | getMaxItem :: IO (Either HackerNewsError MaxItem)
 78 | getMaxItem = issueAjax Nothing "maxitem"
 79 | 
 80 | -- | Retrieve `TopStories`
 81 | getTopStories :: IO (Either HackerNewsError TopStories)
 82 | getTopStories = issueAjax Nothing "topstories"
 83 | 
 84 | -- | Retrieve `NewStories`
 85 | getNewStories :: IO (Either HackerNewsError NewStories)
 86 | getNewStories = issueAjax Nothing "newstories"
 87 | 
 88 | -- | Retrieve `BestStories`
 89 | getBestStories :: IO (Either HackerNewsError BestStories)
 90 | getBestStories = issueAjax Nothing "beststories"
 91 | 
 92 | -- | Retrieve `AskStories`
 93 | getAskStories :: IO (Either HackerNewsError AskStories)
 94 | getAskStories = issueAjax Nothing "askstories"
 95 | 
 96 | -- | Retrieve `ShowStories`
 97 | getShowStories :: IO (Either HackerNewsError ShowStories)
 98 | getShowStories = issueAjax Nothing "showstories"
 99 | 
100 | -- | Retrieve `JobStories`
101 | getJobStories :: IO (Either HackerNewsError JobStories)
102 | getJobStories = issueAjax Nothing "jobstories"
103 | 
104 | -- | Retrieve `Updates`
105 | getUpdates :: IO (Either HackerNewsError Updates)
106 | getUpdates = issueAjax Nothing "updates"
107 | 
108 | issueAjax :: FromJSON a => Maybe JSString -> JSString -> IO (Either HackerNewsError a)
109 | issueAjax maybePath uri = do
110 |   response <- xhrByteString request
111 |   pure $ case contents response of
112 |     Nothing -> Left NotFound
113 |     Just "null" -> Left NotFound
114 |     Just x ->
115 |       case eitherDecode (cs x) of
116 |         Left l -> Left $ DecodeFailureError (cs l) mempty
117 |         Right r -> Right r
118 |     where
119 |       request = Request GET url Nothing [] False NoData
120 |       url = "https://hacker-news.firebaseio.com/v0/"
121 |               <> maybe mempty (\path -> path <> "/") maybePath
122 |               <> uri
123 |               <> ".json"
124 | 


--------------------------------------------------------------------------------
/ghc-src/Web/HackerNews.hs:
--------------------------------------------------------------------------------
  1 | {-# LANGUAGE CPP                        #-}
  2 | {-# LANGUAGE RecordWildCards            #-}
  3 | {-# LANGUAGE OverloadedStrings          #-}
  4 | {-# LANGUAGE TypeFamilies               #-}
  5 | {-# LANGUAGE FlexibleInstances          #-}
  6 | {-# LANGUAGE KindSignatures             #-}
  7 | {-# LANGUAGE DeriveGeneric              #-}
  8 | {-# LANGUAGE TypeOperators              #-}
  9 | {-# LANGUAGE DataKinds                  #-}
 10 | {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 11 | {-# LANGUAGE ScopedTypeVariables        #-}
 12 | ------------------------------------------------------------------------------
 13 | -- |
 14 | -- Module      : Web.HackerNews
 15 | -- Copyright   : (c) David Johnson, 2014-2025
 16 | -- Maintainer  : code@dmj.io
 17 | -- Stability   : experimental
 18 | -- Portability : POSIX
 19 | --
 20 | -- Haskell port of <https://github.com/HackerNews/API>
 21 | --
 22 | ------------------------------------------------------------------------------
 23 | module Web.HackerNews
 24 |   ( -- * Hacker News API
 25 |     HackerNewsAPI
 26 |    -- * Custom combinators
 27 |   , HackerCapture
 28 |    -- * API functions
 29 |   , getItem
 30 |   , getUser
 31 |   , getMaxItem
 32 |   , getTopStories
 33 |   , getNewStories
 34 |   , getBestStories
 35 |   , getAskStories
 36 |   , getShowStories
 37 |   , getJobStories
 38 |   , getUpdates
 39 |   -- * Core Types
 40 |   , Item        (..)
 41 |   , User        (..)
 42 |   , Updates     (..)
 43 |   , MaxItem     (..)
 44 |   , TopStories  (..)
 45 |   , NewStories  (..)
 46 |   , BestStories (..)
 47 |   , AskStories  (..)
 48 |   , ShowStories (..)
 49 |   , JobStories  (..)
 50 |   --- * Supporting Types
 51 |   , UserId      (..)
 52 |   , ItemId      (..)
 53 |   , Deleted     (..)
 54 |   , ItemType    (..)
 55 |   , Time        (..)
 56 |   , ItemText    (..)
 57 |   , Dead        (..)
 58 |   , Parent      (..)
 59 |   , Kids        (..)
 60 |   , URL         (..)
 61 |   , Score       (..)
 62 |   , Title       (..)
 63 |   , Parts       (..)
 64 |   , Descendants (..)
 65 |   , Delay       (..)
 66 |   , Created     (..)
 67 |   , Karma       (..)
 68 |   , About       (..)
 69 |   , Submitted   (..)
 70 |   --- * Error handling
 71 |   , HackerNewsError (..)
 72 |   ) where
 73 | 
 74 | import           Data.Bifunctor
 75 | import           Data.Monoid
 76 | import           Data.Proxy
 77 | import           Data.String.Conversions
 78 | import qualified Data.Text                  as T
 79 | import           Network.HTTP.Client        (Manager)
 80 | import           Network.HTTP.Types.Status
 81 | import           Servant.API
 82 | import           Servant.Client
 83 | import           Servant.Common.Req
 84 | 
 85 | import           Web.HackerNews.Types
 86 | 
 87 | -- | HackerNews API
 88 | type HackerNewsAPI =
 89 |        "item" :> HackerCapture ItemId :> Get '[JSON] Item
 90 |   :<|> "user" :> HackerCapture UserId :> Get '[JSON] User
 91 |   :<|> "maxitem.json" :> Get '[JSON] MaxItem
 92 |   :<|> "topstories.json" :> Get '[JSON] TopStories
 93 |   :<|> "newstories.json" :> Get '[JSON] NewStories
 94 |   :<|> "beststories.json" :> Get '[JSON] BestStories
 95 |   :<|> "askstories.json" :> Get '[JSON] AskStories
 96 |   :<|> "showstories.json" :> Get '[JSON] ShowStories
 97 |   :<|> "jobstories.json" :> Get '[JSON] JobStories
 98 |   :<|> "updates.json" :> Get '[JSON] Updates
 99 | 
100 | -- | Custom combinator for appending '.json' to `Item` query
101 | data HackerCapture (a :: *)
102 | 
103 | -- | Custom combinator `HasClient` instance
104 | instance (ToHttpApiData a, HasClient api) => HasClient (HackerCapture a :> api) where
105 |   type Client (HackerCapture a :> api) = a -> Client api
106 |   clientWithRoute Proxy req val =
107 |     clientWithRoute (Proxy :: Proxy api)
108 |        (appendToPath p req)
109 |     where
110 |       p = T.unpack $ toUrlPiece val <> ".json"
111 | 
112 | -- | HN `BaseURL`
113 | hackerNewsURL :: BaseUrl
114 | hackerNewsURL = BaseUrl Https "hacker-news.firebaseio.com" 443 "/v0"
115 | 
116 | -- | Convert ServantError to HackerNewsError
117 | toError :: Either ServantError ok -> Either HackerNewsError ok
118 | toError = first go
119 |   where
120 |     go :: ServantError -> HackerNewsError
121 | #if MIN_VERSION_servant_client(0,11,0)
122 |     go (FailureResponse _ Status{..} _ body) =
123 | #else
124 |     go (FailureResponse Status{..} _ body) =
125 | #endif
126 |       FailureResponseError statusCode (cs statusMessage) (cs body)
127 |     go (DecodeFailure _ _ "null") = NotFound
128 |     go (DecodeFailure err _ body) =
129 |       DecodeFailureError (cs err) (cs body)
130 |     go (UnsupportedContentType _ body) =
131 |       UnsupportedContentTypeError (cs body)
132 |     go (InvalidContentTypeHeader header body) =
133 |       InvalidContentTypeHeaderError (cs header) (cs body)
134 |     go (ConnectionError ex) =
135 |       HNConnectionError $ cs (show ex)
136 | 
137 | mkClientEnv :: Manager -> ClientEnv
138 | mkClientEnv = flip ClientEnv hackerNewsURL
139 | 
140 | -- | Retrieve `Item`
141 | getItem :: Manager -> ItemId -> IO (Either HackerNewsError Item)
142 | getItem mgr itemId =
143 |   toError <$> do
144 |     runClientM
145 |       (getItem' itemId)
146 |       (mkClientEnv mgr)
147 | 
148 | -- | Retrieve `User`
149 | getUser :: Manager -> UserId -> IO (Either HackerNewsError User)
150 | getUser mgr userId =
151 |   toError <$> do
152 |     runClientM
153 |       (getUser' userId)
154 |       (ClientEnv mgr hackerNewsURL)
155 | 
156 | -- | Retrieve `MaxItem`
157 | getMaxItem :: Manager -> IO (Either HackerNewsError MaxItem)
158 | getMaxItem mgr =
159 |   toError <$> do
160 |     runClientM
161 |       getMaxItem'
162 |       (ClientEnv mgr hackerNewsURL)
163 | 
164 | -- | Retrieve `TopStories`
165 | getTopStories :: Manager -> IO (Either HackerNewsError TopStories)
166 | getTopStories mgr =
167 |   toError <$> do
168 |     runClientM
169 |       getTopStories'
170 |       (mkClientEnv mgr)
171 | 
172 | -- | Retrieve `NewStories`
173 | getNewStories :: Manager -> IO (Either HackerNewsError NewStories)
174 | getNewStories mgr =
175 |   toError <$> do
176 |     runClientM
177 |       getNewStories'
178 |       (mkClientEnv mgr)
179 | 
180 | -- | Retrieve `BestStories`
181 | getBestStories :: Manager -> IO (Either HackerNewsError BestStories)
182 | getBestStories mgr =
183 |   toError <$> do
184 |     runClientM
185 |       getBestStories'
186 |       (mkClientEnv mgr)
187 | 
188 | -- | Retrieve `AskStories`
189 | getAskStories :: Manager -> IO (Either HackerNewsError AskStories)
190 | getAskStories mgr =
191 |   toError <$> do
192 |     runClientM
193 |       getAskStories'
194 |       (mkClientEnv mgr)
195 | 
196 | -- | Retrieve `ShowStories`
197 | getShowStories :: Manager -> IO (Either HackerNewsError ShowStories)
198 | getShowStories mgr =
199 |   toError <$> do
200 |     runClientM
201 |       getShowStories'
202 |       (mkClientEnv mgr)
203 | 
204 | -- | Retrieve `JobStories`
205 | getJobStories :: Manager -> IO (Either HackerNewsError JobStories)
206 | getJobStories mgr =
207 |   toError <$> do
208 |     runClientM
209 |       getJobStories'
210 |       (mkClientEnv mgr)
211 | 
212 | -- | Retrieve `Updates`
213 | getUpdates :: Manager -> IO (Either HackerNewsError Updates)
214 | getUpdates mgr =
215 |   toError <$> do
216 |     runClientM
217 |       getUpdates'
218 |       (mkClientEnv mgr)
219 | 
220 | getItem' :: ItemId -> ClientM Item
221 | getUser' :: UserId -> ClientM User
222 | getMaxItem' :: ClientM MaxItem
223 | getTopStories' :: ClientM TopStories
224 | getNewStories' :: ClientM NewStories
225 | getBestStories' :: ClientM BestStories
226 | getAskStories' :: ClientM AskStories
227 | getShowStories' :: ClientM ShowStories
228 | getJobStories' :: ClientM JobStories
229 | getUpdates' ::  ClientM Updates
230 | 
231 | getItem'
232 |   :<|> getUser'
233 |   :<|> getMaxItem'
234 |   :<|> getTopStories'
235 |   :<|> getNewStories'
236 |   :<|> getBestStories'
237 |   :<|> getAskStories'
238 |   :<|> getShowStories'
239 |   :<|> getJobStories'
240 |   :<|> getUpdates' = client (Proxy :: Proxy HackerNewsAPI)
241 | 
242 | 


--------------------------------------------------------------------------------
/src/Web/HackerNews/Types.hs:
--------------------------------------------------------------------------------
  1 | {-# LANGUAGE DeriveGeneric              #-}
  2 | {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  3 | ------------------------------------------------------------------------------
  4 | -- |
  5 | -- Module      : Web.HackerNews.Types
  6 | -- Copyright   : (c) David Johnson, 2014-2025
  7 | -- Maintainer  : code@dmj.io
  8 | -- Stability   : experimental
  9 | -- Portability : POSIX
 10 | --
 11 | -- Haskell port of <https://github.com/HackerNews/API>
 12 | --
 13 | ------------------------------------------------------------------------------
 14 | module Web.HackerNews.Types where
 15 | 
 16 | import           Data.Aeson
 17 | import           Data.Aeson.Types
 18 | import           Data.Char
 19 | import qualified Data.Text        as T
 20 | import           GHC.Generics
 21 | import           Servant.API
 22 | 
 23 | import Test.QuickCheck
 24 | import Test.QuickCheck.Instances ()
 25 | 
 26 | -- | The item and profile changes are at <https://hacker-news.firebaseio.com/v0/updates>
 27 | data Updates = Updates  {
 28 |       items :: [ItemId]
 29 |        -- ^ Updated `Item`s
 30 |     , profiles :: [UserId]
 31 |        -- ^ Updated `UserName`s
 32 |    } deriving (Show, Eq, Generic)
 33 | 
 34 | instance ToJSON Updates
 35 | instance FromJSON Updates
 36 | 
 37 | instance Arbitrary Updates where
 38 |   arbitrary = Updates <$> arbitrary <*> arbitrary
 39 | 
 40 | -- | The current largest item id is at <https://hacker-news.firebaseio.com/v0/maxitem>.
 41 | -- You can walk backward from here to discover all items.
 42 | newtype MaxItem = MaxItem ItemId
 43 |   deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary)
 44 | 
 45 | -- | <https://hacker-news.firebaseio.com/v0/topstories>
 46 | newtype TopStories = TopStories [ItemId]
 47 |   deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary)
 48 | 
 49 | -- | <https://hacker-news.firebaseio.com/v0/newstories>
 50 | newtype NewStories = NewStories [ItemId]
 51 |   deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary)
 52 | 
 53 | -- | <https://hacker-news.firebaseio.com/v0/beststories>
 54 | newtype BestStories = BestStories [ItemId]
 55 |   deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary)
 56 | 
 57 | -- | <https://hacker-news.firebaseio.com/v0/askstories>
 58 | newtype AskStories = AskStories [ItemId]
 59 |   deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary)
 60 | 
 61 | -- | <https://hacker-news.firebaseio.com/v0/showstories>
 62 | newtype ShowStories = ShowStories [ItemId]
 63 |   deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary)
 64 | 
 65 | -- | <https://hacker-news.firebaseio.com/v0/jobstories>
 66 | newtype JobStories = JobStories [ItemId]
 67 |   deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary)
 68 | 
 69 | -- | Users are identified by case-sensitive ids, and live under
 70 | -- <https://hacker-news.firebaseio.com/v0/user/>.
 71 | -- Only users that have public activity (comments or story submissions)
 72 | -- on the site are available through the API.
 73 | data User = User {
 74 |     userId :: UserId
 75 |     -- ^ The user's unique username. Case-sensitive. Required.
 76 |   , userDelay :: Maybe Delay
 77 |     -- ^ Delay in minutes between a comment's creation and its visibility to other users.
 78 |   , userCreated :: Created
 79 |     -- ^ Creation date of the user, in Unix Time.
 80 |   , userKarma :: Karma
 81 |     -- ^ The user's karma
 82 |   , userAbout :: Maybe About
 83 |     -- ^ The user's optional self-description. HTML.
 84 |   , userSubmitted :: Maybe Submitted
 85 |     -- ^ List of the user's stories, polls and comments.
 86 |   } deriving (Show, Eq, Generic)
 87 | 
 88 | instance Arbitrary User where
 89 |   arbitrary =
 90 |     User <$> arbitrary <*> arbitrary <*> arbitrary
 91 |          <*> arbitrary <*> arbitrary <*> arbitrary
 92 | 
 93 | instance ToJSON User where
 94 |   toJSON = genericToJSON defaultOptions {
 95 |     fieldLabelModifier = map toLower . drop 4
 96 |   }
 97 | 
 98 | instance FromJSON User where
 99 |   parseJSON = genericParseJSON defaultOptions {
100 |     fieldLabelModifier = map toLower . drop 4
101 |   }
102 | 
103 | -- | The user's karma.
104 | newtype Karma = Karma Int
105 |   deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary)
106 | 
107 | -- | The user's unique username. Case-sensitive. Required.
108 | newtype UserId = UserId T.Text
109 |   deriving (Show, Eq, ToJSON, FromJSON, ToHttpApiData, Generic, Arbitrary)
110 | 
111 | -- | Delay in minutes between a comment's creation and its visibility to other users.
112 | newtype Delay = Delay Int
113 |   deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary)
114 | 
115 | -- | Creation date of the user, in Unix Time.
116 | newtype Created = Created Int
117 |   deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary)
118 | 
119 | -- | The user's optional self-description. HTML.
120 | newtype About = About T.Text
121 |   deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary)
122 | 
123 | -- | List of the user's stories, polls and comments.
124 | newtype Submitted = Submitted [ItemId]
125 |   deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary)
126 | 
127 | -- | The item's unique id.
128 | newtype ItemId = ItemId Int
129 |   deriving (Show, Eq, ToJSON, FromJSON, ToHttpApiData, Generic, Arbitrary)
130 | 
131 | -- | `true` if the item is deleted.
132 | newtype Deleted = Deleted Bool
133 |   deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary)
134 | 
135 | -- | The type of item. One of "job", "story", "comment", "poll", or "pollopt"
136 | data ItemType = Job | Story | Comment | Poll | PollOpt
137 |   deriving (Show, Eq, Generic, Enum)
138 | 
139 | instance Arbitrary ItemType where
140 |   arbitrary = elements [ Job .. ]
141 | 
142 | instance ToJSON ItemType where
143 |   toJSON = genericToJSON
144 |     defaultOptions { constructorTagModifier = map toLower }
145 | 
146 | instance FromJSON ItemType where
147 |   parseJSON = genericParseJSON
148 |     defaultOptions { constructorTagModifier = map toLower }
149 | 
150 | -- | The comment, story or poll text. HTML.
151 | newtype ItemText = ItemText T.Text
152 |   deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary)
153 | 
154 | -- | `true` if the item is dead.
155 | newtype Dead = Dead Bool
156 |   deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary)
157 | 
158 | -- | The item's parent. For comments, either another comment or the relevant story.
159 | -- For pollopts, the relevant poll.
160 | newtype Parent = Parent ItemId
161 |   deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary)
162 | 
163 | -- | Creation date of the item, in Unix Time.
164 | newtype Time = Time Integer
165 |   deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary)
166 | 
167 | -- | The ids of the item's comments, in ranked display order.
168 | newtype Kids = Kids [ItemId]
169 |   deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary)
170 | 
171 | -- | The URL of the story.
172 | newtype URL = URL T.Text
173 |   deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary)
174 | 
175 | -- | The story's score, or the votes for a pollopt.
176 | newtype Score = Score Int
177 |   deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary)
178 | 
179 | -- | The title of the story, poll or job.
180 | newtype Title = Title T.Text
181 |   deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary)
182 | 
183 | -- | A list of related pollopts, in display order.
184 | newtype Parts = Parts [ItemId]
185 |   deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary)
186 | 
187 | -- | In the case of stories or polls, the total comment count.
188 | newtype Descendants = Descendants Int
189 |   deriving (Show, Eq, ToJSON, FromJSON, Generic, Arbitrary)
190 | 
191 | -- | Stories, comments, jobs, Ask HNs and even polls are just items.
192 | -- They're identified by their ids, which are unique integers, and live under
193 | -- <https://hacker-news.firebaseio.com/v0/item/>.
194 | data Item = Item {
195 |       itemId          :: Maybe ItemId
196 |     , itemDeleted     :: Maybe Deleted
197 |     , itemType        :: ItemType
198 |     , itemBy          :: Maybe UserId
199 |     , itemTime        :: Maybe Time
200 |     , itemText        :: Maybe ItemText
201 |     , itemDead        :: Maybe Dead
202 |     , itemParent      :: Maybe Parent
203 |     , itemKids        :: Maybe Kids
204 |     , itemURL         :: Maybe URL
205 |     , itemScore       :: Maybe Score
206 |     , itemTitle       :: Maybe Title
207 |     , itemParts       :: Maybe Parts
208 |     , itemDescendants :: Maybe Descendants
209 |     } deriving (Show, Eq, Generic)
210 | 
211 | instance Arbitrary Item where
212 |   arbitrary = Item <$> arbitrary <*> arbitrary <*> arbitrary
213 |                    <*> arbitrary <*> arbitrary <*> arbitrary
214 |                    <*> arbitrary <*> arbitrary <*> arbitrary
215 |                    <*> arbitrary <*> arbitrary <*> arbitrary
216 |                    <*> arbitrary <*> arbitrary
217 | 
218 | instance ToJSON Item where
219 |   toJSON = genericToJSON
220 |     defaultOptions { fieldLabelModifier = map toLower . drop 4 }
221 | 
222 | instance FromJSON Item where
223 |   parseJSON = genericParseJSON
224 |     defaultOptions { fieldLabelModifier = map toLower . drop 4 }
225 | 
226 | -- | Error handling for `HackerNewsAPI`
227 | data HackerNewsError
228 |   = NotFound
229 |   | FailureResponseError Int T.Text T.Text
230 |   | HNConnectionError T.Text
231 |   | DecodeFailureError T.Text T.Text
232 |   | InvalidContentTypeHeaderError T.Text T.Text
233 |   | UnsupportedContentTypeError T.Text
234 |   deriving (Show, Eq)
235 | 


--------------------------------------------------------------------------------