eeva
/
servant
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

stylish-haskell servant-client-core

This commit is contained in:
Oleg Grenrus 2018-06-30 22:17:08 +03:00
parent 07716b8f4e
commit 319dcc2fe1
12 changed files with 118 additions and 104 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
servant-client-core/Setup.hs
View File

@ -1,2 +1,2 @@
import Distribution.Simple
import Distribution.Simple
main = defaultMain

10
servant-client-core/src/Servant/Client/Core.hs
View File

@ -55,13 +55,11 @@ module Servant.Client.Core
, setRequestBody
) where
import Servant.Client.Core.Internal.Auth
import Servant.Client.Core.Internal.BaseUrl (BaseUrl (..),
InvalidBaseUrlException,
Scheme (..),
parseBaseUrl,
showBaseUrl)
import Servant.Client.Core.Internal.BaseUrl
(BaseUrl (..), InvalidBaseUrlException, Scheme (..),
parseBaseUrl, showBaseUrl)
import Servant.Client.Core.Internal.BasicAuth
import Servant.Client.Core.Internal.HasClient
import Servant.Client.Core.Internal.Generic
import Servant.Client.Core.Internal.HasClient
import Servant.Client.Core.Internal.Request
import Servant.Client.Core.Internal.RunClient

3
servant-client-core/src/Servant/Client/Core/Internal/Auth.hs
View File

@ -6,7 +6,8 @@
module Servant.Client.Core.Internal.Auth where
import Servant.Client.Core.Internal.Request (Request)
import Servant.Client.Core.Internal.Request
(Request)
-- | For a resource protected by authentication (e.g. AuthProtect), we need
-- to provide the client with some data used to add authentication data

6
servant-client-core/src/Servant/Client/Core/Internal/BaseUrl.hs
View File

