packages feed

jordan-servant-client (empty) → 0.1.0.0

raw patch · 6 files changed

+163/−0 lines, 6 filesdep +attoparsecdep +basedep +bytestring

Dependencies added: attoparsec, base, bytestring, http-media, http-types, jordan, jordan-servant, servant, servant-client-core, servant-server, text, transformers

Files

+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for jordan-servant-client++## 0.1.0.0 -- 2022-07-04++* First version. Contains orphans for everything in the `jordan-servant` package.
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2022 Anthony Super++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.
+ jordan-servant-client.cabal view
@@ -0,0 +1,59 @@+cabal-version:      2.4+name:               jordan-servant-client+version:            0.1.0.0+synopsis:           Servant Client Instances for Jordan Servant Types++-- A longer description of the package.+description:+  Jordan Servant Client provides orphan instances so you can use Jordan types in a Servant client.+  This module is only designed to be used with Jordan-Servant-Server.+homepage:           https://github.com/AnthonySuper/jordan++-- A URL where users can report bugs.+-- bug-reports:+license:            MIT+license-file:       LICENSE+author:             Anthony Super+maintainer:         anthony@noided.media++-- A copyright notice.+-- copyright:+category:           Web+extra-source-files: CHANGELOG.md++common build-deps+  build-depends:+    , attoparsec >= 0.14.1 && <0.15+    , bytestring >= 0.10.8.1 && <0.12+    , jordan-servant >= 0.1.0.0 && <0.3+    , servant >= 0.18 && <0.20+    , text >= 1.2.3.0 && <1.3+    , servant-server >= 0.19 && <0.20+    , jordan >=0.2 && <=0.3+    , http-types >= 0.12.2 && <0.13+    , http-media >= 0.7 && <0.9+    , transformers >=0.5.5 && <= 0.7+    , servant-client-core >=0.18 && <0.20+    , base >= 4.14.1 && <4.17+++library+    import: build-deps+    exposed-modules:+        Jordan.Servant.Client+      , Jordan.Servant.Client.Query++    -- Modules included in this library but not exported.+    -- other-modules:++    -- LANGUAGE extensions used by modules in this package.+    -- other-extensions:+    hs-source-dirs:   lib+    default-language: Haskell2010++test-suite jordan-servant-client-test+    import: build-deps+    default-language: Haskell2010+    type:             exitcode-stdio-1.0+    hs-source-dirs:   test+    main-is:          MyLibTest.hs
+ lib/Jordan/Servant/Client.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++module Jordan.Servant.Client+  ( HasClient (..),+    JordanQuery',+    ReportingRequestBody,+  )+where++import Data.Proxy+import Jordan+import Jordan.Servant+import Jordan.Servant.Client.Query+import Network.HTTP.Media+import Servant.API+import Servant.API.Modifiers+import Servant.Client.Core++-- | Note: This instance assumes that the 'Jordan.FromJSON' and 'Jordan.ToJSON' instances match.+-- This should be true for all types, ideally.+instance forall a m api. (ToJSON a, HasClient m api) => HasClient m (ReportingRequestBody a :> api) where+  type Client m (ReportingRequestBody a :> api) = a -> Client m api+  clientWithRoute pm Proxy req body =+    clientWithRoute pm (Proxy :: Proxy api) $ setRequestBodyLBS (toJSONViaBuilder body) ("application" // "json") req+  hoistClientMonad pm Proxy f cl = hoistClientMonad pm (Proxy @api) f . cl
+ lib/Jordan/Servant/Client/Query.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++module Jordan.Servant.Client.Query where++import Data.Proxy (Proxy (Proxy))+import qualified Data.Text as T+import GHC.Exts (IsList (..))+import GHC.TypeLits+import Jordan+import Jordan.Servant.Query+import Jordan.Servant.Query.Render+import Servant.API+import Servant.API.Modifiers+import Servant.Client.Core++-- | Note: this instances assumes that the Jordan.FromJSON and Jordan.ToJSON instances match.+instance+  forall a sym m api mods.+  (KnownSymbol sym, ToJSON a, HasClient m api, SBoolI (FoldRequired mods)) =>+  HasClient m (JordanQuery' sym mods a :> api)+  where+  type Client m (JordanQuery' sym mods a :> api) = RequiredArgument mods a -> Client m api+  clientWithRoute pm Proxy req mparam =+    clientWithRoute pm (Proxy @api) $ foldRequiredArgument (Proxy @mods) add (maybe req add) mparam+    where+      add :: a -> Request+      add param =+        req {requestQueryString = requestQueryString req <> newItems}+        where+          newItems =+            fromList $+              renderQueryAtKey+                (T.pack $ symbolVal $ Proxy @sym)+                param+  hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy @api) f . cl
+ test/MyLibTest.hs view
@@ -0,0 +1,4 @@+module Main (main) where++main :: IO ()+main = putStrLn "Test suite not yet implemented."