packages feed

http-response-decoder (empty) → 0.2.1.1

raw patch · 6 files changed

+341/−0 lines, 6 filesdep +base-preludedep +bytestringdep +bytestring-tree-buildersetup-changed

Dependencies added: base-prelude, bytestring, bytestring-tree-builder, case-insensitive, http-client, http-types, matcher, profunctors, text, transformers, unordered-containers

Files

+ LICENSE view
@@ -0,0 +1,22 @@+Copyright (c) 2016, Sannsyn AS++Permission is hereby granted, free of charge, to any person+obtaining a copy of this software and associated documentation+files (the "Software"), to deal in the Software without+restriction, including without limitation the rights to use,+copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the+Software is furnished to do so, subject to the following+conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ http-response-decoder.cabal view
@@ -0,0 +1,61 @@+name:+  http-response-decoder+version:+  0.2.1.1+synopsis:+  Declarative DSL for parsing an HTTP response+homepage:+  https://github.com/sannsyn/http-response-decoder+bug-reports:+  https://github.com/sannsyn/http-response-decoder/issues+author:+  Nikita Volkov <nikita.y.volkov@mail.ru>+maintainer:+  Nikita Volkov <nikita.y.volkov@mail.ru>+copyright:+  (c) 2016, Sannsyn AS+license:+  MIT+license-file:+  LICENSE+build-type:+  Simple+cabal-version:+  >=1.10+++source-repository head+  type:+    git+  location:+    git://github.com/sannsyn/http-response-decoder.git+++library+  hs-source-dirs:+    library+  default-extensions:+    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFunctor, DeriveGeneric, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, ImpredicativeTypes, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+  default-language:+    Haskell2010+  other-modules:+    HTTPResponseDecoder.Prelude+    HTTPResponseDecoder.BodyReaders+  exposed-modules:+    HTTPResponseDecoder+  build-depends:+    -- http:+    http-types >= 0.9 && < 0.10,+    http-client >= 0.4.27 && < 0.5,+    -- data:+    bytestring-tree-builder >= 0.2.5 && < 0.3,+    bytestring >= 0.10 && < 0.11,+    text >= 1 && < 2,+    unordered-containers >= 0.2.6 && < 0.3,+    case-insensitive >= 1.2 && < 2,+    -- general:+    matcher >= 0.1 && < 0.2,+    profunctors >= 5.2 && < 6,+    transformers >= 0.3 && < 0.6,+    base-prelude < 2+
+ library/HTTPResponseDecoder.hs view
@@ -0,0 +1,188 @@+-- |+-- A DSL of HTTP-response decoders.+module HTTPResponseDecoder+(+  run,+  -- * Response+  Response,+  headAndBody,+  -- * Head+  Head,+  statusCode,+  httpVersion,+  headers,+  -- * Headers+  Headers,+  header,+  contentType,+  -- * Body+  Body,+  bodyStream,+  bodyBytes,+  bodyLazyBytes,+  -- * Matcher+  Matcher.Matcher,+  Matcher.equals,+  Matcher.satisfies,+  Matcher.converts,+)+where++import HTTPResponseDecoder.Prelude+import qualified Network.HTTP.Client+import qualified Network.HTTP.Types+import qualified Data.ByteString.Lazy+import qualified Data.HashMap.Strict+import qualified Data.CaseInsensitive+import qualified HTTPResponseDecoder.BodyReaders+import qualified Matcher+++run :: Response a -> Network.HTTP.Client.Response Network.HTTP.Client.BodyReader -> IO (Either Text a)+run (Response impl) =+  impl+++-- * Response+-------------------------++-- |+-- Response decoder.+newtype Response a =+  Response (Network.HTTP.Client.Response Network.HTTP.Client.BodyReader -> IO (Either Text a))+  deriving (Functor)++-- |+-- Composes a Response decoder from Head and Body decoders.+-- +-- You can then merge the tuple in the result using the Functor interface.+headAndBody :: Head a -> Body b -> Response (a, b)+headAndBody (Head headMatcher) (Body bodyToIOEither) =+  Response $+  (liftA2 . liftA2 . liftA2) (,) (pure . responseToEither) (bodyToIOEither . responseToBody)+  where+    responseToBody =+      Network.HTTP.Client.responseBody+    responseToEither =+      Matcher.run headMatcher+++-- * Head+-------------------------++-- |+-- Response head decoder.+-- +-- Supports the 'Applicative' and 'Alternative' interfaces.+newtype Head a =+  Head (forall body. Matcher.Matcher (Network.HTTP.Client.Response body) a)+  deriving (Functor)++instance Applicative Head where+  {-# INLINE pure #-}+  pure a =+    Head (pure a)+  {-# INLINE (<*>) #-}+  (<*>) (Head decoder1) (Head decoder2) =+    Head (decoder1 <*> decoder2)++instance Alternative Head where+  {-# INLINE empty #-}+  empty =+    Head empty+  {-# INLINE (<|>) #-}+  (<|>) (Head decoder1) (Head decoder2) =+    Head (decoder1 <|> decoder2)++statusCode :: Matcher.Matcher Int a -> Head a+statusCode decoder =+  Head $+  lmap mapping decoder+  where+    mapping =+      Network.HTTP.Types.statusCode .+      Network.HTTP.Client.responseStatus++httpVersion :: Matcher.Matcher (Int, Int) a -> Head a+httpVersion decoder =+  Head $+  lmap mapping decoder+  where+    mapping =+      httpVersionToTuple .+      Network.HTTP.Client.responseVersion+      where+        httpVersionToTuple (Network.HTTP.Types.HttpVersion major minor) =+          (major, minor)++headers :: Headers a -> Head a+headers (Headers decoder) =+  Head $+  lmap mapping decoder+  where+    mapping =+      Data.HashMap.Strict.fromList .+      map foldKeyCase .+      Network.HTTP.Client.responseHeaders+      where+        foldKeyCase (k, v) =+          (Data.CaseInsensitive.foldedCase k, v)+++-- * Headers+-------------------------++-- |+-- Response headers decoder.+newtype Headers a =+  Headers (Matcher.Matcher (HashMap ByteString ByteString) a)+  deriving (Functor, Applicative, Alternative)++header :: ByteString -> Matcher.Matcher ByteString a -> Headers a+header name headerMatcher =+  Headers $+  decoder+  where+    decoder =+      headerMatcher . lookup+      where+        lookup =+          Matcher.converts $+          \hashMap ->+            Data.HashMap.Strict.lookup foldedName hashMap &+            maybe (Left ("Header " <> fromString (show foldedName) <> " not found")) Right+          where+            foldedName =+              Data.CaseInsensitive.foldCase name++contentType :: Matcher.Matcher ByteString a -> Headers a+contentType =+  header "content-type"+++-- * Body+-------------------------++-- |+-- Body decoder.+newtype Body a =+  Body (IO ByteString -> IO (Either Text a))+  deriving (Functor)++bodyStream :: (IO ByteString -> IO (Either Text a)) -> Body a+bodyStream reader =+  Body $+  reader++bodyBytes :: Matcher.Matcher ByteString a -> Body a+bodyBytes matcher =+  Body $+  fmap (Matcher.run matcher) .+  HTTPResponseDecoder.BodyReaders.bytes++bodyLazyBytes :: Matcher.Matcher Data.ByteString.Lazy.ByteString a -> Body a+bodyLazyBytes matcher =+  Body $+  fmap (Matcher.run matcher) .+  HTTPResponseDecoder.BodyReaders.lazyBytes+
+ library/HTTPResponseDecoder/BodyReaders.hs view
@@ -0,0 +1,32 @@+module HTTPResponseDecoder.BodyReaders+where++import HTTPResponseDecoder.Prelude+import qualified ByteString.TreeBuilder+import qualified Data.ByteString+import qualified Data.ByteString.Lazy+++{-# INLINE bytes #-}+bytes :: IO ByteString -> IO ByteString+bytes =+  fmap ByteString.TreeBuilder.toByteString .+  builder++{-# INLINE lazyBytes #-}+lazyBytes :: IO ByteString -> IO Data.ByteString.Lazy.ByteString+lazyBytes =+  fmap ByteString.TreeBuilder.toLazyByteString .+  builder++{-# INLINABLE builder #-}+builder :: IO ByteString -> IO ByteString.TreeBuilder.Builder+builder chunk =+  loop mempty+  where+    loop builder =+      do+        chunk <- chunk+        if Data.ByteString.null chunk+          then return builder+          else loop (builder <> ByteString.TreeBuilder.byteString chunk)
+ library/HTTPResponseDecoder/Prelude.hs view
@@ -0,0 +1,36 @@+module HTTPResponseDecoder.Prelude +(+  module Exports,+)+where++-- base-prelude+-------------------------+import BasePrelude as Exports++-- transformers+-------------------------+import Control.Monad.IO.Class as Exports+import Control.Monad.Trans.Class as Exports+import Control.Monad.Trans.Cont as Exports hiding (shift, callCC)+import Control.Monad.Trans.Except as Exports (ExceptT(ExceptT), Except, except, runExcept, runExceptT, mapExcept, mapExceptT, withExcept, withExceptT)+import Control.Monad.Trans.Maybe as Exports+import Control.Monad.Trans.Reader as Exports (Reader, runReader, mapReader, withReader, ReaderT(ReaderT), runReaderT, mapReaderT, withReaderT)+import Control.Monad.Trans.State.Strict as Exports (State, runState, evalState, execState, mapState, withState, StateT(StateT), runStateT, evalStateT, execStateT, mapStateT, withStateT)+import Control.Monad.Trans.Writer.Strict as Exports (Writer, runWriter, execWriter, mapWriter, WriterT(..), execWriterT, mapWriterT)++-- profunctors+-------------------------+import Data.Profunctor.Unsafe as Exports++-- bytestring+-------------------------+import Data.ByteString as Exports (ByteString)++-- text+-------------------------+import Data.Text as Exports (Text)++-- unordered-containers+-------------------------+import Data.HashMap.Strict as Exports (HashMap)