packages feed

servant (empty) → 0.1

raw patch · 7 files changed

+566/−0 lines, 7 filesdep +basesetup-changed

Dependencies added: base

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2014, 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ servant.cabal view
@@ -0,0 +1,37 @@+name:                servant+version:             0.1+synopsis:            A library to generate REST-style webservices on top of scotty, handling all the boilerplate for you+description:         +  An abstraction for 'Resource's that can support any number+  of operations, which will be tagged at the type-level.+  .+  This package however does provide standard /REST-y/ operations+  ('Servant.Operation.Add', 'Servant.Operation.Delete', 'Servant.Operation.ListAll'+  , 'Servant.Operation.Update' and 'Servant.Operation.View') and lets you define your+  own.+  .+  You can then actually make a service out of a 'Servant.Resource.Resource' description+  using any backend you like (we currently only provide a+  <http://hackage.haskell.org/package/scotty scotty> backend in+  the /servant-scotty/ package).+homepage:            http://github.com/zalora/servant+license:             BSD3+license-file:        LICENSE+author:              Alp Mestanogullari+maintainer:          alp@zalora.com+copyright:           2014 Zalora SEA+category:            Web, Database+build-type:          Simple+cabal-version:       >=1.10++library+  exposed-modules:+      Servant.Context+    , Servant.Error+    , Servant.Prelude+    , Servant.Resource+  build-depends:+    base >=4 && <5+  hs-source-dirs:      src+  default-language:    Haskell2010+  ghc-options:         -Wall
+ src/Servant/Context.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE RankNTypes #-}+{- |+Module      :  Servant.Context+Copyright   :  (c) Zalora SEA 2014+License     :  BSD3+Maintainer  :  Alp Mestanogullari <alp@zalora.com>+Stability   :  experimental++A 'Context' type for holding a function+that will use some /context/ to execute+something analoguous to a /database operation/.++This is equivalent to holding something like:++> withConnection someConnection++where you have previously set up @someConnection@ by specifying a+connection string or something like that. This lets us support+any kind of backend (even an in-memory Map in an /IORef/), and+most interestingly, we can use just raw connections or a connection+pool, this approach really covers a lot of situations while keeping+everything quite simple.++-}+module Servant.Context+  ( Context+  , mkContext+  , withContext+  ) where++-- | A 'Context' is just a wrapper around a function+--   that can execute IO operations /given/+--   this context.+newtype Context c+  = Context { withctx :: forall r. (c -> IO r) -> IO r }++-- | Create a 'Context' from a suitable function+mkContext :: (forall r. (c -> IO r) -> IO r)+          -> Context c+mkContext = Context++-- | Use the 'Context' to actually perform an 'IO'+--   operation requiring it.+withContext :: Context c+            -> (c -> IO r)+            -> IO r+withContext = withctx
+ src/Servant/Error.hs view
@@ -0,0 +1,94 @@+{-# LANGUAGE ExistentialQuantification #-}+{- |+Module      :  Servant.Error+Copyright   :  (c) Zalora SEA 2014+License     :  BSD3+Maintainer  :  Alp Mestanogullari <alp@zalora.com>+Stability   :  experimental++Everything you'll need when doing some kind of exception handling+around your \"database operations\".+-}+module Servant.Error+  ( -- * Creating an combining 'ExceptionCatcher's+    ExceptionCatcher+  , noCatch+  , catchAnd+  , combineCatchers++  , -- * Running 'IO' actions against an 'ExceptionCatcher'+    handledWith+  ) where++import Control.Exception+import Data.Monoid++-- | A container for zero or more "exception catchers".+--+--   By exception catcher, we mean here a function that can convert+--   some precise instance of 'Exception' to the error type used in+--   your scotty app (the @e@ type in "Servant.Resource" "Servant.Service")+newtype ExceptionCatcher err =+	EC [Catcher err]++-- a handy type for representing a single function that can catch+-- some (specific) exception.+-- The dictionary for the corresponding 'Exception' instance is packed+-- along with the function in this data type.+data Catcher err = forall exc. Exception exc => Catcher (exc -> err)++-- | Don't catch any exception.+noCatch :: ExceptionCatcher err+noCatch = EC []++-- | Combine two 'ExceptionCatcher'.+--+--   The resulting 'ExceptionCatcher' will be able to catch+--   exceptions using the /catchers/ from both arguments.+combineCatchers :: ExceptionCatcher err+                -> ExceptionCatcher err+                -> ExceptionCatcher err+combineCatchers (EC c1s) (EC c2s) = EC (c1s ++ c2s)++-- | If you're into 'Monoid's, enjoy our+--   'mempty' ('noErrorHandling') and '<>' ('combineCatchers').+instance Monoid (ExceptionCatcher err) where+  mempty = noCatch++  mappend = combineCatchers++-- | Run an 'IO' action by watching for all the exceptions+--   supported by the 'ExceptionCatcher'.+--+--   If an exception is thrown somewhere in the action and is caught+--   by the catcher, it will call the function given to 'catchAnd'+--   to convert the exception value to the error type of your scotty application.+--+--   If an exception is thrown whose type isn't one for which there's a /catcher/+--   in the 'ExceptionCatcher' argument, you'll have to catch it yourself or let it+--   be sent to the default handler.+--+--   Since 'Servant.Service.runService' sets up a 'defaultHandler', you'll most+--   likely want to directly use 'raiseIfExc' which 'raise's the error value+--   you got from the exception if some exception is thrown or just run some+--   scotty action if everything went smoothly. This means writing a handler+--   that'll set up a response with the proper HTTP status and send some JSON+--   to the client with an informative error message, which... isn't a bad thing :-)+handledWith :: IO a -> ExceptionCatcher err -> IO (Either err a)+handledWith act (EC hs) = fmap Right act `catches` map runCatcher hs++  where runCatcher :: Catcher err -> Handler (Either err a)+        runCatcher (Catcher f) = Handler $ return . Left . f++-- | Create an 'ExceptionCatcher' from a function.+--+--   This will make the catcher aware of exceptions of type @except@+--   so that when you'll run a catcher against an 'IO' action+--   using 'raiseIfExc' or 'handledWith', if an exception of this type+--   is thrown, it will be caught and converted to the error type of your+--   web application using the provided function.+catchAnd :: Exception except+         => (except -> err) +         -> ExceptionCatcher err+catchAnd f = EC [catcher]+  where catcher = Catcher f
+ src/Servant/Prelude.hs view
@@ -0,0 +1,163 @@+{-# LANGUAGE TypeOperators,+             ConstraintKinds,+             MultiParamTypeClasses,+             TypeFamilies,+             TypeSynonymInstances,+             DataKinds,+             FlexibleContexts,+             FlexibleInstances,+             ScopedTypeVariables #-}+{- |+Module      :  Servant.Prelude+Copyright   :  (c) Zalora SEA 2014+License     :  BSD3+Maintainer  :  Alp Mestanogullari <alp@zalora.com>+Stability   :  experimental++Some standard REST-y operations your 'Resource's can+support out of the box.++Your type will have to implement a couple of class instances+to be usable with a backend. For the scotty backend, this means+having 'FromJSON' or 'ToJSON' instances and the appropriate+'toResponse' implementations for the return types of your+database.+-}+module Servant.Prelude+ ( -- * Defining 'Resource's+   module Servant.Resource+ , module Servant.Context+ , module Servant.Error+ + , -- * Standard operations+   Add+ , addWith+ , Delete+ , deleteWith+ , ListAll+ , listAllWith+ , Update+ , updateWith+ , View+ , viewWith+ ) where++import Servant.Context+import Servant.Error+import Servant.Resource++-- | A dummy type representing an operation that adds an entry.+data Add+instance Show Add where show _ = "Add"++-- | A dummy type representing an operation that deletes an entry.+data Delete+instance Show Delete where show _ = "Delete"++-- | A dummy type representing an operation that lists all entries.+data ListAll+instance Show ListAll where show _ = "ListAll"++-- | A dummy type representing an operation that updates an entry.+data Update+instance Show Update where show _ = "Update"++-- | A dummy type representing an operation that looks up an entry.+data View+instance Show View where show _ = "View"++-- | To 'Add' an entry, we require a function of type @c -> a -> IO r@.+type instance Operation Add c a i r     =      a -> c -> IO (r Add)+-- | To 'Delete' an entry, we require a function of type @c -> i -> IO r@.+type instance Operation Delete c a i r  = i      -> c -> IO (r Delete)+-- | To 'List' all entries, we require a function of type @c -> IO [a]@.+type instance Operation ListAll c a i r =           c -> IO [a]+-- | To 'Update' an entry, we require a function of type @c -> i -> a -> IO r@.+type instance Operation Update c a i r  = i -> a -> c -> IO (r Update)+-- | To 'View' an entry, we require a function of type @c -> i -> IO (Maybe a)@.+type instance Operation View c a i r    = i      -> c -> IO (Maybe a)++-- | Make a 'Resource' support the 'Add'+--   operation by using your function.+--+--   Given:+--+--   > addPerson :: PGSQL.Connection -> Person -> IO Bool+--+--   you could do:+--+--   > mkResource "persons" postgresContext noErrorHandling+--   >   & addWith addPerson+addWith :: Contains Add ops ~ False+        => (a -> c -> IO (r Add))+        -> Resource c a i r e ops+        -> Resource c a i r e (Add ': ops)+addWith = addOperation++-- | Make a 'Resource' support the 'Delete'+--   operation by using your function.+--+--   Given:+--+--   > deletePerson :: PGSQL.Connection -> PersonId -> IO Bool+--+--   you could do:+--+--   > mkResource "persons" postgresContext noErrorHandling+--   >   & deleteWith addPerson+deleteWith :: Contains Delete ops ~ False+           => (i -> c -> IO (r Delete))+           -> Resource c a i r e ops+           -> Resource c a i r e (Delete ': ops)+deleteWith = addOperation++-- | Make a 'Resource' support the 'ListAll'+--   operation by using your function.+--+--   Given:+--+--   > listAllPersons :: PGSQL.Connection -> IO [Person]+--+--   you could do:+--+--   > mkResource "persons" postgresContext noErrorHandling+--   >   & listAllWith listAllPersons+listAllWith :: Contains ListAll ops ~ False+            => (c -> IO [a])+            -> Resource c a i r e ops+            -> Resource c a i r e (ListAll ': ops)+listAllWith = addOperation++-- | Make a 'Resource' support the 'Update'+--   operation by using your function.+--+--   Given:+--+--   > updatePerson :: PGSQL.Connection -> PersonId -> Person -> IO Bool+--+--   you could do:+--+--   > mkResource "persons" postgresContext noErrorHandling+--   >   & updateWith updatePerson+updateWith :: Contains Update ops ~ False+           => (i -> a -> c -> IO (r Update))+           -> Resource c a i r e ops+           -> Resource c a i r e (Update ': ops)+updateWith = addOperation++-- | Make a 'Resource' support the 'View'+--   operation by using your function.+--+--   Given:+--+--   > viewPerson :: PGSQL.Connection -> PersonId -> IO (Maybe Person)+--+--   you could do:+--+--   > mkResource "persons" postgresContext noErrorHandling+--   >   & viewWith viewPerson+viewWith :: Contains View ops ~ False+         => (i -> c -> IO (Maybe a))+         -> Resource c a i r e ops+         -> Resource c a i r e (View ': ops)+viewWith = addOperation
+ src/Servant/Resource.hs view
@@ -0,0 +1,193 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}++{- |+Module      :  Servant.Resource+Copyright   :  (c) Zalora SEA 2014+License     :  BSD3+Maintainer  :  Alp Mestanogullari <alp@zalora.com>+Stability   :  experimental++Defining 'Resource's.+-}+module Servant.Resource+  ( Resource+  , name+  , context+  , excCatcher+  , withHeadOperation+  , dropHeadOperation+  , mkResource+  , addOperation+  , Operation+  , (&)+  , Ops+  , Contains+  ) where++import Servant.Context+import Servant.Error++-- | Heterogeneous list+data HList :: [*] -> * where+  Nil :: HList '[]+  Cons :: a -> HList as -> HList (a ': as)++hhead :: HList (a ': as) -> a+hhead (Cons h _) = h++-- | Get the tail of an heterogeneous list+htail :: HList (a ': as) -> HList as+htail (Cons _ t) = t++-- | Utility (closed) type family to detect whether a type+--   is contained in a type-level list of types+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 781+type family Contains (elem :: *) (list :: [*]) :: Bool where+  Contains elem '[] = False+  Contains elem (elem ': xs) = True+  Contains elem (x ': xs) = Contains elem xs+#else+type Contains (elem :: *) (list :: [*]) = False+#endif++-- | A resource that:+--+--   * uses some context type @c@ (think database connection)+--   * manages entries of type @a@+--   * (optionally) supports indexing through the @i@ type (a dumb ID, or something like+--     @data FooId = ByToken Token | ByID Integer@). That can be useful when trying to view,+--     update or delete a particular entry, for example.+--   * uses @r@ as the return type (tagged by the operation type) for /effectful/ database operations (e.g. adding, updating, deleting entries+--     for example).+--   * can catch exceptions, converting them to some error type+--     @e@ of yours+--   * supports the operations listed in the @ops@ type list. a corresponding+--     (heterogeneous) list of "database functions" is held internally and we+--     ask the compiler to make the types of these functions match with the ones+--     expected for the operations listed at the type-level.+data Resource c a i (r :: * -> *) e (ops :: [*])+  = Resource { name       :: String    -- ^ Get the name of the 'Resource'+             , context    :: Context c -- ^ Gives the 'Context' attached to this 'Resource'+             , excCatcher :: ExceptionCatcher e -- ^ Hands you the 'ExceptionCatcher' you can+                                                --   'handledWith' with to make your \"database operations\"+                                                --   exception safe.+             , operations :: HList (Ops ops c a i r)+             }++instance Show (Resource c a i r e '[]) where+  show r = name r++instance (Show o, Show (Resource c a i r e ops)) +      => Show (Resource c a i r e (o ': ops)) where+  show r = +    show (dropHeadOperation r) +++    opstring++    where opstring = "\n  - " ++ show (undefined :: o)++-- | Typically, functions that will use our operations will need access+--   to the resource's name and what not, so we need to provide them with+--   the resource. But we obviously also need the \"database function\"+--   associated to our operation. So we provide it too.+--+--   Just give this function a 'Resource' and a function that uses it,+--   most likely to run the handler for an operation,+--   and it'll give your function the right arguments.+withHeadOperation :: Resource c a i r e (o ': ops)+                  -> (Resource c a i r e (o ': ops) -> Operation o c a i r -> b)+                  -> b+withHeadOperation res runop =+  runop res (hhead $ operations res)++-- | Type-safely \"unconsider\" the first operation in the list+--+--   Helpful when performing recursion on the type-level list+--   and the internal list of \"database functions\"+--   simultaneously.+dropHeadOperation :: Resource c a i r e (o ': ops) -> Resource c a i r e ops+dropHeadOperation r = r { operations = operations' }++  where operations' = htail (operations r)++-- | Create an /empty/ resource that doesn't support any operation+--   and catches exceptions using the given 'ExceptionCatcher'.+--   Any operation supported later on can make use of the provided+--   'Context', by simply doing:+--+--   > withContext (context resource) $ \c -> ...+--+--   where @c@ could be a PostgreSQL connection, for example.+mkResource :: String+           -> Context c+           -> ExceptionCatcher e+           -> Resource c a i r e '[]+mkResource n ctx catcher = Resource n ctx catcher Nil++-- | Add an operation to a resource by specifying the \"database function\"+--   that'll actually perform the lookup, update, listing, search and what not.+--+--   We statically enforce that the operation we're adding isn't+--   already supported by the 'Resource', when built with @ghc >= 7.8@.+addOperation :: Contains o ops ~ False+             => Operation o c a i r +             -> Resource c a i r e ops +             -> Resource c a i r e (o ': ops)+addOperation opfunc resource =+  resource { operations = Cons opfunc (operations resource) }++-- | Type level 'map'-like function that replaces an operation's tag+--   by the type of the associated \"database function\"+--+--   For example:+--+--   > Ops [Add, List] c a i r+--+--   will result in:+--+--   > [ a -> c -> IO r -- what 'Add' is replaced by+--   > , c -> IO [a]    -- what 'List' is replaced by+--   > ]+--+--   This is useful as we can exactly determine the type of the heterogeneous+--   list that holds the actual \"dtabase functions\" that will perform the+--   operations, using 'Ops'. This among other things enforces a strong+--   correspondance between the type-level list of operations and the+--   (heterogeneous) list of functions held in the 'Resource' we're interested in.+--+--   That means we can't magically convert a 'Resource' into one that supports one more+--   operations without registering a function for it (which /must have/ the right type,+--   or your code won't compile.+type family Ops (ops :: [*]) c a i (r :: * -> *) :: [*]+type instance Ops (o ': ops) c a i r = Operation o c a i r ': Ops ops c a i r+type instance Ops '[] c a i r = '[]++-- | Map an operation tag @o@ to some combination of the other type+--   parameters.+--+--   For instance, if we look at 'Add', we know that we'll need our+--   \"connection type\" @c@ and a value to add, of type @a@. The result will+--   be of type @IO (r Add)@. If we put this all together, we get:+--+--   > type instance Operation Add c a i r = a -> c -> IO (r Add)+--+--   Whereas for listing all entries ('ListAll'), we just want some kind+--   of connection @c@ and we get back @[a]@.+--+--   > type instance Operation ListAll c a i r = c -> IO [a]+type family Operation o c a i (r :: * -> *) :: *++-- | Reversed function application.+--+--   > x & f = f x+(&) :: a -> (a -> b) -> b+x & f = f x+{-# INLINE (&) #-}