4 files changed, 48 insertions, 33 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)
 
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";
diff --git a/default.nix b/default.nix
index 4e65886..2b84d30 100644
--- a/default.nix
+++ b/default.nix
@@ -1,10 +1,12 @@
-{ pkgs ? (import <nixpkgs> {})
-, compilerName ? "ghc802"
+args@{
+  compilerName ? "ghc802"
 , extraPackages ? (p: [])
+, ...
 }:
 
-rec {
-  haskellPackages = pkgs.haskell.packages."${compilerName}".override {
+let
+  defaultPackages = import <nixpkgs> {};
+  haskellPackages = defaultPackages.haskell.packages."${compilerName}".override {
     overrides = self: super: with super; {
       # threepenny-gui = pkgs.haskell.lib.appendPatch threepenny-gui ./threepenny.patch;
       encoding = pkgs.haskell.lib.doJailbreak encoding;
@@ -12,25 +14,18 @@ rec {
       extended-reals = pkgs.haskell.lib.doJailbreak extended-reals;
     };
   };
-  thermoprint-spec = haskellPackages.callPackage ./spec/thermoprint-spec.nix {};
-  thermoprint-bbcode = haskellPackages.callPackage ./tp-bbcode/thermoprint-bbcode.nix {
-    inherit bbcode thermoprint-spec;
-  };
-  thermoprint-client = haskellPackages.callPackage ./client/thermoprint-client.nix {
-    inherit thermoprint-spec;
-  };
-  thermoprint-server = pkgs.callPackage ./server/wrapped.nix {
-    inherit (haskellPackages) ghcWithPackages;
-    inherit extraPackages;
-    thermoprint-server = haskellPackages.callPackage ./server/thermoprint-server.nix {
-      inherit thermoprint-spec thermoprint-client;
+  pkgs = defaultPackages // haskellPackages // args;
+  callPackage = pkgs.lib.callPackageWith (pkgs // self);
+  self = {
+    thermoprint-spec = callPackage ./spec/thermoprint-spec.nix {};
+    thermoprint-bbcode = callPackage ./tp-bbcode/thermoprint-bbcode.nix {};
+    thermoprint-client = callPackage ./client/thermoprint-client.nix {};
+    thermoprint-server = callPackage ./server/wrapped.nix {
+      inherit extraPackages;
+      thermoprint-server = callPackage ./server/thermoprint-server.nix {};
     };
+    thermoprint-webgui = callPackage ./webgui/thermoprint-webgui.nix {};
+    tprint = callPackage ./tprint/tprint.nix {};
+    bbcode = callPackage ./bbcode/bbcode.nix {};
   };
-  thermoprint-webgui = haskellPackages.callPackage ./webgui/thermoprint-webgui.nix {
-    inherit thermoprint-bbcode thermoprint-client;
-  };
-  tprint = haskellPackages.callPackage ./tprint/tprint.nix {
-    inherit thermoprint-bbcode thermoprint-client;
-  };
-  bbcode = haskellPackages.callPackage ./bbcode/bbcode.nix {};
-}
+in self