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 +++++++++++++++++++++++----- 1 file changed, 23 insertions(+), 5 deletions(-) (limited to 'client/src/Thermoprint/Client.hs') 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) -- cgit v1.2.3