From 2ab4ee48a15da128536b27c77a224c08cd2e9b78 Mon Sep 17 00:00:00 2001 From: Gregor Kleen 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 +++++---- default.nix | 43 ++++++++++++++++++---------------------- 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 {}) -, compilerName ? "ghc802" +args@{ + compilerName ? "ghc802" , extraPackages ? (p: []) +, ... }: -rec { - haskellPackages = pkgs.haskell.packages."${compilerName}".override { +let + defaultPackages = import {}; + 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 -- cgit v1.2.3