@ -3,11 +3,13 @@
{-# LANGUAGE ViewPatterns #-}
module Servant.Client.Core.Internal.BaseUrl where
import Control.Monad.Catch (Exception, MonadThrow, throwM)
import Control.Monad.Catch
(Exception, MonadThrow, throwM)
import Data.List
import Data.Typeable
import GHC.Generics
import Network.URI hiding (path)
import Network.URI hiding
(path)
import Safe
import Text.Read

15
servant-client-core/src/Servant/Client/Core/Internal/BasicAuth.hs
View File

@ -6,11 +6,16 @@
module Servant.Client.Core.Internal.BasicAuth where
import Data.ByteString.Base64 (encode)
import Data.Monoid ((<>))
import Data.Text.Encoding (decodeUtf8)
import Servant.API.BasicAuth (BasicAuthData (BasicAuthData))
import Servant.Client.Core.Internal.Request (Request, addHeader)
import Data.ByteString.Base64
(encode)
import Data.Monoid
((<>))
import Data.Text.Encoding
(decodeUtf8)
import Servant.API.BasicAuth
(BasicAuthData (BasicAuthData))
import Servant.Client.Core.Internal.Request
(Request, addHeader)
-- | Authenticate a request using Basic Authentication
basicAuthReq :: BasicAuthData -> Request -> Request

2
servant-client-core/src/Servant/Client/Core/Internal/ClientF.hs
View File

@ -1,7 +1,7 @@
{-# LANGUAGE DeriveFunctor #-}
module Servant.Client.Core.Internal.ClientF where
import Servant.Client.Core.Internal.Request
import Servant.Client.Core.Internal.Request
data ClientF a
= RunRequest Request (Response -> a)

22
servant-client-core/src/Servant/Client/Core/Internal/Generic.hs
View File

@ -1,19 +1,21 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
#include "overlapping-compat.h"
module Servant.Client.Core.Internal.Generic where
import Generics.SOP (Code, Generic, I(..), NP(..), NS(Z), SOP(..), to)
import Servant.API ((:<|>)(..))
import Generics.SOP
(Code, Generic, I (..), NP (..), NS (Z), SOP (..), to)
import Servant.API
((:<|>) (..))
-- | This class allows us to match client structure with client functions
-- produced with 'client' without explicit pattern-matching.

80
servant-client-core/src/Servant/Client/Core/Internal/HasClient.hs
View File

@ -15,54 +15,46 @@
#include "overlapping-compat.h"
module Servant.Client.Core.Internal.HasClient where
import Prelude ()
import Prelude ()
import Prelude.Compat
import Control.Concurrent (newMVar, modifyMVar)
import Data.Foldable (toList)
import Control.Concurrent
(modifyMVar, newMVar)
import Control.Monad.IO.Class
(MonadIO (..))
import qualified Data.ByteString.Lazy as BL
import Control.Monad.IO.Class (MonadIO (..))
import Data.List (foldl')
import Data.Proxy (Proxy (Proxy))
import Data.Semigroup ((<>))
import Data.Sequence (fromList)
import Data.String (fromString)
import Data.Text (Text, pack)
import GHC.TypeLits (KnownSymbol, symbolVal)
import Data.Foldable
(toList)
import Data.List
(foldl')
import Data.Proxy
(Proxy (Proxy))
import Data.Semigroup
((<>))
import Data.Sequence
(fromList)
import Data.String
(fromString)
import Data.Text
(Text, pack)
import GHC.TypeLits
(KnownSymbol, symbolVal)
import qualified Network.HTTP.Types as H
import Servant.API ((:<|>) ((:<|>)), (:>),
AuthProtect, BasicAuth,
BasicAuthData,
BuildHeadersTo (..),
FromResultStream (..),
ByteStringParser (..),
Capture', CaptureAll,
Description, EmptyAPI,
FramingUnrender (..),
Header', Headers (..),
HttpVersion, IsSecure,
MimeRender (mimeRender),
MimeUnrender (mimeUnrender),
NoContent (NoContent),
QueryFlag, QueryParam',
QueryParams, Raw,
ReflectMethod (..),
RemoteHost, ReqBody',
ResultStream(..),
SBoolI,
Stream,
Summary, ToHttpApiData,
Vault, Verb,
WithNamedContext,
contentType,
getHeadersHList,
getResponse,
toQueryParam,
toUrlPiece)
import Servant.API.ContentTypes (contentTypes)
import Servant.API.Modifiers (FoldRequired,
RequiredArgument,
foldRequiredArgument)
import Servant.API
((:<|>) ((:<|>)), (:>), AuthProtect, BasicAuth, BasicAuthData,
BuildHeadersTo (..), ByteStringParser (..), Capture',
CaptureAll, Description, EmptyAPI, FramingUnrender (..),
FromResultStream (..), Header', Headers (..), HttpVersion,
IsSecure, MimeRender (mimeRender),
MimeUnrender (mimeUnrender), NoContent (NoContent), QueryFlag,
QueryParam', QueryParams, Raw, ReflectMethod (..), RemoteHost,
ReqBody', ResultStream (..), SBoolI, Stream, Summary,
ToHttpApiData, Vault, Verb, WithNamedContext, contentType,
getHeadersHList, getResponse, toQueryParam, toUrlPiece)
import Servant.API.ContentTypes
(contentTypes)
import Servant.API.Modifiers
(FoldRequired, RequiredArgument, foldRequiredArgument)
import Servant.Client.Core.Internal.Auth
import Servant.Client.Core.Internal.BasicAuth

36
servant-client-core/src/Servant/Client/Core/Internal/Request.hs
View File

@ -12,26 +12,34 @@
module Servant.Client.Core.Internal.Request where
import Prelude ()
import Prelude ()
import Prelude.Compat
import Control.Monad.Catch (Exception)
import Control.Monad.Catch
(Exception)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as Builder
import qualified Data.ByteString.Lazy as LBS
import Data.Int (Int64)
import Data.Semigroup ((<>))
import Data.Int
(Int64)
import Data.Semigroup
((<>))
import qualified Data.Sequence as Seq
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8)
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import Network.HTTP.Media (MediaType)
import Network.HTTP.Types (Header, HeaderName, HttpVersion,
Method, QueryItem, Status, http11,
methodGet)
import Web.HttpApiData (ToHttpApiData, toEncodedUrlPiece,
toHeader)
import Data.Text
(Text)
import Data.Text.Encoding
(encodeUtf8)
import Data.Typeable
(Typeable)
import GHC.Generics
(Generic)
import Network.HTTP.Media
(MediaType)
import Network.HTTP.Types
(Header, HeaderName, HttpVersion, Method, QueryItem, Status,
http11, methodGet)
import Web.HttpApiData
(ToHttpApiData, toEncodedUrlPiece, toHeader)
-- | A type representing possible errors in a request
--

29
servant-client-core/src/Servant/Client/Core/Internal/RunClient.hs
View File

@ -6,24 +6,27 @@
-- | Types for possible backends to run client-side `Request` queries
module Servant.Client.Core.Internal.RunClient where
import Prelude ()
import Prelude ()
import Prelude.Compat
import Control.Monad (unless)
import Control.Monad.Free (Free (..), liftF)
import Data.Foldable (toList)
import Data.Proxy (Proxy)
import Control.Monad
(unless)
import Control.Monad.Free
(Free (..), liftF)
import Data.Foldable
(toList)
import Data.Proxy
(Proxy)
import qualified Data.Text as T
import Network.HTTP.Media (MediaType, matches,
parseAccept, (//))
import Servant.API (MimeUnrender,
contentTypes,
mimeUnrender)
import Network.HTTP.Media
(MediaType, matches, parseAccept, (//))
import Servant.API
(MimeUnrender, contentTypes, mimeUnrender)
import Servant.Client.Core.Internal.Request (Request, Response, GenResponse (..),
StreamingResponse (..),
ServantError (..))
import Servant.Client.Core.Internal.ClientF
import Servant.Client.Core.Internal.Request
(GenResponse (..), Request, Response, ServantError (..),
StreamingResponse (..))
class Monad m => RunClient m where
-- | How to make a request.

2
servant-client-core/src/Servant/Client/Core/Reexport.hs
View File

@ -28,6 +28,6 @@ module Servant.Client.Core.Reexport
import Servant.Client.Core.Internal.BaseUrl
import Servant.Client.Core.Internal.HasClient
import Servant.Client.Core.Internal.Generic
import Servant.Client.Core.Internal.HasClient
import Servant.Client.Core.Internal.Request

15
servant-client-core/src/Servant/Client/Free.hs
View File

@ -1,15 +1,18 @@
{-# LANGUAGE ScopedTypeVariables, FlexibleContexts, GADTs #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Servant.Client.Free (
client,
ClientF (..),
module Servant.Client.Core.Reexport,
) where
import Data.Proxy (Proxy (..))
import Control.Monad.Free
import Servant.Client.Core
import Servant.Client.Core.Reexport
import Servant.Client.Core.Internal.ClientF
import Control.Monad.Free
import Data.Proxy
(Proxy (..))
import Servant.Client.Core
import Servant.Client.Core.Internal.ClientF
import Servant.Client.Core.Reexport
client :: HasClient (Free ClientF) api => Proxy api -> Client (Free ClientF) api
client api = api `clientIn` (Proxy :: Proxy (Free ClientF))