servant-generate (empty) → 0.1

raw patch · 6 files changed

+330/−0 lines, 6 filesdep +basedep +servantdep +servant-serversetup-changed

Dependencies added: base, servant, servant-server

Files

ChangeLog.md +5/−0
LICENSE +30/−0
README.md +8/−0
Setup.hs +2/−0
servant-generate.cabal +31/−0
src/Servant/Server/Generate.hs +254/−0

+ ChangeLog.md view

@@ -0,0 +1,5 @@+# Revision history for servant-generate++## 0.1 -- 2018-03-22++* First version. Released on an unsuspecting world.

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2018, Alp Mestanogullari++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Alp Mestanogullari nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ README.md view

@@ -0,0 +1,8 @@+# servant-generate++Utilities for generating "default" server implementations for+servant APIs. This is a generalisation of+[servant-mock](https://hackage.haskell.org/package/servant-mock).++See the documentation in `Servant.Server.Generate` for examples+and more.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ servant-generate.cabal view

@@ -0,0 +1,31 @@+name:                servant-generate+version:             0.1+synopsis:            Utilities for generating mock server implementations+description:         Utilities for generating mock server implementations+                     .+                     See the documentation of the @Servant.Server.Generate@ module.+homepage:            https://github.com/alpmestan/servant-generate+bug-reports:         https://github.com/alpmestan/servant-generate+license:             BSD3+license-file:        LICENSE+author:              Alp Mestanogullari+maintainer:          alpmestan@gmail.com+copyright:           2018 Alp Mestanogullari+category:            Web+build-type:          Simple+extra-source-files:  ChangeLog.md, README.md+cabal-version:       >=1.10+tested-with:         GHC == 8.0.2, GHC == 8.2.2++source-repository head+  type:     git+  location: https://github.com/alpmestan/servant-generate.git++library+  exposed-modules:     Servant.Server.Generate+  build-depends:       base >=4.7 && <5,+                       servant >= 0.13 && <0.14,+                       servant-server >= 0.13 && <0.14+  hs-source-dirs:      src+  default-language:    Haskell2010+  ghc-options:         -Wall

+ src/Servant/Server/Generate.hs view

