rest-happstack (empty) → 0.2.9.4

raw patch · 4 files changed

+108/−0 lines, 4 filesdep +basedep +containersdep +happstack-serversetup-changed

Dependencies added: base, containers, happstack-server, mtl, rest-core, rest-types, transformers, utf8-string

Files

LICENSE +30/−0
Setup.hs +2/−0
rest-happstack.cabal +30/−0
src/Rest/Driver/Happstack.hs +46/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2014, Silk++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 Silk 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

+ rest-happstack.cabal view

@@ -0,0 +1,30 @@+Name:             rest-happstack+Version:          0.2.9.4+Description:      Rest driver for Happstack.+Synopsis:         Rest driver for Happstack.+Maintainer:       code@silk.co+Category:         Web+Build-Type:       Simple+Cabal-Version:    >= 1.8+License:          BSD3+License-File:     LICENSE++Library+  GHC-Options:     -Wall+  Hs-Source-Dirs:   src+  Build-Depends:++      base             == 4.*+    , containers       >= 0.4    && < 0.6+    , happstack-server >= 7.0.5  && < 7.4+    , mtl              >= 2.0    && < 2.2+    , rest-types       == 1.9.0.1+    , transformers     == 0.3.*+    , utf8-string      == 0.3.*+    , rest-core        == 0.27.*++  Exposed-Modules:  Rest.Driver.Happstack++Source-repository head+  Type:              Git+  Location:          https://github.com/silkapp/rest.git

+ src/Rest/Driver/Happstack.hs view

@@ -0,0 +1,46 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE RankNTypes #-}+module Rest.Driver.Happstack (apiToHandler, apiToHandler') where++import Control.Applicative+import Control.Concurrent.MVar (readMVar)+import Control.Monad+import Control.Monad.Trans (MonadIO (liftIO))+import Happstack.Server++import qualified Data.ByteString.UTF8 as UTF8+import qualified Data.Map             as M+import qualified Happstack.Server     as Happstack++import Rest.Api (Api)+import Rest.Driver.Perform (Rest (..))+import Rest.Driver.Types (Run)++import qualified Rest.Run          as Rest+import qualified Rest.Driver.Types as Rest++apiToHandler :: (Functor m, MonadPlus m, MonadIO m) => Api (ServerPartT m) -> ServerPartT m Response+apiToHandler = apiToHandler' id++apiToHandler' :: (Functor n, MonadPlus n, MonadIO n) => Run m (ServerPartT n) -> Api m -> ServerPartT n Response+apiToHandler' run api = toResponse <$> Rest.apiToHandler' run api++instance (Functor m, MonadPlus m, MonadIO m) => Rest (ServerPartT m) where+  getHeader nm     = fmap UTF8.toString . Happstack.getHeader nm <$> askRq+  getParameter  nm = Just <$> look nm <|> pure Nothing+  getBody =+    do rq <- askRq+       bdy <- liftIO (readMVar (rqBody rq))+       return (unBody bdy)+  getMethod       = toRestMethod . rqMethod <$> askRq+  getPaths        = rqPaths <$> askRq+  lookupMimeType  = return . flip M.lookup Happstack.mimeTypes+  setHeader       = Happstack.setHeaderM+  setResponseCode = Happstack.setResponseCode++toRestMethod :: Happstack.Method -> Rest.Method+toRestMethod Happstack.GET    = Rest.GET+toRestMethod Happstack.POST   = Rest.POST+toRestMethod Happstack.PUT    = Rest.PUT+toRestMethod Happstack.DELETE = Rest.DELETE+toRestMethod mthd             = Rest.Unknown (show mthd)