diff options
author | Gregor Kleen <gkleen@yggdrasil.li> | 2017-09-03 21:24:45 +0200 |
---|---|---|
committer | Gregor Kleen <gkleen@yggdrasil.li> | 2017-09-03 21:24:45 +0200 |
commit | 2ab4ee48a15da128536b27c77a224c08cd2e9b78 (patch) | |
tree | ad409d465a1f1f69e5423f2c784fd9d60c6b0f13 /client | |
parent | cbe2b674b3a9297321dfb62cf294bb0f270ea731 (diff) | |
download | thermoprint-2ab4ee48a15da128536b27c77a224c08cd2e9b78.tar thermoprint-2ab4ee48a15da128536b27c77a224c08cd2e9b78.tar.gz thermoprint-2ab4ee48a15da128536b27c77a224c08cd2e9b78.tar.bz2 thermoprint-2ab4ee48a15da128536b27c77a224c08cd2e9b78.tar.xz thermoprint-2ab4ee48a15da128536b27c77a224c08cd2e9b78.zip |
Fix build
Diffstat (limited to 'client')
-rw-r--r-- | client/src/Thermoprint/Client.hs | 28 | ||||
-rw-r--r-- | client/thermoprint-client.cabal | 1 | ||||
-rw-r--r-- | client/thermoprint-client.nix | 9 |
3 files changed, 29 insertions, 9 deletions
diff --git a/client/src/Thermoprint/Client.hs b/client/src/Thermoprint/Client.hs index 46f6073..8c4d99d 100644 --- a/client/src/Thermoprint/Client.hs +++ b/client/src/Thermoprint/Client.hs | |||
@@ -5,7 +5,10 @@ | |||
5 | {-# LANGUAGE RecordWildCards #-} | 5 | {-# LANGUAGE RecordWildCards #-} |
6 | {-# LANGUAGE FlexibleContexts #-} | 6 | {-# LANGUAGE FlexibleContexts #-} |
7 | {-# LANGUAGE FlexibleInstances #-} | 7 | {-# LANGUAGE FlexibleInstances #-} |
8 | {-# LANGUAGE MultiParamTypeClasses #-} | ||
8 | {-# LANGUAGE RankNTypes #-} | 9 | {-# LANGUAGE RankNTypes #-} |
10 | {-# LANGUAGE FunctionalDependencies #-} | ||
11 | {-# LANGUAGE UndecidableInstances #-} | ||
9 | 12 | ||
10 | -- | A client library for 'Thermoprint.API' | 13 | -- | A client library for 'Thermoprint.API' |
11 | module Thermoprint.Client | 14 | module Thermoprint.Client |
@@ -16,7 +19,7 @@ module Thermoprint.Client | |||
16 | , module Thermoprint.API | 19 | , module Thermoprint.API |
17 | , module Servant.Common.BaseUrl | 20 | , module Servant.Common.BaseUrl |
18 | , module Control.Monad.Except | 21 | , module Control.Monad.Except |
19 | , module Servant.Utils.Enter | 22 | , module Control.Natural |
20 | ) where | 23 | ) where |
21 | 24 | ||
22 | import Thermoprint.API | 25 | import Thermoprint.API |
@@ -30,7 +33,8 @@ import Servant.Common.BaseUrl | |||
30 | import Servant.Common.Req | 33 | import Servant.Common.Req |
31 | import Network.HTTP.Client (Manager, ManagerSettings, newManager, defaultManagerSettings) | 34 | import Network.HTTP.Client (Manager, ManagerSettings, newManager, defaultManagerSettings) |
32 | import Servant.API | 35 | import Servant.API |
33 | import Servant.Utils.Enter | 36 | -- import Servant.Utils.Enter |
37 | import Control.Natural ((:~>)(..)) | ||
34 | import Control.Monad.Except (ExceptT(..), runExceptT) | 38 | import Control.Monad.Except (ExceptT(..), runExceptT) |
35 | 39 | ||
36 | import Control.Monad.Reader (ReaderT, runReaderT, ask) | 40 | import Control.Monad.Reader (ReaderT, runReaderT, ask) |
@@ -42,6 +46,20 @@ import Control.Monad | |||
42 | import Control.Category | 46 | import Control.Category |
43 | import Prelude hiding (id, (.)) | 47 | import Prelude hiding (id, (.)) |
44 | 48 | ||
49 | |||
50 | class Enter typ mod ret | typ mod -> ret, typ ret -> mod, mod ret -> typ where | ||
51 | enter :: mod -> typ -> ret | ||
52 | |||
53 | instance Enter (m a) (m :~> n) (n a) where | ||
54 | enter (NT f) = f | ||
55 | |||
56 | instance (Enter typ1 mod1 ret1, Enter typ2 mod2 ret2, mod1 ~ mod2) => Enter (typ1 :<|> typ2) mod1 (ret1 :<|> ret2) where | ||
57 | enter mod (a :<|> b) = enter mod a :<|> enter mod b | ||
58 | |||
59 | instance Enter typ mod ret => Enter (r -> typ) mod (r -> ret) where | ||
60 | enter mod = (enter mod .) | ||
61 | |||
62 | |||
45 | -- | All 'ThermoprintAPI'-functions as a record | 63 | -- | All 'ThermoprintAPI'-functions as a record |
46 | -- | 64 | -- |
47 | -- Use like this: | 65 | -- Use like this: |
@@ -105,10 +123,10 @@ mkClientS n = Client{..} | |||
105 | = enter n $ client thermoprintAPI | 123 | = enter n $ client thermoprintAPI |
106 | 124 | ||
107 | mkClient :: (MonadThrow m, MonadIO m) => ManagerSettings -> BaseUrl -> Client m | 125 | mkClient :: (MonadThrow m, MonadIO m) => ManagerSettings -> BaseUrl -> Client m |
108 | mkClient mSettings url = mkClientS $ Nat clientNat | 126 | mkClient mSettings url = mkClientS clientNat |
109 | where | 127 | where |
110 | clientNat :: forall m a. (MonadThrow m, MonadIO m) => ClientM a -> m a | 128 | clientNat :: forall m. (MonadThrow m, MonadIO m) => ClientM :~> m |
111 | clientNat cAct = do | 129 | clientNat = NT $ \cAct -> do |
112 | mgr <- liftIO $ newManager mSettings | 130 | mgr <- liftIO $ newManager mSettings |
113 | either throwM return =<< liftIO (runClientM cAct $ ClientEnv mgr url) | 131 | either throwM return =<< liftIO (runClientM cAct $ ClientEnv mgr url) |
114 | 132 | ||
diff --git a/client/thermoprint-client.cabal b/client/thermoprint-client.cabal index 1306542..523b755 100644 --- a/client/thermoprint-client.cabal +++ b/client/thermoprint-client.cabal | |||
@@ -32,6 +32,7 @@ library | |||
32 | , transformers >=0.4.2 && <1 | 32 | , transformers >=0.4.2 && <1 |
33 | , http-client >=0.4.28 && <1 | 33 | , http-client >=0.4.28 && <1 |
34 | , mtl >=2.2.1 && <3 | 34 | , mtl >=2.2.1 && <3 |
35 | , natural-transformation >=0.4 && <1 | ||
35 | hs-source-dirs: src | 36 | hs-source-dirs: src |
36 | default-language: Haskell2010 | 37 | default-language: Haskell2010 |
37 | ghc-options: -Wall | 38 | ghc-options: -Wall |
diff --git a/client/thermoprint-client.nix b/client/thermoprint-client.nix index 7f83630..0046a0f 100644 --- a/client/thermoprint-client.nix +++ b/client/thermoprint-client.nix | |||
@@ -1,14 +1,15 @@ | |||
1 | { mkDerivation, base, containers, either, exceptions, http-client | 1 | { mkDerivation, base, containers, either, exceptions, http-client |
2 | , mtl, servant, servant-client, servant-server, stdenv | 2 | , mtl, natural-transformation, servant, servant-client |
3 | , thermoprint-spec, time, transformers | 3 | , servant-server, stdenv, thermoprint-spec, time, transformers |
4 | }: | 4 | }: |
5 | mkDerivation { | 5 | mkDerivation { |
6 | pname = "thermoprint-client"; | 6 | pname = "thermoprint-client"; |
7 | version = "2.0.0"; | 7 | version = "2.0.0"; |
8 | src = ./.; | 8 | src = ./.; |
9 | libraryHaskellDepends = [ | 9 | libraryHaskellDepends = [ |
10 | base containers either exceptions http-client mtl servant | 10 | base containers either exceptions http-client mtl |
11 | servant-client servant-server thermoprint-spec time transformers | 11 | natural-transformation servant servant-client servant-server |
12 | thermoprint-spec time transformers | ||
12 | ]; | 13 | ]; |
13 | homepage = "http://dirty-haskell.org/tags/thermoprint.html"; | 14 | homepage = "http://dirty-haskell.org/tags/thermoprint.html"; |
14 | description = "Client for thermoprint-spec"; | 15 | description = "Client for thermoprint-spec"; |