1 files changed, 23 insertions, 5 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 @@
 {-# 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)