From 2ab4ee48a15da128536b27c77a224c08cd2e9b78 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Sun, 3 Sep 2017 21:24:45 +0200
Subject: Fix build

---
 client/src/Thermoprint/Client.hs | 28 +++++++++++++++++++++++-----
 client/thermoprint-client.cabal  |  1 +
 client/thermoprint-client.nix    |  9 +++++----
 3 files changed, 29 insertions(+), 9 deletions(-)

(limited to 'client')

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 @@
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE UndecidableInstances #-}
 
 -- | A client library for 'Thermoprint.API'
 module Thermoprint.Client
@@ -16,7 +19,7 @@ module Thermoprint.Client
        , module Thermoprint.API
        , module Servant.Common.BaseUrl
        , module Control.Monad.Except
-       , module Servant.Utils.Enter
+       , module Control.Natural
        ) where
 
 import Thermoprint.API
@@ -30,7 +33,8 @@ import Servant.Common.BaseUrl
 import Servant.Common.Req
 import Network.HTTP.Client (Manager, ManagerSettings, newManager, defaultManagerSettings)
 import Servant.API
-import Servant.Utils.Enter
+-- import Servant.Utils.Enter
+import Control.Natural ((:~>)(..))
 import Control.Monad.Except (ExceptT(..), runExceptT)
 
 import Control.Monad.Reader (ReaderT, runReaderT, ask)
@@ -42,6 +46,20 @@ import Control.Monad
 import Control.Category
 import Prelude hiding (id, (.))
 
+
+class Enter typ mod ret | typ mod -> ret, typ ret -> mod, mod ret -> typ where
+  enter :: mod -> typ -> ret
+
+instance Enter (m a) (m :~> n) (n a) where
+  enter (NT f) = f
+
+instance (Enter typ1 mod1 ret1, Enter typ2 mod2 ret2, mod1 ~ mod2) => Enter (typ1 :<|> typ2) mod1 (ret1 :<|> ret2) where
+  enter mod (a :<|> b) = enter mod a :<|> enter mod b
+
+instance Enter typ mod ret => Enter (r -> typ) mod (r -> ret) where
+  enter mod = (enter mod .)
+
+
 -- | All 'ThermoprintAPI'-functions as a record
 --
 -- Use like this:
@@ -105,10 +123,10 @@ mkClientS n = Client{..}
       = enter n $ client thermoprintAPI
 
 mkClient :: (MonadThrow m, MonadIO m) => ManagerSettings -> BaseUrl -> Client m
-mkClient mSettings url = mkClientS $ Nat clientNat
+mkClient mSettings url = mkClientS clientNat
   where
-    clientNat :: forall m a. (MonadThrow m, MonadIO m) => ClientM a -> m a
-    clientNat cAct = do
+    clientNat :: forall m. (MonadThrow m, MonadIO m) => ClientM :~> m
+    clientNat = NT $ \cAct -> do
       mgr <- liftIO $ newManager mSettings
       either throwM return =<< liftIO (runClientM cAct $ ClientEnv mgr url)
 
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
                      , transformers >=0.4.2 && <1
                      , http-client >=0.4.28 && <1
                      , mtl >=2.2.1 && <3
+                     , natural-transformation >=0.4 && <1
   hs-source-dirs:      src
   default-language:    Haskell2010
   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 @@
 { mkDerivation, base, containers, either, exceptions, http-client
-, mtl, servant, servant-client, servant-server, stdenv
-, thermoprint-spec, time, transformers
+, mtl, natural-transformation, servant, servant-client
+, servant-server, stdenv, thermoprint-spec, time, transformers
 }:
 mkDerivation {
   pname = "thermoprint-client";
   version = "2.0.0";
   src = ./.;
   libraryHaskellDepends = [
-    base containers either exceptions http-client mtl servant
-    servant-client servant-server thermoprint-spec time transformers
+    base containers either exceptions http-client mtl
+    natural-transformation servant servant-client servant-server
+    thermoprint-spec time transformers
   ];
   homepage = "http://dirty-haskell.org/tags/thermoprint.html";
   description = "Client for thermoprint-spec";
-- 
cgit v1.2.3