diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,9 @@ +## 2.1.0.0 + +* Add support for servant-0.16 and remove support for all previous version of + servant. [#31](https://github.com/cdepillabout/servant-checked-exceptions/pull/31) + Thanks [Schell Carl Scivally](https://github.com/schell)! + ## 2.0.0.0 * Split into two package `servant-checked-exceptions-core` and @@ -6,7 +12,7 @@ the latter reexports the former and adds instances for `HasServer` and `HasClient`. The rationale is described further in [issue 25](https://github.com/cdepillabout/servant-checked-exceptions/issues/25) - + Most users should only depend on `servant-checked-exceptions`. But users who need access to core types without incurring a dependency on `servant-server` and `servant-client` can depend on diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -220,3 +220,7 @@ shared with ghcjs and run in a browser, where these dependencies aren't available. +## Maintainers + +- [![Maintainer: cdepillabout](https://img.shields.io/badge/maintainer-cdepillabout-lightgrey.svg)](http://github.com/cdepillabout) +- [![Maintainer: imalsogreg](https://img.shields.io/badge/maintainer-imalsogreg-lightgrey.svg)](http://github.com/imalsogreg) diff --git a/example/Docs.hs b/example/Docs.hs deleted file mode 100644 --- a/example/Docs.hs +++ /dev/null @@ -1,63 +0,0 @@ -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE EmptyCase #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} - -module Main where - -import Data.Proxy (Proxy(Proxy)) -import Data.Text (Text) -import Servant.API (Capture) -import Servant.Docs - (DocCapture(DocCapture), ToCapture(toCapture), ToSample(toSamples), - docs, markdown) - -import Servant.Checked.Exceptions () - -import Api - (Api, BadSearchTermErr(BadSearchTermErr), - IncorrectCapitalization(IncorrectCapitalization), SearchQuery, - SearchResponse) - --- This module prints out documentation for 'Api'. --- --- Notice how we only need 'ToSample' instances for the two errors we are --- throwing with 'Throws': 'BadSearchTermErr' and 'IncorrectCapitialization'. --- We don't have to directly worry about writing instances for 'Envelope'. - -instance ToSample SearchResponse where - toSamples :: Proxy SearchResponse -> [(Text, SearchResponse)] - toSamples Proxy = [("This is a successful response.", "good")] - -instance ToCapture (Capture "query" SearchQuery) where - toCapture :: Proxy (Capture "query" SearchQuery) -> DocCapture - toCapture Proxy = - DocCapture "query" "a search string like \"hello\" or \"bye\"" - -instance ToSample BadSearchTermErr where - toSamples :: Proxy BadSearchTermErr -> [(Text, BadSearchTermErr)] - toSamples Proxy = - [("a completely incorrect search term was used", BadSearchTermErr)] - -instance ToSample IncorrectCapitalization where - toSamples :: Proxy IncorrectCapitalization -> [(Text, IncorrectCapitalization)] - toSamples Proxy = - [ ( "the search term \"Hello\" has not been capitalized correctly" - , IncorrectCapitalization) - ] - --- | Print the documentation rendered as markdown to stdout. -main :: IO () -main = putStrLn . markdown $ docs (Proxy :: Proxy Api) diff --git a/servant-checked-exceptions.cabal b/servant-checked-exceptions.cabal --- a/servant-checked-exceptions.cabal +++ b/servant-checked-exceptions.cabal @@ -1,5 +1,5 @@ name: servant-checked-exceptions -version: 2.0.0.0 +version: 2.1.0.0 synopsis: Checked exceptions for Servant APIs. description: Please see . homepage: https://github.com/cdepillabout/servant-checked-exceptions @@ -8,7 +8,7 @@ author: Dennis Gosnell maintainer: cdep.illabout@gmail.com copyright: 2017-2018 Dennis Gosnell -category: Text +category: Web build-type: Simple extra-source-files: CHANGELOG.md , README.md @@ -27,20 +27,13 @@ , Servant.Checked.Exceptions.Internal.Servant.Client , Servant.Checked.Exceptions.Internal.Servant.Server build-depends: base >= 4.9 && < 5 - , aeson , bytestring - , deepseq - , http-media , http-types - , profunctors - , tagged - , servant >= 0.12 + , servant >= 0.16 , servant-checked-exceptions-core - , servant-client >= 0.12 - , servant-client-core >= 0.12 - , servant-docs >= 0.10 - , servant-server >= 0.12 - , text + , servant-client >= 0.16 + , servant-client-core >= 0.16 + , servant-server >= 0.16 , wai , world-peace default-language: Haskell2010 @@ -60,27 +53,7 @@ , optparse-applicative , servant , servant-checked-exceptions - , servant-client - , text - default-language: Haskell2010 - ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N - - if flag(buildexample) - buildable: True - else - buildable: False - -executable servant-checked-exceptions-example-docs - main-is: Docs.hs - other-modules: Api - hs-source-dirs: example - build-depends: base - , aeson - , http-api-data - , http-types - , servant - , servant-checked-exceptions - , servant-docs + , servant-client >= 0.13 , text default-language: Haskell2010 ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N @@ -98,7 +71,6 @@ , aeson , http-api-data , http-types - , natural-transformation , servant , servant-checked-exceptions , servant-server @@ -119,11 +91,10 @@ other-modules: hs-source-dirs: test build-depends: base - , bytestring , hspec-wai , http-types , tasty - , tasty-hspec + , tasty-hspec >= 0.2 , tasty-hunit , servant , servant-checked-exceptions diff --git a/src/Servant/Checked/Exceptions/Internal/Servant/Client.hs b/src/Servant/Checked/Exceptions/Internal/Servant/Client.hs --- a/src/Servant/Checked/Exceptions/Internal/Servant/Client.hs +++ b/src/Servant/Checked/Exceptions/Internal/Servant/Client.hs @@ -6,6 +6,7 @@ {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} @@ -46,8 +47,17 @@ -> Proxy (Throws e :> api) -> Request -> Client m (Throwing '[e] :> api) - clientWithRoute p Proxy = clientWithRoute p (Proxy :: Proxy (Throwing '[e] :> api)) + clientWithRoute p Proxy = clientWithRoute p (Proxy @(Throwing '[e] :> api)) + hoistClientMonad + :: Proxy m + -> Proxy (Throws e :> api) + -> (forall x. mon x -> mon' x) + -> Client mon (Throws e :> api) + -> Client mon' (Throwing '[e] :> api) + hoistClientMonad pm _ = hoistClientMonad pm (Proxy @(Throwing '[e] :> api)) + + -- | When @'Throwing' es@ comes before a 'Verb', change it into the same 'Verb' -- but returning an @'Envelope' es@. instance (HasClient m (Verb method status ctypes (Envelope es a))) => @@ -64,6 +74,17 @@ clientWithRoute p Proxy = clientWithRoute p (Proxy :: Proxy (Verb method status ctypes (Envelope es a))) + hoistClientMonad + :: Proxy m + -> Proxy (Throwing es :> Verb method status ctypes a) + -> (forall x. mon x -> mon' x) + -> Client mon (Throwing es :> Verb method status ctypes a) + -> Client mon' (Verb method status ctypes (Envelope es a)) + hoistClientMonad pm _ = + hoistClientMonad pm (Proxy @(Verb method status ctypes (Envelope es a))) + + + -- | When 'NoThrow' comes before a 'Verb', change it into the same 'Verb' -- but returning an @'Envelope' \'[]@. instance (RunClient m, HasClient m (Verb method status ctypes (Envelope '[] a))) => @@ -80,6 +101,16 @@ clientWithRoute p Proxy = clientWithRoute p (Proxy :: Proxy (Verb method status ctypes (Envelope '[] a))) + hoistClientMonad + :: Proxy m + -> Proxy (NoThrow :> Verb method status ctypes a) + -> (forall x. mon x -> mon' x) + -> Client mon (NoThrow :> Verb method status ctypes a) + -> Client mon' (Verb method status ctypes (Envelope '[] a)) + hoistClientMonad pm _ = + hoistClientMonad pm (Proxy @(Verb method status ctypes (Envelope '[] a))) + + -- | When @'Throwing' es@ comes before ':<|>', push @'Throwing' es@ into each -- branch of the API. instance (RunClient m, HasClient m ((Throwing es :> api1) :<|> (Throwing es :> api2))) => @@ -96,6 +127,16 @@ clientWithRoute p _ = clientWithRoute p (Proxy :: Proxy ((Throwing es :> api1) :<|> (Throwing es :> api2))) + hoistClientMonad + :: Proxy m + -> Proxy (Throwing es :> (api1 :<|> api2)) + -> (forall x. mon x -> mon' x) + -> Client mon (Throwing es :> (api1 :<|> api2)) + -> Client mon' ((Throwing es :> api1) :<|> (Throwing es :> api2)) + hoistClientMonad pm _ = + hoistClientMonad pm (Proxy @(Throwing es :> (api1 :<|> api2))) + + -- | When 'NoThrow' comes before ':<|>', push 'NoThrow' into each branch of the -- API. instance (RunClient m, HasClient m ((NoThrow :> api1) :<|> (NoThrow :> api2))) => @@ -112,6 +153,16 @@ clientWithRoute p _ = clientWithRoute p (Proxy :: Proxy ((NoThrow :> api1) :<|> (NoThrow :> api2))) + hoistClientMonad + :: Proxy m + -> Proxy (NoThrow :> (api1 :<|> api2)) + -> (forall x. mon x -> mon' x) + -> Client mon (NoThrow :> (api1 :<|> api2)) + -> Client mon' ((NoThrow :> api1) :<|> (NoThrow :> api2)) + hoistClientMonad pm _ = + hoistClientMonad pm (Proxy @(NoThrow :> (api1 :<|> api2))) + + -- | When a @'Throws' e@ comes immediately after a @'Throwing' es@, 'Snoc' the -- @e@ onto the @es@. Otherwise, if @'Throws' e@ comes before any other -- combinator, push it down so it is closer to the 'Verb'. @@ -129,6 +180,16 @@ clientWithRoute p _ = clientWithRoute p (Proxy :: Proxy (ThrowingNonterminal (Throwing es :> api :> apis))) + hoistClientMonad + :: Proxy m + -> Proxy (Throwing es :> api :> apis) + -> (forall x. mon x -> mon' x) + -> Client mon (Throwing es :> api :> apis) + -> Client mon' (ThrowingNonterminal (Throwing es :> api :> apis)) + hoistClientMonad pm _ = + hoistClientMonad pm (Proxy @(ThrowingNonterminal (Throwing es :> api :> apis))) + + -- | When 'NoThrow' comes before any other combinator, push it down so it is -- closer to the 'Verb'. instance (RunClient m, HasClient m (api :> NoThrow :> apis)) => @@ -144,3 +205,12 @@ -> Client m (api :> NoThrow :> apis) clientWithRoute p _ = clientWithRoute p (Proxy :: Proxy (api :> NoThrow :> apis)) + + hoistClientMonad + :: Proxy m + -> Proxy (NoThrow :> api :> apis) + -> (forall x. mon x -> mon' x) + -> Client mon (NoThrow :> api :> apis) + -> Client mon' (api :> NoThrow :> apis) + hoistClientMonad pm _ = + hoistClientMonad pm (Proxy @(api :> NoThrow :> apis)) diff --git a/src/Servant/Checked/Exceptions/Internal/Servant/Server.hs b/src/Servant/Checked/Exceptions/Internal/Servant/Server.hs --- a/src/Servant/Checked/Exceptions/Internal/Servant/Server.hs +++ b/src/Servant/Checked/Exceptions/Internal/Servant/Server.hs @@ -45,13 +45,12 @@ ) import Servant.Server.Internal (ct_wildcard) import Servant.Server.Internal.Router (Router, Router', leafRouter) -import Servant.Server.Internal.RoutingApplication +import Servant.Server.Internal.RouteResult (RouteResult(FailFatal, Route)) +import Servant.Server.Internal.DelayedIO (DelayedIO, delayedFail) +import Servant.Server.Internal.Delayed ( Delayed - , DelayedIO - , RouteResult(FailFatal, Route) , addAcceptCheck , addMethodCheck - , delayedFail , runAction ) import Servant @@ -90,8 +89,8 @@ type ServerT (Throws e :> api) m = ServerT (Throwing '[e] :> api) m - hoistServerWithContext _ pc nt s = - hoistServerWithContext (Proxy :: Proxy (Throwing '[e] :> api)) pc nt s + hoistServerWithContext _ = + hoistServerWithContext (Proxy :: Proxy (Throwing '[e] :> api)) route :: Proxy (Throws e :> api) @@ -230,7 +229,7 @@ type ServerT (VerbWithErr method successStatus ctypes es a) m = m (Envelope es a) - hoistServerWithContext _ _ nt s = nt s + hoistServerWithContext _ _ nt = nt route :: Proxy (VerbWithErr method successStatus ctypes es a) @@ -317,4 +316,4 @@ Just (contentT, body) -> Route $ responseLBS status hdrs bdy where bdy = if allowedMethodHead method request then "" else body - hdrs = (hContentType, LBS.toStrict contentT) : (fromMaybe [] headers) + hdrs = (hContentType, LBS.toStrict contentT) : fromMaybe [] headers