servant-generic (empty) → 0.1.0.0
raw patch · 6 files changed
+356/−0 lines, 6 filesdep +basedep +servantdep +servant-genericsetup-changed
Dependencies added: base, servant, servant-generic, servant-server, text, warp
Files
- LICENSE +21/−0
- README.md +160/−0
- Setup.hs +2/−0
- examples/Basic.hs +53/−0
- servant-generic.cabal +42/−0
- src/Servant/Generic.hs +78/−0
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2017 Patrick Chilton++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,160 @@+[](https://travis-ci.org/chpatrick/servant-generic) [](http://hackage.haskell.org/package/servant-generic)++tl;dr+-----+Specify Servant APIs with simple records instead of `:<|>` trees.++```haskell+data Site route = Site+ { about :: route :-+ "about" :> Get '[PlainText] Text+ , faq :: route :-+ "faq" :> Get '[PlainText] Text+ } deriving Generic++siteServer :: Site AsServer+siteServer = Site+ { about = return "about"+ , faq = return "faq"+ }++type Api = ToServant (Site AsApi)++main :: IO ()+main = run 31337 $ serve (Proxy :: Proxy Api) (toServant siteServer)+```++So long and thanks for all the `:<|>`+-------------------------------------+Servant is great for building typesafe APIs. However, its biggest weakness is that you need to specify APIs as a tree of `:<|>` operators:++```haskell+type SiteOld =+ "about" :> Get '[PlainText] Text+ :<|> "faq" :> Get '[PlainText] Text+ :<|> "subsite" :> SubSiteOld++type SubSiteOld =+ "echo" :> Capture "x" Text :> Get '[PlainText] Text+ :<|> "timestwo" :> Capture "x" Int :> Get '[PlainText] Text++siteOldServer :: Server SiteOld+siteOldServer =+ return "about"+ :<|> subSiteOldServer+ :<|> return "faq"++subSiteOldServer :: Server SubSiteOld+subSiteOldServer =+ return+ :<|> (\x -> return $ T.pack $ show (x * 2))+```++This is cumbersome because you need to remember the exact order of routes when you are implementing the API. Not only that, but if you get anything wrong, you are treated with an incomprehensible error message. Let's see what happens if we mix up the implementations of `/faq` and `/subsite`:++```+ • Couldn't match type ‘(Text+ -> transformers-0.5.2.0:Control.Monad.Trans.Except.ExceptT+ ServantErr IO Text)+ :<|> (Int+ -> transformers-0.5.2.0:Control.Monad.Trans.Except.ExceptT+ ServantErr IO Text)’+ with ‘transformers-0.5.2.0:Control.Monad.Trans.Except.ExceptT+ ServantErr IO Text’+ Expected type: Server SiteOld+ Actual type: transformers-0.5.2.0:Control.Monad.Trans.Except.ExceptT+ ServantErr IO Text+ :<|> (Server SubSiteOld+ :<|> ((Text+ -> transformers-0.5.2.0:Control.Monad.Trans.Except.ExceptT+ ServantErr IO Text)+ :<|> (Int+ -> transformers-0.5.2.0:Control.Monad.Trans.Except.ExceptT+ ServantErr IO Text)))+ • In the expression:+ return "about" :<|> subSiteOldServer :<|> return "faq"+ In an equation for ‘siteOldServer’:+ siteOldServer+ = return "about" :<|> subSiteOldServer :<|> return "faq"+```++Can you figure out what the problem is from that?++What this package lets you do is to specify routes as regular Haskell records:++```haskell+data Site route = Site+ { about :: route :-+ "about" :> Get '[PlainText] Text+ , faq :: route :-+ "faq" :> Get '[PlainText] Text+ , subSite :: route :-+ "subsite" :> ToServant (SubSite AsApi) -- record APIs can be nested easily+ } deriving Generic++data SubSite route = SubSite+ { echo :: route :-+ "echo" :> Capture "x" Text :> Get '[PlainText] Text+ , timesTwo :: route :-+ "timestwo" :> Capture "x" Int :> Get '[PlainText] Text+ } deriving Generic++type Api = ToServant (Site AsApi)++subSiteServer :: SubSite AsServer+subSiteServer = SubSite+ { echo = return+ , timesTwo = \x -> return $ T.pack $ show (x * 2)+ }++siteServer :: Site AsServer+siteServer = Site+ { about = return "about"+ , faq = return "faq"+ , subSite = toServant subSiteServer+ }+```++Now everything is named so we don't need to remember which route is which.+These records can be converted to Servant-compatible types like this:+```haskell+ToServant (MyApiRecord AsApi)+```++and to Servant-compatible implementations like this:++```haskell+toServant myApiRecordServer+```++These functions work with any library based on Servant, not just `servant-server`.++What happens if we make the same mistake as above?++```+ • Couldn't match type ‘(Text+ -> transformers-0.5.2.0:Control.Monad.Trans.Except.ExceptT+ ServantErr IO Text)+ :<|> (Int+ -> transformers-0.5.2.0:Control.Monad.Trans.Except.ExceptT+ ServantErr IO Text)’+ with ‘transformers-0.5.2.0:Control.Monad.Trans.Except.ExceptT+ ServantErr IO Text’+ Expected type: AsServer :- ("faq" :> Get '[PlainText] Text)+ Actual type: ToServant (SubSite AsServer)+ • In the ‘faq’ field of a record+ In the expression:+ Site+ {about = return "about", faq = toServant subSiteServer,+ subSite = return "faq",+ home = return "So long and thanks for all the :<|>"}+ In an equation for ‘siteServer’:+ siteServer+ = Site+ {about = return "about", faq = toServant subSiteServer,+ subSite = return "faq",+ home = return "So long and thanks for all the :<|>"}+```+Now, GHC tells us that the problem is in the `faq` field, and that we passed a `SubSite` route rather than an `"faq"` route.++This approach is based on my [solga](https://github.com/chpatrick/solga) library, which also has these benefits and is a lot simpler than Servant.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ examples/Basic.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}++import Servant+import Servant.Generic+import qualified Data.Text as T+import Data.Text (Text)+import Network.Wai.Handler.Warp (run)+import System.Timeout++data Site route = Site+ { about :: route :-+ "about" :> Get '[PlainText] Text+ , faq :: route :-+ "faq" :> Get '[PlainText] Text+ , subSite :: route :-+ "subsite" :> ToServant (SubSite AsApi)+ , home :: route :-+ Get '[PlainText] Text+ } deriving Generic++data SubSite route = SubSite+ { echo :: route :-+ "echo" :> Capture "x" Text :> Get '[PlainText] Text+ , timesTwo :: route :-+ "timestwo" :> Capture "x" Int :> Get '[PlainText] Text+ } deriving Generic++type Api = ToServant (Site AsApi)++subSiteServer :: SubSite AsServer+subSiteServer = SubSite+ { echo = return+ , timesTwo = \x -> return $ T.pack $ show (x * 2)+ }++siteServer :: Site AsServer+siteServer = Site+ { about = return "about"+ , faq = return "faq"+ , subSite = toServant subSiteServer+ , home = return "So long and thanks for all the :<|>"+ }++main :: IO ()+main = do+ let runServer = run 31337 $ serve (Proxy :: Proxy Api) (toServant siteServer)++ -- just to use this example as a test, run the server for one second+ Nothing <- timeout 1000000 runServer+ return ()
+ servant-generic.cabal view
@@ -0,0 +1,42 @@+-- Initial servant-generic.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/++name: servant-generic+version: 0.1.0.0+synopsis: Specify Servant APIs with records.+description: See README.+license: MIT+license-file: LICENSE+author: Patrick Chilton+maintainer: chpatrick@gmail.com+copyright: 2017 Patrick Chilton+category: Web+build-type: Simple+cabal-version: >=1.10+extra-source-files: README.md++source-repository head+ type: git+ location: https://github.com/chpatrick/servant-generic.git++library+ exposed-modules: Servant.Generic + -- other-modules: + -- other-extensions: + build-depends: base >=4.7 && <4.10,+ servant >= 0.7.1,+ servant-server >= 0.7.1+ hs-source-dirs: src+ default-language: Haskell2010+ ghc-options: -Wall++test-suite example-basic+ type: exitcode-stdio-1.0+ main-is: examples/Basic.hs+ default-language: Haskell2010+ build-depends: base >=4.7 && <4.10,+ servant >= 0.7.1,+ servant-server >= 0.7.1,+ servant-generic,+ text,+ warp
+ src/Servant/Generic.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE DataKinds #-}+ +module Servant.Generic+ ( (:-)+ , AsServerT+ , AsServer+ , AsApi+ , ToServant+ , toServant+ , GenericProduct+ -- * Internals+ , GProduct(..)+ , Generic(..)+ ) where++import GHC.Generics+import Servant++-- | A class of generic product types.+class GProduct f where+ type GToServant f+ gtoServant :: f p -> GToServant f++instance GProduct f => GProduct (M1 i c f) where+ type GToServant (M1 i c f) = GToServant f+ gtoServant (M1 x) = gtoServant x++instance (GProduct l, GProduct r) => GProduct (l :*: r) where+ type GToServant (l :*: r) = GToServant l :<|> GToServant r+ gtoServant (l :*: r) = gtoServant l :<|> gtoServant r++instance GProduct (K1 i c) where+ type GToServant (K1 i c) = c+ gtoServant (K1 x) = x++type GenericProduct a = (Generic a, GProduct (Rep a))++-- | Turns a generic product type into a linear tree of `:<|>` combinators.+-- For example, given+-- +-- @+-- data Foo route = Foo+-- { foo :: route :-+-- Get '[PlainText] Text+-- , bar :: route :-+-- Get '[PlainText] Text+-- }+-- @+-- +-- @ ToServant (Foo AsApi) ~ Get '[PlainText] Text :\<|\> Get '[PlainText] Text @+type ToServant a = GToServant (Rep a)++-- | See `ToServant`, but at value-level.+toServant :: GenericProduct a => a -> ToServant a+toServant = gtoServant . from++-- | A type family that applies an appropriate type family to the @api@ parameter.+-- For example, passing `AsApi` will leave @api@ untouched, while @`AsServerT` m@ will produce @`ServerT` api m@. +type family mode :- api+infixl 8 :-++-- | A type that specifies that an API record contains an API definition. Only useful at type-level.+data AsApi+type instance AsApi :- api = api++-- | A type that specifies that an API record contains a server implementation.+data AsServerT (m :: * -> *)+type instance AsServerT m :- api = ServerT api m+type AsServer = AsServerT Handler