From 7065a8cc1b8b01cd32d4b1d5317b323fec5238bd Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Tue, 7 Mar 2017 14:16:21 +0100 Subject: Bump versions --- client/src/Thermoprint/Client.hs | 55 ++++++++++------------------------------ client/thermoprint-client.cabal | 4 +-- client/thermoprint-client.nix | 2 +- 3 files changed, 17 insertions(+), 44 deletions(-) (limited to 'client') diff --git a/client/src/Thermoprint/Client.hs b/client/src/Thermoprint/Client.hs index 448a912..46f6073 100644 --- a/client/src/Thermoprint/Client.hs +++ b/client/src/Thermoprint/Client.hs @@ -5,12 +5,12 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE RankNTypes #-} -- | A client library for 'Thermoprint.API' module Thermoprint.Client ( Client(..) , mkClient, mkClient' - , throwNat, ioNat -- = Reexports , ServantError(..) , module Thermoprint.API @@ -27,10 +27,11 @@ import Data.Time (UTCTime) import Servant.Client hiding (HasClient(..)) import qualified Servant.Client as S import Servant.Common.BaseUrl +import Servant.Common.Req import Network.HTTP.Client (Manager, ManagerSettings, newManager, defaultManagerSettings) import Servant.API import Servant.Utils.Enter -import Control.Monad.Except (ExceptT, runExceptT) +import Control.Monad.Except (ExceptT(..), runExceptT) import Control.Monad.Reader (ReaderT, runReaderT, ask) import Control.Monad.Catch (Exception, MonadThrow(..)) @@ -92,29 +93,10 @@ withArgs subAPI = (\(a :<|> _) -> a) . subAPI :<|> (\(_ :<|> b) -> b) . subAPI mkClientS :: Monad m => (ClientM :~> m) -- ^ A monad functor ('Nat') used to make the api functions work in any monad which can do 'IO' and handle errors - -> ManagerSettings - -> BaseUrl -> Client m -- ^ Generate a 'Client' -mkClientS n mgrS url = Client - { printers = clientF n printers - , jobs = \a b c -> clientF n $ jobs a b c - , jobCreate = \a b -> clientF n $ jobCreate a b - , job = \a -> clientF n $ job a - , jobStatus = \a -> clientF n $ jobStatus a - , jobDelete = \a -> clientF n $ jobDelete a - , drafts = clientF n drafts - , draftCreate = \a b -> clientF n $ draftCreate a b - , draftReplace = \a b c -> clientF n $ draftReplace a b c - , draft = \a -> clientF n $ draft a - , draftDelete = \a -> clientF n $ draftDelete a - , draftPrint = \a b -> clientF n $ draftPrint a b - } +mkClientS n = Client{..} where - clientF :: Monad m => (ClientM :~> m) -> (Manager -> BaseUrl -> m a) -> m a - clientF n f = do - mgr <- unNat n $ (liftIO $ newManager mgrS :: ClientM Manager) - f mgr url printers :<|> (jobs :<|> jobCreate) :<|> (withArgs -> job :<|> (withArgs -> jobStatus :<|> jobDelete)) @@ -122,23 +104,14 @@ mkClientS n mgrS url = Client :<|> (withArgs -> draftReplace :<|> (withArgs -> draft :<|> (withArgs -> draftDelete :<|> draftPrint))) = enter n $ client thermoprintAPI -mkClient :: Monad m - => (ClientM :~> m) -- ^ A monad functor ('Nat') used to make the api functions work in any monad which can do 'IO' and handle errors - -> BaseUrl - -> Client m -mkClient n url = mkClientS n defaultManagerSettings url - -mkClient' :: (MonadThrow m, MonadIO m) => BaseUrl -> Client m --- ^ @mkClient' = mkClient $ ioNat . throwNat@ -mkClient' = mkClient $ ioNat . throwNat - -throwNat :: (Exception e, MonadThrow m) => ExceptT e m :~> m --- ^ Squash a layer of 'EitherT' into the underlying monad supporting 'throwM' -throwNat = Nat $ either throwM return <=< runExceptT - -ioNat :: MonadIO m => IO :~> m --- ^ @ioNat = Nat liftIO@ -ioNat = Nat liftIO +mkClient :: (MonadThrow m, MonadIO m) => ManagerSettings -> BaseUrl -> Client m +mkClient mSettings url = mkClientS $ Nat clientNat + where + clientNat :: forall m a. (MonadThrow m, MonadIO m) => ClientM a -> m a + clientNat cAct = do + mgr <- liftIO $ newManager mSettings + either throwM return =<< liftIO (runClientM cAct $ ClientEnv mgr url) -readerNat :: a -> ReaderT a m :~> m -readerNat a = Nat $ flip runReaderT a +mkClient' :: (MonadThrow m, MonadIO m) => BaseUrl -> Client m +-- ^ @mkClient' = mkClient defaultManagerSettings +mkClient' = mkClient defaultManagerSettings diff --git a/client/thermoprint-client.cabal b/client/thermoprint-client.cabal index 0920773..1306542 100644 --- a/client/thermoprint-client.cabal +++ b/client/thermoprint-client.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: thermoprint-client -version: 1.0.1 +version: 2.0.0 synopsis: Client for thermoprint-spec -- description: homepage: http://dirty-haskell.org/tags/thermoprint.html @@ -21,7 +21,7 @@ library -- other-modules: -- other-extensions: build-depends: base >=4.8 && <5 - , thermoprint-spec ==5.0.* + , thermoprint-spec ==6.0.* , servant >=0.4.4 && <1 , servant-client >=0.4.4 && <1 , servant-server >=0.4.4 && <1 diff --git a/client/thermoprint-client.nix b/client/thermoprint-client.nix index 8aadafb..7f83630 100644 --- a/client/thermoprint-client.nix +++ b/client/thermoprint-client.nix @@ -4,7 +4,7 @@ }: mkDerivation { pname = "thermoprint-client"; - version = "1.0.1"; + version = "2.0.0"; src = ./.; libraryHaskellDepends = [ base containers either exceptions http-client mtl servant -- cgit v1.2.3