packages feed

wai-make-assets (empty) → 0.1

raw patch · 7 files changed

+295/−0 lines, 7 filesdep +basedep +bytestringdep +directorysetup-changed

Dependencies added: base, bytestring, directory, getopt-generics, hspec, http-types, lens, mockery, shake, silently, string-conversions, wai, wai-app-static, warp, wreq

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2016, Sönke Hahn++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 Sönke Hahn 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,3 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+main = defaultMain
+ src/Network/Wai/MakeAssets.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TupleSections #-}++module Network.Wai.MakeAssets (serveAssets) where++import           Control.Concurrent+import           Control.Exception+import           Control.Monad+import           Data.List (intercalate)+import           Data.Monoid+import           Data.String.Conversions+import           Development.Shake (cmd, Exit(..), Stderr(..), CmdOption(..))+import           Network.HTTP.Types.Status+import           Network.Wai+import           Network.Wai.Application.Static+import           System.Directory+import           System.Exit++serveAssets :: IO Application+serveAssets = do+  startupChecks+  let fileApp = staticApp $ defaultFileServerSettings "assets/"+  mvar <- newMVar ()+  return $ \ request respond -> do+    (Exit exitCode, Stderr errs) <- synchronize mvar $+      cmd (Cwd "client") "make"+    case exitCode of+      ExitSuccess -> fileApp request respond+      ExitFailure _ -> respond $ responseLBS internalServerError500 [] $+        cs "make error:\n" <> errs++synchronize :: MVar () -> IO a -> IO a+synchronize mvar action = modifyMVar mvar $ \ () -> ((), ) <$> action++startupChecks :: IO ()+startupChecks = do+  checkExists Dir "client/" $+    "You should put sources for assets in there."+  checkExists File "client/Makefile" $ unwords $+    "Which will be invoked to build the assets." :+    "It should put compiled assets into 'assets/'." :+    []+  checkExists Dir "assets/" $+    "All files in 'assets/' will be served."++data FileType+  = File+  | Dir++checkExists :: FileType -> FilePath -> String -> IO ()+checkExists typ path hint = do+  exists <- (isFile doesFileExist doesDirectoryExist) path+  when (not exists) $ do+    throwIO $ ErrorCall $ intercalate "\n" $+      ("missing " ++ isFile "file" "directory" ++ ": '" ++ path ++ "'") :+      ("Please create '" ++ path ++ "'.") :+      ("(" ++ hint ++ ")") :+      []+  where+    isFile :: a -> a -> a+    isFile a b = case typ of+      File -> a+      Dir -> b
+ src/wai-make-assets.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE DeriveGeneric #-}++import           Network.Wai.Handler.Warp+import           System.IO+import           WithCli++import           Network.Wai.MakeAssets++data Args+  = Args {+    port :: Int+  }+  deriving (Generic)++instance HasArguments Args++main :: IO ()+main = withCliModified [AddShortOption "port" 'p'] $ \ (Args port) -> do+  let settings =+        setPort port $+        setBeforeMainLoop (hPutStrLn stderr+          ("listening to " ++ show port ++ "...")) $+        defaultSettings+  runSettings settings =<< serveAssets
+ test/Network/Wai/MakeAssetsSpec.hs view
@@ -0,0 +1,92 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.Wai.MakeAssetsSpec where++import           Control.Exception+import           Control.Lens+import           Data.ByteString.Lazy (isPrefixOf)+import           Data.List (intercalate)+import           Network.Wai.Handler.Warp+import           Network.Wreq+import           System.Directory+import           System.IO.Silently+import           Test.Hspec+import           Test.Mockery.Directory++import           Network.Wai.MakeAssets++spec :: Spec+spec = do+  around_ silence $ do+    describe "serverClient" $ do+      it "returns static files" $ do+        inTempDirectory $ do+          createDirectoryIfMissing True "client"+          createDirectoryIfMissing True "assets"+          writeFile "assets/foo" "bar"+          writeFile "client/Makefile" "all:\n\ttrue"+          testWithApplication serveAssets $ \ port -> do+            let url = "http://localhost:" ++ show port ++ "/foo"+            response <- get url+            response ^. responseBody `shouldBe` "bar"++      it "runs 'make' in 'client/' before answering requests" $ do+        inTempDirectory $ do+          createDirectoryIfMissing True "client"+          createDirectoryIfMissing True "assets"+          writeFile "client/Makefile" "all:\n\techo bar > ../assets/foo"+          testWithApplication serveAssets $ \ port -> do+            let url = "http://localhost:" ++ show port ++ "/foo"+            response <- get url+            response ^. responseBody `shouldBe` "bar\n"++      it "returns the error messages in case 'make' fails" $ do+        inTempDirectory $ do+          createDirectoryIfMissing True "client"+          createDirectoryIfMissing True "assets"+          writeFile "client/Makefile" "all:\n\t>&2 echo error message ; false"+          testWithApplication serveAssets $ \ port -> do+            let url = "http://localhost:" ++ show port ++ "/foo"+            response <- getWith acceptErrors url+            let body = response ^. responseBody+            body `shouldSatisfy` ("make error:\nerror message\n" `isPrefixOf`)++      context "complains about missing files or directories" $ do+        it "missing client/" $ do+          inTempDirectory $ do+            createDirectoryIfMissing True "assets"+            let expected = intercalate "\n" $+                  "missing directory: 'client/'" :+                  "Please create 'client/'." :+                  "(You should put sources for assets in there.)" :+                  []+            testWithApplication serveAssets (\ _ -> return ())+              `shouldThrow` errorCall expected++        it "missing client/Makefile" $ do+          inTempDirectory $ do+            createDirectoryIfMissing True "client"+            createDirectoryIfMissing True "assets"+            let expected = intercalate "\n" $+                  "missing file: 'client/Makefile'" :+                  "Please create 'client/Makefile'." :+                  "(Which will be invoked to build the assets. It should put compiled assets into 'assets/'.)" :+                  []+            testWithApplication serveAssets (\ _ -> return ())+              `shouldThrow` errorCall expected++        it "missing assets/" $ do+          inTempDirectory $ do+            touch "client/Makefile"+            let expected = intercalate "\n" $+                  "missing directory: 'assets/'" :+                  "Please create 'assets/'." :+                  "(All files in 'assets/' will be served.)" :+                  []+            catch (testWithApplication serveAssets (\ _ -> return ())) $+              \ (ErrorCall message) -> do+                message `shouldBe` expected++acceptErrors :: Options+acceptErrors = defaults &+  checkStatus .~ Just (\ _ _ _ -> Nothing)
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ wai-make-assets.cabal view
@@ -0,0 +1,82 @@+-- This file has been generated from package.yaml by hpack version 0.14.0.+--+-- see: https://github.com/sol/hpack++name:           wai-make-assets+version:        0.1+synopsis:       Compiling and serving assets+description:    Small wai library and command line tool for compiling and serving assets (e.g. through ghcjs, elm, sass)+category:       Development+homepage:       https://github.com/soenkehahn/wai-make-assets#readme+bug-reports:    https://github.com/soenkehahn/wai-make-assets/issues+maintainer:     SoenkeHahn@gmail.com+license:        BSD3+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10++source-repository head+  type: git+  location: https://github.com/soenkehahn/wai-make-assets++library+  hs-source-dirs:+      src+  build-depends:+      base < 99+    , wai-app-static+    , wai+    , warp+    , string-conversions+    , bytestring+    , shake+    , http-types+    , directory+  exposed-modules:+      Network.Wai.MakeAssets+  default-language: Haskell2010++executable wai-make-assets+  main-is: wai-make-assets.hs+  hs-source-dirs:+      src+  build-depends:+      base < 99+    , wai-app-static+    , wai+    , warp+    , string-conversions+    , bytestring+    , shake+    , http-types+    , directory+    , getopt-generics+  other-modules:+      Network.Wai.MakeAssets+  default-language: Haskell2010++test-suite spec+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  hs-source-dirs:+      test+    , src+  build-depends:+      base < 99+    , wai-app-static+    , wai+    , warp+    , string-conversions+    , bytestring+    , shake+    , http-types+    , directory+    , hspec+    , wreq+    , mockery+    , lens+    , silently+  other-modules:+      Network.Wai.MakeAssetsSpec+      Network.Wai.MakeAssets+  default-language: Haskell2010