named-servant-client (empty) → 0.0.1

raw patch · 3 files changed

+109/−0 lines, 3 filesdep +basedep +nameddep +named-servant

Dependencies added: base, named, named-servant, servant, servant-client-core

Files

• LICENSE +29/−0
• named-servant-client.cabal +27/−0
• src/Servant/Named/Client.hs +53/−0

@@ -0,0 +1,29 @@+BSD 3-Clause License++Copyright (c) 2020, Kristof Bastiaensen+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+   list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+   this list of conditions and the following disclaimer in the documentation+   and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its+   contributors may be used to endorse or promote products derived from+   this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,27 @@+cabal-version: 1.12+name: named-servant-client+version: 0.0.1+synopsis: client support for named-servant+maintainer: kristof@resonata.be+copyright: Kristof Bastiaensen 2020+license: BSD3+license-file: LICENSE+build-type: Simple++source-repository head+    type: git+    location: https://github.com/kuribas/named-servant-client++library+   default-language: Haskell2010+   Ghc-options: -Wall+   exposed-modules:+        Servant.Named.Client+   hs-source-dirs:+        src+   build-depends:+        base >= 4.7 && < 5,+        servant,+        servant-client-core,+        named-servant,+        named

@@ -0,0 +1,53 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+-- | This module just exports orphan instances to make named-servant+-- work with clients+module Servant.Named.Client () where+import Servant.API+import Servant.Client.Core.HasClient+import Servant.Named+import Servant.API.Modifiers+import Data.Proxy+import GHC.TypeLits+import Data.Functor.Identity+import Named++unarg :: NamedF f a name -> f a+unarg (ArgF a) = a++instance (KnownSymbol sym, ToHttpApiData a, HasClient m api)+      => HasClient m (NamedQueryParams sym a :> api) where++  type Client m (NamedQueryParams sym a :> api) =+    sym :! [a] -> Client m api++  clientWithRoute pm Proxy req (Arg paramlist) =+    clientWithRoute pm (Proxy :: Proxy (QueryParams sym a :> api)) req+                    paramlist+                    +  hoistClientMonad pm _ f cl = \as ->+    hoistClientMonad pm (Proxy :: Proxy api) f (cl as)++instance (KnownSymbol sym, ToHttpApiData a, HasClient m sub,+          SBoolI (FoldRequired mods))+      => HasClient m (NamedQueryParam' mods sym a :> sub) where++  type Client m (NamedQueryParam' mods sym a :> sub) =+    If (FoldRequired mods) (sym :! a) (sym :? a) -> Client m sub++  -- if mparam = Nothing, we don't add it to the query string+  clientWithRoute pm Proxy req mparam =+    clientWithRoute pm (Proxy :: Proxy (QueryParam' mods sym a :> sub)) req $+      case sbool :: SBool (FoldRequired mods) of+        STrue  -> runIdentity (unarg mparam)+        SFalse -> unarg mparam++  hoistClientMonad pm _ f cl = \arg' ->+    hoistClientMonad pm (Proxy :: Proxy sub) f (cl arg')