@@ -0,0 +1,254 @@+{-# OPTIONS_GHC -Wno-unused-top-binds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE MultiParamTypeClasses #-}+module Servant.Server.Generate+  ( -- * Using this library+    -- $using++    -- * The 'GenerateServer' class+    GenerateServer(..)+  , -- * Utilities+    unconstrained, constrained+  , handlers+  , Flatten, NonEmpty+  ) where++import Data.Proxy+import GHC.Exts+import GHC.TypeLits+import Servant.API+import Servant.API.Internal.Test.ComprehensiveAPI+import Servant.Server++-- | A class that'll define the generated server using the supplied+--   constraints and some function that takes a response type (through a 'Proxy')+--   and returns a computation in an arbitrary monad that returns a value of+--   the aforementionned response type.+--+--   What does this all mean?+--+--   Well, for example, we can use an empty list of+--   constraints (see 'unconstrained') and just systematically call 'throwError'+--   in all endpoints. The monad in that case would be 'Handler', and the result of+--   calling 'generateServer' on any API type would be a server implementation for that+--   API that just errors out in each handler.+--+--   Another example would be to use a constraint list of just one class (with+--   'constrained'), say `Arbitrary`, and pass a function to `generateServer` that+--   simply generates a random value in IO (something like+--   @\_ -> liftIO $ generate (arbitrary :: Gen a)@). The result of calling this on a+--   given API type would be a server implementation that can live in any `MonadIO m`,+--   where for each endpoint we simply generate a random response (of the right type!).+class GenerateServer (api :: *) (constraints :: [* -> Constraint]) where+  -- | Given:+  --+  --     * a particular API type @api@,+  --+  --     * some constraint(s) that all response types in the API must satisfy,+  --+  --     * a \"monad-like\" type constructor @m@, of kind @* -> *@,+  --+  --     * a function that, when given (a 'Proxy' to) any response type @a@ that+  --       implements the aforementionned constraints, can produce a value of+  --       that type in @m@,+  --+  --   'generateServer' gives you back an implementation of the given API+  --   in with handlers returning responses in @m@, that is, a value of type+  --   @'ServerT' api m@.+  --+  --   When @m@ is just 'Handler', you can directly 'serve' that implementation.+  --   If you're working with another monad, you need to use 'hoistServer' on the+  --   result of 'generateServer' before you can 'serve' it.+  generateServer :: forall (m :: * -> *).+                    Proxy api+                 -> Proxy constraints+                 -> Proxy m+                 -> (forall a. Flatten constraints a => Proxy a -> m a)+                 -> ServerT api m++instance (GenerateServer a c, GenerateServer b c) => GenerateServer (a :<|> b) c where+  generateServer _ c m f = generateServer (Proxy @ a) c m f+                      :<|> generateServer (Proxy @ b) c m f++instance (KnownSymbol path, GenerateServer api c) => GenerateServer (path :> api) c where+  generateServer _ c m f = generateServer (Proxy @ api) c m f++instance GenerateServer api c => GenerateServer (Summary s :> api) c where+  generateServer _ c m f = generateServer (Proxy @ api) c m f++instance GenerateServer api c => GenerateServer (Description s :> api) c where+  generateServer _ c m f = generateServer (Proxy @ api) c m f++instance GenerateServer EmptyAPI c where+  generateServer _ _ _ _ = emptyServer++instance (KnownSymbol s, GenerateServer api c) => GenerateServer (Capture' mods s a :> api) c where+  generateServer _ c m f = \_ -> generateServer (Proxy @ api) c m f++instance (KnownSymbol s, GenerateServer api c) => GenerateServer (CaptureAll s a :> api) c where+  generateServer _ c m f = \_ -> generateServer (Proxy @ api) c m f++instance GenerateServer api c => GenerateServer (ReqBody' mods cts a :> api) c where+  generateServer _ c m f = \_ -> generateServer (Proxy @ api) c m f++instance GenerateServer api c => GenerateServer (RemoteHost :> api) c where+  generateServer _ c m f = \_ -> generateServer (Proxy @ api) c m f++instance GenerateServer api c => GenerateServer (IsSecure :> api) c where+  generateServer _ c m f = \_ -> generateServer (Proxy @ api) c m f++instance GenerateServer api c => GenerateServer (Vault :> api) c where+  generateServer _ c m f = \_ -> generateServer (Proxy @ api) c m f++instance GenerateServer api c => GenerateServer (HttpVersion :> api) c where+  generateServer _ c m f = \_ -> generateServer (Proxy @ api) c m f++instance (KnownSymbol s, GenerateServer api c) => GenerateServer (QueryParam' mods s a :> api) c where+  generateServer _ c m f = \_ -> generateServer (Proxy @ api) c m f++instance (KnownSymbol s, GenerateServer api c) => GenerateServer (QueryFlag s :> api) c where+  generateServer _ c m f = \_ -> generateServer (Proxy @ api) c m f++instance (KnownSymbol s, GenerateServer api c) => GenerateServer (QueryParams s a :> api) c where+  generateServer _ c m f = \_ -> generateServer (Proxy @ api) c m f++instance (KnownSymbol h, GenerateServer api c) => GenerateServer (Header' mods h a :> api) c where+  generateServer _ c m f = \_ -> generateServer (Proxy @ api) c m f++instance GenerateServer api c => GenerateServer (WithNamedContext name subContext api) c where+  generateServer _ c m f = generateServer (Proxy @ api) c m f++-- | Requires all constraints in @cs@ to be satisfied by @a@.+instance (KnownNat status, Flatten cs a) => GenerateServer (Verb (method :: StdMethod) (status :: Nat) (cts :: [*]) (a :: *)) cs where+  generateServer _ _ _ f = f (Proxy @ a)++type family Flatten (cs :: [* -> Constraint]) (a :: *) :: Constraint where+  Flatten '[] a = ()+  Flatten (c ': cs) a = (c a, Flatten cs a)++-- * Utilities for specifying the arguments to 'generateServer'++-- | Meant to be used as the second argument to 'generateServer' when your+--   implementation function doesn't need any typeclass constraint and can+--   just work with any response type.+unconstrained :: Proxy ('[] :: [* -> Constraint])+unconstrained = Proxy++type family NonEmpty (cs :: [* -> Constraint]) :: Constraint where+  NonEmpty '[] = TypeError ('Text "empty list of constraints used with 'constrained'")+  NonEmpty cs = ()++-- | Meant to be used as the second argument to 'generateServer' when your+--   implementation function requires one or more constraints on the /all/+--   the response types of your API, e.g @'constrained' \@ '[Show, Random, Monoid]@.+constrained+  :: forall (cs :: [* -> Constraint]). NonEmpty cs => Proxy cs+constrained = Proxy++-- | Meant to be used as the third argument to 'generateServer'. It's a simple+--   more readable wrapper around 'Proxy'. Use a type application to specify+--   the monad, e.g @'handlers' \@ 'AppMonad'@.+handlers :: forall (m :: * -> *). Proxy m+handlers = Proxy++-- do we have all instances?++class A a where+  getA :: Proxy a -> a++instance A NoContent where+  getA _ = NoContent++instance A Int where+  getA _ = 0++instance A a => A (Headers '[] a) where+  getA _ = Headers (getA (Proxy :: Proxy a)) HNil++instance (A t, A (Headers hs a))+      => A (Headers (Header h t ': hs) a) where+  getA _ = case getA (Proxy @ (Headers hs a)) of+    Headers a hs -> Headers a $+      (Header $ getA (Proxy @ t)) `HCons` hs++s :: Server ComprehensiveAPIWithoutRaw+s = generateServer+  (Proxy @ ComprehensiveAPIWithoutRaw)+  (constrained @ '[A])+  (handlers @ Handler)+  (return . getA)++-- $using+-- Let's imagine we're working with the following+-- simple API and we would like to spin up a "silly"+-- server implementation that returns responses of the+-- right type (or errors out) for each endpoint.+--+-- > type API = Get '[JSON] ()+-- >       :<|> "int" :> Get '[JSON] Int+-- >+-- > api :: Proxy API+-- > api = Proxy+--+-- First, let's see how we can get a server implementation+-- where all the handlers throw a 404 error.+--+-- > -- x :: Handler () :<|> Handler Int+-- > -- inferred just fine+-- > x = generateServer api unconstrained (handlers @ Handler) (\_ -> throwError err404)+--+-- We could more generally take the monad as argument, simply+-- requiring that it is a @'MonadError' 'ServantErr'@, for+-- example.+--+-- > -- x' :: MonadError ServantErr m => Proxy m -> m () :<|> m Int+-- > -- inferred just fine+-- > x' mon = generateServer api unconstrained mon (\_ -> throwError err404)+--+-- Now, let's see an example where we need one constraint to be+-- satisfied for all response types present in the API.+--+-- > -- we will require all response types to provide+-- > -- an instance of this typeclass.+-- > class Default a where+-- >   def :: Proxy a -> a+-- >+-- > instance Default () where+-- >   def _ = ()+-- >+-- > instance Default Int where+-- >   def _ = 0+-- >+-- > -- y :: forall m. Applicative m => Proxy m -> m () :<|> m Int+-- > -- inferred just fine+-- > y mon = generateServer api (constrained @ '[Default]) mon $ \pa -> pure (def pa)+--+-- Finally, let's see an example where we require all response+-- types of an API to have instances for several type classes.+--+-- > -- we will require instances of Tweak in addition to+-- > -- Default.+-- > class Tweak a where+-- >   tweak :: a -> a+-- >+-- > instance Tweak () where+-- >   tweak () = ()+-- >+-- > instance Tweak Int where+-- >   tweak n = n^2+-- >+-- > -- z :: forall m. Monad m => Proxy m -> m () :<|> m Int+-- > z mon = generateServer api (constrained @ '[Default, Tweak]) mon $ \pa ->+-- >   return $ tweak (def pa)+-- >+-- > -- instantiated at a particular monad, say Handler:+-- > z' = z (handlers @ Handler)