packages feed

servant-checked-exceptions 0.4.0.0 → 0.4.1.0

raw patch · 13 files changed

+292/−36 lines, 13 filesdep ~servantPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: servant

API changes (from Hackage documentation)

+ Servant.Checked.Exceptions: data NoThrow
+ Servant.Checked.Exceptions: emptyEnvelope :: Envelope '[] a -> a
+ Servant.Checked.Exceptions.Internal.Envelope: emptyEnvelope :: Envelope '[] a -> a
+ Servant.Checked.Exceptions.Internal.Servant.API: data NoThrow
+ Servant.Checked.Exceptions.Internal.Servant.Client: instance Servant.Client.HasClient ((Servant.Checked.Exceptions.Internal.Servant.API.NoThrow Servant.API.Sub.:> api1) Servant.API.Alternative.:<|> (Servant.Checked.Exceptions.Internal.Servant.API.NoThrow Servant.API.Sub.:> api2)) => Servant.Client.HasClient (Servant.Checked.Exceptions.Internal.Servant.API.NoThrow Servant.API.Sub.:> (api1 Servant.API.Alternative.:<|> api2))
+ Servant.Checked.Exceptions.Internal.Servant.Client: instance forall k k1 (api :: k1) (apis :: k). Servant.Client.HasClient (api Servant.API.Sub.:> (Servant.Checked.Exceptions.Internal.Servant.API.NoThrow Servant.API.Sub.:> apis)) => Servant.Client.HasClient (Servant.Checked.Exceptions.Internal.Servant.API.NoThrow Servant.API.Sub.:> (api Servant.API.Sub.:> apis))
+ Servant.Checked.Exceptions.Internal.Servant.Client: instance forall k1 (method :: k1) (status :: GHC.Types.Nat) (ctypes :: [GHC.Types.*]) a. Servant.Client.HasClient (Servant.API.Verbs.Verb method status ctypes (Servant.Checked.Exceptions.Internal.Envelope.Envelope '[] a)) => Servant.Client.HasClient (Servant.Checked.Exceptions.Internal.Servant.API.NoThrow Servant.API.Sub.:> Servant.API.Verbs.Verb method status ctypes a)
+ Servant.Checked.Exceptions.Internal.Servant.Docs: instance forall k1 (method :: k1) (status :: GHC.Types.Nat) (ctypes :: [GHC.Types.*]) a. Servant.Docs.Internal.HasDocs (Servant.API.Verbs.Verb method status ctypes (Servant.Checked.Exceptions.Internal.Envelope.Envelope '[] a)) => Servant.Docs.Internal.HasDocs (Servant.Checked.Exceptions.Internal.Servant.API.NoThrow Servant.API.Sub.:> Servant.API.Verbs.Verb method status ctypes a)
+ Servant.Checked.Exceptions.Internal.Servant.Server: instance Servant.Server.Internal.HasServer ((Servant.Checked.Exceptions.Internal.Servant.API.NoThrow Servant.API.Sub.:> api1) Servant.API.Alternative.:<|> (Servant.Checked.Exceptions.Internal.Servant.API.NoThrow Servant.API.Sub.:> api2)) context => Servant.Server.Internal.HasServer (Servant.Checked.Exceptions.Internal.Servant.API.NoThrow Servant.API.Sub.:> (api1 Servant.API.Alternative.:<|> api2)) context
+ Servant.Checked.Exceptions.Internal.Servant.Server: instance forall k k1 (api :: k1) (apis :: k) (context :: [*]). Servant.Server.Internal.HasServer (api Servant.API.Sub.:> (Servant.Checked.Exceptions.Internal.Servant.API.NoThrow Servant.API.Sub.:> apis)) context => Servant.Server.Internal.HasServer (Servant.Checked.Exceptions.Internal.Servant.API.NoThrow Servant.API.Sub.:> (api Servant.API.Sub.:> apis)) context
+ Servant.Checked.Exceptions.Internal.Servant.Server: instance forall k1 (method :: k1) (status :: GHC.Types.Nat) (ctypes :: [GHC.Types.*]) a (context :: [*]). Servant.Server.Internal.HasServer (Servant.API.Verbs.Verb method status ctypes (Servant.Checked.Exceptions.Internal.Envelope.Envelope '[] a)) context => Servant.Server.Internal.HasServer (Servant.Checked.Exceptions.Internal.Servant.API.NoThrow Servant.API.Sub.:> Servant.API.Verbs.Verb method status ctypes a) context

Files

+ CHANGELOG.md view
@@ -0,0 +1,5 @@++## 0.4.1.0++*   Add `NoThrow` type to represent handlers that don't throw any errors, but+    do return a result wrapped in an `Envelope`.
example/Api.hs view
@@ -16,7 +16,7 @@ import Text.Read (readMaybe) import Web.HttpApiData (FromHttpApiData, ToHttpApiData) -import Servant.Checked.Exceptions (Throws)+import Servant.Checked.Exceptions (NoThrow, Throws)  --------- -- API --@@ -25,8 +25,9 @@ -- | This is our main 'Api' type.  We will create a server, a client, and -- documentation for this api. ----- This api is composed of two routes, 'ApiStrictSearch' and 'ApiLaxSearch'.-type Api = ApiStrictSearch :<|> ApiLaxSearch+-- This api is composed of three routes, 'ApiStrictSearch', 'ApiLaxSearch', and+-- 'ApiNoErrSearch'.+type Api = ApiStrictSearch :<|> ApiLaxSearch :<|> ApiNoErrSearch  -- | This is a strict search api.  You pass it a @\"query\"@, and it returns a -- 'SearchResponse'.  It potentially returns a 'BadSearchTermErr' if your query@@ -48,6 +49,14 @@   "lax-search" :>   Capture "query" SearchQuery :>   Throws BadSearchTermErr :>+  Post '[JSON] SearchResponse++-- | This is similar to 'ApiLaxSearch', but it doesn't force the query to use+-- correct terms.  It does not return an error.+type ApiNoErrSearch =+  "no-err-search" :>+  Capture "query" SearchQuery :>+  NoThrow :>   Post '[JSON] SearchResponse  ------------------------------
example/Client.hs view
@@ -28,7 +28,7 @@        (BaseUrl(BaseUrl), ClientEnv(ClientEnv), ClientM, Scheme(Http),         client, runClientM) -import Servant.Checked.Exceptions (Envelope, catchesEnvelope)+import Servant.Checked.Exceptions (Envelope, emptyEnvelope, catchesEnvelope)  import Api        (Api, BadSearchTermErr(BadSearchTermErr),@@ -40,7 +40,8 @@ -----------------------------------------  -- We generate the client functions just like normal.  Note that when we use--- 'Throws', the client functions get generated with the 'Envelope' type.+-- 'Throws' or 'NoThrow', the client functions get generated with the+-- 'Envelope' type.  strictSearch   :: SearchQuery@@ -48,7 +49,10 @@ laxSearch   :: SearchQuery   -> ClientM (Envelope '[BadSearchTermErr] SearchResponse)-strictSearch :<|> laxSearch = client (Proxy :: Proxy Api)+noErrSearch+  :: SearchQuery+  -> ClientM (Envelope '[] SearchResponse)+strictSearch :<|> laxSearch :<|> noErrSearch = client (Proxy :: Proxy Api)  -------------------------------------- -- Command-line options and parsers --@@ -57,7 +61,7 @@ -- The following are needed for using optparse-applicative to parse command -- line arguments.  Most people shouldn't need to worry about how this works. -data Options = Options { query :: String, useStrict :: Bool }+data Options = Options { query :: String, useStrict :: Bool, useNoErr :: Bool }  queryParser :: Parser String queryParser = argument str (metavar "QUERY")@@ -65,10 +69,17 @@ useStrictParser :: Parser Bool useStrictParser =   switch $-    long "strict" <> short 's' <> help "Whether to be use the strict api"+    long "strict" <> short 's' <> help "Whether or not to use the strict api" +useNoErrParser :: Parser Bool+useNoErrParser =+  switch $+    long "no-err" <>+    short 'n' <>+    help "Whether or not to use the api that does not return an error"+ commandParser :: Parser Options-commandParser = Options <$> queryParser <*> useStrictParser+commandParser = Options <$> queryParser <*> useStrictParser <*> useNoErrParser  ------------------------------------------------------------------------- -- Command Runners (these use the clients generated by servant-client) --@@ -107,10 +118,22 @@           (\(SearchResponse searchResponse) -> "Success: " <> searchResponse)           env --- | Run either 'runStrict' or 'runLax' depending on the command line options.+-- | This function uses the 'noErrSearch' function to send a 'SearchQuery' to+-- the server.+runNoErr :: ClientEnv -> String -> IO ()+runNoErr clientEnv query = do+  eitherRes <- runClientM (noErrSearch $ SearchQuery query) clientEnv+  case eitherRes of+    Left servantErr -> putStrLn $ "Got a ServantErr: " <> show servantErr+    Right env -> do+      let (SearchResponse res) = emptyEnvelope env+      putStrLn $ "Success: " <> res++-- | Run 'runStrict',  'runLax', or 'runNoErr' depending on the command line options. run :: ClientEnv -> Options -> IO ()-run clientEnv Options{query, useStrict = True} = runStrict clientEnv query-run clientEnv Options{query, useStrict = False} = runLax clientEnv query+run clientEnv Options{query, useStrict = True, useNoErr = _} = runStrict clientEnv query+run clientEnv Options{query, useStrict = _, useNoErr = True} = runNoErr clientEnv query+run clientEnv Options{query, useStrict = _, useNoErr = _} = runLax clientEnv query  ---------- -- Main --
example/Server.hs view
@@ -33,7 +33,7 @@ -- | This is our server root for the 'ServerT' for 'Api'.  We only have two -- handlers, 'postStrictSearch' and 'postLaxSearch'. serverRoot :: ServerT Api Handler-serverRoot = postStrictSearch :<|> postLaxSearch+serverRoot = postStrictSearch :<|> postLaxSearch :<|> postNoErrSearch  -- | This is the handler for 'Api.ApiStrictSearch'. --@@ -59,7 +59,7 @@  -- | This is the handler for 'Api.ApiLaxSearch'. ----- This is similar to 'postStrictSearch', but it doesn't require correctly+-- This is similar to 'postStrictSearch', but it doesn't require correct -- capitalization. postLaxSearch   :: SearchQuery@@ -67,6 +67,13 @@ postLaxSearch (SearchQuery query)   | fmap toLower query == "hello" = pureSuccEnvelope "good"   | otherwise = pureErrEnvelope BadSearchTermErr++-- | This is the handler for 'Api.ApiNoErrSearch'.+--+-- This is similar to 'postLaxSearch', but it doesn't require a correct search+-- term.+postNoErrSearch :: SearchQuery -> Handler (Envelope '[] SearchResponse)+postNoErrSearch (SearchQuery _) = pureSuccEnvelope "good"  -- | Create a WAI 'Application'. app :: Application
servant-checked-exceptions.cabal view
@@ -1,5 +1,5 @@ name:                servant-checked-exceptions-version:             0.4.0.0+version:             0.4.1.0 synopsis:            Checked exceptions for Servant APIs. description:         Please see <https://github.com/cdepillabout/servant-checked-exceptions#readme README.md>. homepage:            https://github.com/cdepillabout/servant-checked-exceptions@@ -10,7 +10,9 @@ copyright:           2017 Dennis Gosnell category:            Text build-type:          Simple-extra-source-files:  README.md+extra-source-files:  CHANGELOG.md+                   , README.md+                   , stack.yaml cabal-version:       >=1.10  flag buildexample
src/Servant/Checked/Exceptions.hs view
@@ -92,6 +92,8 @@   (   -- * 'Throws' API parameter     Throws+  -- * 'NoThrow' API parameter+  , NoThrow   -- * 'Envelope' response wrapper   , Envelope(..)   -- ** 'Envelope' helper functions@@ -102,6 +104,7 @@   , pureErrEnvelope   -- *** 'Envelope' destructors   , envelope+  , emptyEnvelope   , fromEnvelope   , fromEnvelopeOr   , fromEnvelopeM
src/Servant/Checked/Exceptions/Internal/Envelope.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-}@@ -41,6 +42,7 @@   , pureErrEnvelope   -- ** Envelope Destructors   , envelope+  , emptyEnvelope   , fromEnvelope   , fromEnvelopeOr   , fromEnvelopeM@@ -74,7 +76,7 @@        (Iso, Prism, Prism', iso, preview, prism) import Servant.Checked.Exceptions.Internal.Product (ToOpenProduct) import Servant.Checked.Exceptions.Internal.Union-       (IsMember, OpenUnion, catchesOpenUnion, openUnionLift,+       (IsMember, OpenUnion, absurdUnion, catchesOpenUnion, openUnionLift,         openUnionPrism) import Servant.Checked.Exceptions.Internal.Util (ReturnX) @@ -152,6 +154,17 @@ envelope :: (OpenUnion es -> c) -> (a -> c) -> Envelope es a -> c envelope f _ (ErrEnvelope es) = f es envelope _ f (SuccEnvelope a) = f a++-- | Unwrap an 'Envelope' that cannot contain an error.+--+-- ==== __Examples__+--+-- >>> let env = toSuccEnvelope "hello" :: Envelope '[] String+-- >>> emptyEnvelope env+-- "hello"+emptyEnvelope :: Envelope '[] a -> a+emptyEnvelope (SuccEnvelope a) = a+emptyEnvelope (ErrEnvelope es) = absurdUnion es  -- | Just like 'Data.Either.fromEither' but for 'Envelope'. --
src/Servant/Checked/Exceptions/Internal/Servant/API.hs view
@@ -32,6 +32,25 @@ -- >>> type API = Throws String :> Get '[JSON] Int data Throws (e :: *) +-- | 'NoThrow' is used to indicate that an API will not throw an error, but+-- that it will still return a response wrapped in a+-- 'Servant.Checked.Exceptions.Internal.Envelope.Envelope'.+--+-- ==== __Examples__+--+-- Create an API using 'NoThrow':+--+-- >>> import Servant.API (Get, JSON, (:>))+-- >>> type API = NoThrow :> Get '[JSON] Int+--+-- A servant-server handler for this type would look like the following:+--+-- @+--   apiHandler :: 'Servant.Handler' ('Servant.Checked.Exceptions.Internal.Envelope.Envelope' \'[] Int)+--   apiHandler = 'Servant.Checked.Exceptions.Internal.Envelope.pureSuccEnvelope' 3+-- @+data NoThrow+ -- | This is used internally and should not be used by end-users. data Throwing (e :: [*]) 
src/Servant/Checked/Exceptions/Internal/Servant/Client.hs view
@@ -33,7 +33,7 @@  import Servant.Checked.Exceptions.Internal.Envelope (Envelope) import Servant.Checked.Exceptions.Internal.Servant.API-       (Throws, Throwing, ThrowingNonterminal)+       (NoThrow, Throws, Throwing, ThrowingNonterminal)  -- TODO: Make sure to also account for when headers are being used. @@ -62,6 +62,21 @@   clientWithRoute Proxy =     clientWithRoute (Proxy :: 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 (HasClient (Verb method status ctypes (Envelope '[] a))) =>+    HasClient (NoThrow :> Verb method status ctypes a) where++  type Client (NoThrow :> Verb method status ctypes a) =+    Client (Verb method status ctypes (Envelope '[] a))++  clientWithRoute+    :: Proxy (NoThrow :> Verb method status ctypes a)+    -> Req+    -> Client (Verb method status ctypes (Envelope '[] a))+  clientWithRoute Proxy =+    clientWithRoute (Proxy :: Proxy (Verb method status ctypes (Envelope '[] a)))+ -- | When @'Throwing' es@ comes before ':<|>', push @'Throwing' es@ into each -- branch of the API. instance HasClient ((Throwing es :> api1) :<|> (Throwing es :> api2)) =>@@ -77,6 +92,21 @@   clientWithRoute _ =     clientWithRoute (Proxy :: Proxy ((Throwing es :> api1) :<|> (Throwing es :> api2))) +-- | When 'NoThrow' comes before ':<|>', push 'NoThrow' into each branch of the+-- API.+instance HasClient ((NoThrow :> api1) :<|> (NoThrow :> api2)) =>+    HasClient (NoThrow :> (api1 :<|> api2)) where++  type Client (NoThrow :> (api1 :<|> api2)) =+    Client ((NoThrow :> api1) :<|> (NoThrow :> api2))++  clientWithRoute+    :: Proxy (NoThrow :> (api1 :<|> api2))+    -> Req+    -> Client ((NoThrow :> api1) :<|> (NoThrow :> api2))+  clientWithRoute _ =+    clientWithRoute (Proxy :: Proxy ((NoThrow :> api1) :<|> (NoThrow :> 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'.@@ -92,3 +122,18 @@     -> Client (ThrowingNonterminal (Throwing es :> api :> apis))   clientWithRoute _ =     clientWithRoute (Proxy :: Proxy (ThrowingNonterminal (Throwing es :> api :> apis)))++-- | When 'NoThrow' comes before any other combinator, push it down so it is+-- closer to the 'Verb'.+instance HasClient (api :> NoThrow :> apis) =>+    HasClient (NoThrow :> api :> apis) where++  type Client (NoThrow :> api :> apis) =+    Client (api :> NoThrow :> apis)++  clientWithRoute+    :: Proxy (NoThrow :> api :> apis)+    -> Req+    -> Client (api :> NoThrow :> apis)+  clientWithRoute _ =+    clientWithRoute (Proxy :: Proxy (api :> NoThrow :> apis))
src/Servant/Checked/Exceptions/Internal/Servant/Docs.hs view
@@ -45,7 +45,7 @@        (Envelope, toErrEnvelope, toSuccEnvelope) import Servant.Checked.Exceptions.Internal.Prism ((<>~)) import Servant.Checked.Exceptions.Internal.Servant.API-       (Throws, Throwing)+       (NoThrow, Throws, Throwing) import Servant.Checked.Exceptions.Internal.Util (Snoc)  -- TODO: Make sure to also account for when headers are being used.@@ -80,6 +80,21 @@             docOpts     in api & apiEndpoints . traverse . response . respBody <>~         createRespBodiesFor (Proxy :: Proxy es) (Proxy :: Proxy ctypes)++-- | When 'NoThrow' comes before a 'Verb', generate the documentation for+-- the same 'Verb', but returning an @'Envelope' \'[]@.+instance (HasDocs (Verb method status ctypes (Envelope '[] a)))+    => HasDocs (NoThrow :> Verb method status ctypes a) where+  docsFor+    :: Proxy (NoThrow :> Verb method status ctypes a)+    -> (Endpoint, Action)+    -> DocOptions+    -> API+  docsFor Proxy (endpoint, action) docOpts =+    docsFor+      (Proxy :: Proxy (Verb method status ctypes (Envelope '[] a)))+      (endpoint, action)+      docOpts  -- | Create samples for a given @list@ of types, under given @ctypes@. --
src/Servant/Checked/Exceptions/Internal/Servant/Server.hs view
@@ -34,7 +34,7 @@  import Servant.Checked.Exceptions.Internal.Envelope (Envelope) import Servant.Checked.Exceptions.Internal.Servant.API-       (Throws, Throwing, ThrowingNonterminal)+       (NoThrow, Throws, Throwing, ThrowingNonterminal)  -- TODO: Make sure to also account for when headers are being used. @@ -67,6 +67,21 @@     -> Router env   route _ = route (Proxy :: 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 (HasServer (Verb method status ctypes (Envelope '[] a)) context) =>+    HasServer (NoThrow :> Verb method status ctypes a) context where++  type ServerT (NoThrow :> Verb method status ctypes a) m =+    ServerT (Verb method status ctypes (Envelope '[] a)) m++  route+    :: Proxy (NoThrow :> Verb method status ctypes a)+    -> Context context+    -> Delayed env (ServerT (Verb method status ctypes (Envelope '[] a)) Handler)+    -> Router env+  route _ = route (Proxy :: Proxy (Verb method status ctypes (Envelope '[] a)))+ -- | When @'Throwing' es@ comes before ':<|>', push @'Throwing' es@ into each -- branch of the API. instance HasServer ((Throwing es :> api1) :<|> (Throwing es :> api2)) context =>@@ -82,6 +97,21 @@     -> Router env   route _ = route (Proxy :: Proxy ((Throwing es :> api1) :<|> (Throwing es :> api2))) +-- | When 'NoThrow' comes before ':<|>', push 'NoThrow' into each+-- branch of the API.+instance HasServer ((NoThrow :> api1) :<|> (NoThrow :> api2)) context =>+    HasServer (NoThrow :> (api1 :<|> api2)) context where++  type ServerT (NoThrow :> (api1 :<|> api2)) m =+    ServerT ((NoThrow :> api1) :<|> (NoThrow :> api2)) m++  route+    :: Proxy (NoThrow :> (api1 :<|> api2))+    -> Context context+    -> Delayed env (ServerT ((NoThrow :> api1) :<|> (NoThrow :> api2)) Handler)+    -> Router env+  route _ = route (Proxy :: Proxy ((NoThrow :> api1) :<|> (NoThrow :> 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'.@@ -97,3 +127,18 @@     -> Delayed env (ServerT (ThrowingNonterminal (Throwing es :> api :> apis)) Handler)     -> Router env   route _ = route (Proxy :: Proxy (ThrowingNonterminal (Throwing es :> api :> apis)))++-- | When 'NoThrow' comes before any combinator, push it down so it is closer+-- to the 'Verb'.+instance HasServer (api :> NoThrow :> apis) context =>+    HasServer (NoThrow :> api :> apis) context where++  type ServerT (NoThrow :> api :> apis) m =+    ServerT (api :> NoThrow :> apis) m++  route+    :: Proxy (NoThrow :> api :> apis)+    -> Context context+    -> Delayed env (ServerT (api :> NoThrow :> apis) Handler)+    -> Router env+  route _ = route (Proxy :: Proxy (api :> NoThrow :> apis))
+ stack.yaml view
@@ -0,0 +1,41 @@+# For more information, see: http://docs.haskellstack.org/en/stable/yaml_configuration.html++# Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2)+resolver: lts-9.2++# Local packages, usually specified by relative directory name+packages:+- '.'++# Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3)+extra-deps: []++# Override default flag values for local packages and extra-deps+flags: {}++# Extra package databases containing global packages+extra-package-dbs: []++# Control whether we use the GHC we find on the path+# system-ghc: true++# Require a specific version of stack, using version ranges+# require-stack-version: -any # Default+# require-stack-version: >= 1.0.0++# Override the architecture used by stack, especially useful on Windows+# arch: i386+# arch: x86_64++# Extra directories used by stack for building+# extra-include-dirs: [/path/to/dir]+# extra-lib-dirs: [/path/to/dir]++# Allow a newer minor version of GHC than the snapshot specifies+# compiler-check: newer-minor++# Enable Hackage-friendly mode, for more details see+#  https://docs.haskellstack.org/en/stable/yaml_configuration/#pvp-bounds+# This has been disabled because of the following exchange:+# https://github.com/cdepillabout/pretty-simple/pull/1#issuecomment-272706215+#pvp-bounds: both
test/Spec.hs view
@@ -10,14 +10,14 @@ import Data.Type.Equality ((:~:)(Refl)) import Data.Typeable (Typeable) import Network.Wai (Application)-import Servant ((:<|>), (:>), Capture, Get, Handler, JSON, ServerT, serve)+import Servant ((:<|>)((:<|>)), (:>), Capture, Get, Handler, JSON, ServerT, serve) import Test.Hspec.Wai (get, shouldRespondWith, with) import Test.Tasty (TestTree, defaultMain, testGroup)-import Test.Tasty.Hspec (testSpec, it)+import Test.Tasty.Hspec (describe, it, testSpec) import Test.Tasty.HUnit ((@?=), assertFailure, testCase)  import Servant.Checked.Exceptions-       (Envelope, Throws, pureErrEnvelope, pureSuccEnvelope)+       (Envelope, NoThrow, Throws, pureErrEnvelope, pureSuccEnvelope)  main :: IO () main = do@@ -69,18 +69,15 @@  type ApiThrows = Throws String :> Get '[JSON] Int -checkApiThrows-  :: ServerT ApiThrows m :~: m (Envelope '[String] Int)+checkApiThrows :: ServerT ApiThrows m :~: m (Envelope '[String] Int) checkApiThrows = Refl - type ApiDoubleThrows = Throws String :> Throws Double :> Get '[JSON] Int  checkApiDoubleThrows   :: ServerT ApiDoubleThrows m :~: m (Envelope '[String, Double] Int) checkApiDoubleThrows = Refl - type ApiThrowsBeforeCapture =   Throws String :> Capture "foobar" Double :> Get '[JSON] Int @@ -88,7 +85,6 @@   :: ServerT ApiThrowsBeforeCapture m :~: (Double -> m (Envelope '[String] Int)) checkApiThrowsBeforeCapture = Refl - type ApiThrowsBeforeMulti =   Throws String :> (Get '[JSON] Int :<|> Get '[JSON] Double) @@ -97,7 +93,26 @@      (m (Envelope '[String] Int) :<|> m (Envelope '[String] Double)) checkApiThrowsBeforeMulti = Refl +type ApiNoThrow = NoThrow :> Get '[JSON] Int +checkApiNoThrows :: ServerT ApiNoThrow m :~: m (Envelope '[] Int)+checkApiNoThrows = Refl++type ApiNoThrowBeforeCapture =+  NoThrow :> Capture "foobar" Double :> Get '[JSON] Int++checkApiNoThrowBeforeCapture+  :: ServerT ApiNoThrowBeforeCapture m :~: (Double -> m (Envelope '[] Int))+checkApiNoThrowBeforeCapture = Refl++type ApiNoThrowBeforeMulti =+  NoThrow :> (Get '[JSON] Int :<|> Get '[JSON] Double)++checkApiNoThrowBeforeMulti+  :: ServerT ApiNoThrowBeforeMulti m :~:+     (m (Envelope '[] Int) :<|> m (Envelope '[] Double))+checkApiNoThrowBeforeMulti = Refl+ hasServerInstanceTests :: TestTree hasServerInstanceTests =   testGroup@@ -106,23 +121,33 @@     , testCase "double Throws" $ checkApiDoubleThrows @?= Refl     , testCase "Throws before Capture" $ checkApiThrowsBeforeCapture @?= Refl     , testCase "Throws before (:<|>)" $ checkApiThrowsBeforeMulti @?= Refl+    , testCase "single NoThrows" $ checkApiNoThrows @?= Refl+    , testCase "NoThrow before Capture" $ checkApiNoThrowBeforeCapture @?= Refl+    , testCase "NoThrow before (:<|>)" $ checkApiNoThrowBeforeMulti @?= Refl     ]  ------------------ -- Server tests -- ------------------ -type TestApi = Capture "foobar" Double :> Throws Int :> Get '[JSON] String+type TestThrows = Capture "foobar" Double :> Throws Int :> Get '[JSON] String +type TestNoThrow = Capture "baz" Integer :> NoThrow :> Get '[JSON] String++type TestApi = TestThrows :<|> TestNoThrow+ server :: ServerT TestApi Handler-server = helloWorldGet+server = testThrowsGet :<|> testNoThrowsGet -helloWorldGet :: Double -> Handler (Envelope '[Int] String)-helloWorldGet double =+testThrowsGet :: Double -> Handler (Envelope '[Int] String)+testThrowsGet double =   if double < 0     then pureErrEnvelope (0 :: Int)     else pureSuccEnvelope "success" +testNoThrowsGet :: Integer -> Handler (Envelope '[] String)+testNoThrowsGet _ = pureSuccEnvelope "success"+ app :: Application app = serve (Proxy :: Proxy TestApi) server @@ -130,7 +155,11 @@ serverTestsIO =   testSpec "server" $     with (pure app) $ do-      it "handler can return error envelope" $-        get "/-5" `shouldRespondWith` "{\"err\":0}"-      it "handler can return success envelope" $-        get "/10" `shouldRespondWith` "{\"data\":\"success\"}"+      describe "Throws" $ do+        it "handler can return error envelope" $+          get "/-5" `shouldRespondWith` "{\"err\":0}"+        it "handler can return success envelope" $+          get "/10" `shouldRespondWith` "{\"data\":\"success\"}"+      describe "NoThrow" $ do+        it "handler can return success envelope" $+          get "/10" `shouldRespondWith` "{\"data\":\"success\"}"