hackernews 0.3.1.2 → 0.4.0.0
raw patch · 2 files changed
+99/−14 lines, 2 filesdep +ghcjs-basePVP ok
version bump matches the API change (PVP)
Dependencies added: ghcjs-base
API changes (from Hackage documentation)
Files
- hackernews.cabal +19/−3
- src/Web/HackerNews/Client.hs +80/−11
hackernews.cabal view
@@ -1,5 +1,5 @@ name: hackernews-version: 0.3.1.2+version: 0.4.0.0 description: API for news.ycombinator.com license: MIT synopsis: API for Hacker News@@ -10,8 +10,11 @@ build-type: Simple cabal-version: >=1.10 +flag ghcjs+ description: Tell cabal we're using GHCJS+ default: False+ library- ghc-options: -Wall -rtsopts exposed-modules: Web.HackerNews other-modules: Web.HackerNews.Types , Web.HackerNews.Client@@ -26,7 +29,20 @@ , Web.HackerNews.Util , Web.HackerNews.Endpoint hs-source-dirs: src- build-depends: HsOpenSSL >= 0.10.5++ if flag(ghcjs)+ ghcjs-options: -O2+ build-depends: ghcjs-base+ , aeson >= 0.8.0.1+ , base >= 4.7 && <4.8+ , attoparsec >= 0.12.1.2+ , either >= 4.3.1+ , text >= 1.2.0.0+ , time >= 1.4.2+ , transformers >= 0.3.0.0+ else+ ghc-options: -Wall -rtsopts+ build-depends: HsOpenSSL >= 0.10.5 , aeson >= 0.8.0.1 , attoparsec >= 0.12.1.2 , base >= 4.7 && <4.8
src/Web/HackerNews/Client.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP, OverloadedStrings, ForeignFunctionInterface, JavaScriptFFI#-} ------------------------------------------------------------------------------ -- | -- Module : Web.HackerNews.Client@@ -18,20 +18,27 @@ ------------------------------------------------------------------------------ import Data.Aeson hiding (Result) import Data.Aeson.Parser (value)-import Data.Attoparsec.ByteString (parseOnly)+import qualified Data.Text.Encoding as T+import Data.Text (Text)+import Data.Monoid ((<>))+import Control.Monad.Trans.Either import Data.Either (rights)-import Control.Monad.Trans.Either -import Control.Exception (try, SomeException)-import Control.Monad (when)+import Data.Maybe import Control.Monad.IO.Class (liftIO)+import Data.Attoparsec.ByteString (parseOnly)+import Control.Monad (when)+#ifdef __GHCJS__+import GHCJS.Types+import GHCJS.Foreign as F+#else+import Control.Exception (try, SomeException) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Reader (ReaderT, ask, runReaderT)-import Data.Monoid ((<>))-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+#endif+ ------------------------------------------------------------------------------ ------------------------------------------------------------------------------@@ -41,8 +48,11 @@ ------------------------------------------------------------------------------ -- | Core Type+#ifdef __GHCJS__+type HackerNews a = EitherT HackerNewsError IO a+#else type HackerNews a = EitherT HackerNewsError (ReaderT Connection IO) a-+#endif ------------------------------------------------------------------------------ -- | Error Types data HackerNewsError =@@ -52,7 +62,67 @@ | RequestError deriving (Show, Eq) +#ifdef __GHCJS__+-- | HackerNews API request method+hackerNews :: FromJSON a => HackerNews a -> IO (Either HackerNewsError a)+hackerNews = runEitherT++ ------------------------------------------------------------------------------+-- | Request Builder for API+buildHNRequest :: FromJSON a => Text -> HackerNews a+buildHNRequest path = do+ let url = "https://hacker-news.firebaseio.com/v0/" <> path <> ".json"+ res <- liftIO $ ajax url+ case (arError res) of+ Just et -> case et of+ "connection-error" -> left ConnectionError+ "request-error" -> left RequestError+ _ -> left NotFound+ Nothing -> do+ let t = T.encodeUtf8 $ fromMaybe "" $ arData res+ xs = rights [parseOnly value t, parseOnly json t]+ when debug $ liftIO . print $ t+ case xs of+ [] -> left ParseError+ x : _ ->+ case fromJSON x of+ Success jsonBody -> right jsonBody+ _ -> left NotFound+++data AjaxResult = AjaxResult { arData :: Maybe Text,+ arError :: Maybe Text+ } deriving (Ord, Eq, Show)++ajax :: Text -> IO AjaxResult+ajax url = do+ res <- js_ajax (toJSString url)+ err <- F.getProp ("error" :: Text) res+ dat <- F.getProp ("data" :: Text) res+ let d = getTextDat dat+ e = getTextDat err+ return (AjaxResult d e)+ where getTextDat dt = if isNull dt then Nothing else Just (fromJSString dt)+++foreign import javascript interruptible "var req = new XMLHttpRequest(); \+ if (!req)\+ $c({error: 'connection-error', data: null});\+ req.onreadystatechange = function() {\+ if (req.readyState === 4) {\+ if (req.status === 200) {\+ $c({data: req.responseText, error: null});\+ } else\+ $c({error: 'request-error', data: null});\+ }\+ };\+ req.open('GET', $1, true);\+ req.send();"+ js_ajax :: JSString -> IO (JSRef ajaxResult)++#else+------------------------------------------------------------------------------ -- | HackerNews API request method hackerNews :: FromJSON a => HackerNews a -> IO (Either HackerNewsError a) hackerNews requests =@@ -90,5 +160,4 @@ Success jsonBody -> right jsonBody _ -> left NotFound --+#endif