waitra 0.0.2.0 → 0.0.3.0

raw patch · 4 files changed

+75/−6 lines, 4 filesdep +bytestringdep +directorydep +filepathPVP ok

version bump matches the API change (PVP)

Dependencies added: bytestring, directory, filepath, template-haskell

API changes (from Hackage documentation)

Files

• README.md +1/−1
• src/Network/Waitra.hs +11/−2
• src/Network/Waitra/Embedded.hs +55/−0
• waitra.cabal +8/−3

@@ -14,7 +14,7 @@   where echoApp msg _req respond = respond $ responseLBS status200 [] (fromString msg)  app :: Application-app = waitraMiddleware [echoRoute] fallbackApp+app = waitraMiddleware [echoRoute] $ staticApp $ embeddedSettings $(mkRecursiveEmbedded "static") ```  ## Documentation

@@ -28,17 +28,18 @@   , routeDelete   -- * JSON helper   , jsonApp+  , jsonApp'   -- * Compilation   , routeMiddleware   , waitraMiddleware   ) where  import           Data.Aeson+import           Data.String (fromString) import qualified Data.Text as T import qualified Network.HTTP.Types as H import           Network.Wai import           Text.Regex.Applicative-import Data.String (fromString)  -- | We use strings, as - unluckily - `Text.Regex.Applicative` doesn't work with `Text` directly. type Path = String@@ -85,10 +86,18 @@ waitraMiddleware :: [Route] -> Middleware waitraMiddleware = foldr ((.) . routeMiddleware) id +jsonHeader :: H.Header+jsonHeader = (H.hContentType, fromString "application/json")+ jsonApp :: (FromJSON a, ToJSON b) => (a -> IO (H.Status, H.ResponseHeaders, b)) -> Application jsonApp f req respond = do   body <- strictRequestBody req   case eitherDecode body of     Left err  -> respond $ responseLBS H.status400 [] $ fromString err     Right x   -> do (status, headers, y) <- f x-                    respond $ responseLBS status ((H.hContentType, fromString "application/json") : headers) $ encode y+                    respond $ responseLBS status (jsonHeader : headers) $ encode y++jsonApp' :: ToJSON b => IO (H.Status, H.ResponseHeaders, b) -> Application+jsonApp' io _req respond = do+  (status, headers, y) <- io+  respond $ responseLBS status (jsonHeader : headers) $ encode y

@@ -0,0 +1,55 @@+{-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-}+------------------------------------------------------------+-- |+-- Module      :  Network.Waitra.Embedded+-- Copyright   :  (c) 2015 Futurice+-- License     :  MIT (see the file LICENSE)+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+-- Stability   :  experimental+--+-- @Network.Waitra.Embedded@ is a missing part from @wai-app-static@.+----------------------------------------------------------------------------+module Network.Waitra.Embedded (mkRecursiveEmbedded) where++import           Control.Applicative+import           Control.Arrow (first)+import           Control.Monad (forM)+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as B8+import qualified Data.ByteString.Lazy as BL+import           Language.Haskell.TH+import           System.Directory (doesDirectoryExist, getDirectoryContents)+import           System.FilePath ((</>), makeRelative)++getRecursiveContents :: FilePath -> IO [(FilePath, BL.ByteString)]+getRecursiveContents topdir = do+  names <- getDirectoryContents topdir+  let properNames = Prelude.filter (`notElem` [".", ".."]) names+  paths <- forM properNames $ \name -> do+    let path = topdir </> name+    isDirectory <- doesDirectoryExist path+    if isDirectory+      then getRecursiveContents path+      else do contents <- BL.readFile path+              return [(path, contents)]+  return (concat paths)++makeAllRelative :: FilePath -> [(FilePath, a)] -> [(FilePath, a)]+makeAllRelative topdir = map (first (("/" ++) . makeRelative topdir))++bytestringE :: B.ByteString -> Q Exp+bytestringE b = [| B8.pack $s |]+  where s = litE $ stringL $ B8.unpack b++makeEmbeddedEntry :: (FilePath, BL.ByteString) -> Q Exp+makeEmbeddedEntry (path, bs) = [| (path, $(bytestringE $ BL.toStrict bs)) |]++-- | Create a @[(FilePath, ByteString)]@ list, recursively traversing given directory path.+--+-- > staticApp $ embeddedSettings $(mkRecursiveEmbedded "static")+-- > -- is an in-memory equivalent of+-- > staticApp $ defaultFileServerSettings "static" +mkRecursiveEmbedded :: FilePath -> Q Exp+mkRecursiveEmbedded topdir = do+  pairs <- runIO $ makeAllRelative topdir <$> getRecursiveContents topdir+  listE $ map makeEmbeddedEntry pairs

@@ -1,5 +1,5 @@ name:                waitra-version:             0.0.2.0+version:             0.0.3.0 synopsis:            A very simple Wai router description:   Waitra is a very simple router.@@ -11,7 +11,7 @@   >  where echoApp msg _req respond = respond $ responseLBS status200 [] (fromString msg)   >   > app :: Application-  > app = waitraMiddleware [echoRoute] fallbackApp+  > app = waitraMiddleware [echoRoute] $ staticApp $ embeddedSettings $(mkRecursiveEmbedded "static") homepage:            https://github.com/futurice/waitra license:             MIT license-file:        LICENSE@@ -24,11 +24,16 @@ cabal-version:       >=1.10  library-  exposed-modules:     Network.Waitra+  exposed-modules:     Network.Waitra,+                       Network.Waitra.Embedded   build-depends:       base              >=4.6 && <4.9,                        aeson             >=0.8.0.2,+                       bytestring        >=0.10.4.0,+                       directory         >=1.2.1.0,+                       filepath          >=1.3.0.2,                        http-types        >=0.8.6,                        regex-applicative >=0.3.1,+                       template-haskell,                        text              >=1.1.0.0,                        wai               >=3.0.2.3   hs-source-dirs:      src