packages feed

wai-make-assets 0.1.1 → 0.2

raw patch · 4 files changed

+96/−28 lines, 4 filesdep +data-defaultdep +filepath

Dependencies added: data-default, filepath

Files

src/Network/Wai/MakeAssets.hs view
@@ -1,11 +1,18 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} -module Network.Wai.MakeAssets (serveAssets) where+module Network.Wai.MakeAssets (+  serveAssets,+  Options(..), +  -- * re-exports+  Default(..),+) where+ import           Control.Concurrent import           Control.Exception import           Control.Monad+import           Data.Default import           Data.List (intercalate) import           Data.Monoid import           Data.String.Conversions@@ -15,15 +22,41 @@ import           Network.Wai.Application.Static import           System.Directory import           System.Exit+import           System.FilePath -serveAssets :: IO Application-serveAssets = do-  startupChecks+data Options+  = Options {+    clientDir :: FilePath+  }++instance Default Options where+  def = Options {+    clientDir = "client"+  }++-- | 'serveAssets' will create a wai 'Application' that serves files from the+-- "assets" directory.+--+-- The workflow that 'serveAssets' allows is similar to working on files (for+-- web-sites) that don't need compilation or generation, e.g. html, css, php or+-- javascript. You edit the file in an editor, save it, switch to a browser and+-- hit reload. 'serveAssets' makes sure your browser will be sent up-to-date+-- files.+--+-- To accomplish this, 'serveAssets' assumes that there's a "Makefile" in the+-- directory pointed to by 'clientDir' (default: "client"). This "Makefile" is+-- supposed to put compilation results into the "assets" directory. On __every__+-- request, 'serveAssets' will execute that "Makefile" and only start serving+-- files once the "Makefile" is done. ('serveAssets' makes sure not to run your+-- "Makefile" concurrently.)+serveAssets :: Options -> IO Application+serveAssets options = do+  startupChecks options   let fileApp = staticApp $ defaultFileServerSettings "assets/"   mvar <- newMVar ()   return $ \ request respond -> do     (Exit exitCode, Stderr errs) <- synchronize mvar $-      cmd (Cwd "client") "make"+      cmd (Cwd (clientDir options)) "make"     case exitCode of       ExitSuccess -> fileApp request respond       ExitFailure _ -> respond $ responseLBS internalServerError500 [] $@@ -32,15 +65,15 @@ synchronize :: MVar () -> IO a -> IO a synchronize mvar action = modifyMVar mvar $ \ () -> ((), ) <$> action -startupChecks :: IO ()-startupChecks = do-  checkExists Dir "client/" $+startupChecks :: Options -> IO ()+startupChecks options = do+  checkExists Dir (clientDir options) $     "You should put sources for assets in there."-  checkExists File "client/Makefile" $ unwords $+  checkExists File (clientDir options </> "Makefile") $ unwords $     "Which will be invoked to build the assets." :     "It should put compiled assets into 'assets/'." :     []-  checkExists Dir "assets/" $+  checkExists Dir "assets" $     "All files in 'assets/' will be served."  data FileType@@ -52,8 +85,8 @@   exists <- (isFile doesFileExist doesDirectoryExist) path   when (not exists) $ do     throwIO $ ErrorCall $ intercalate "\n" $-      ("missing " ++ isFile "file" "directory" ++ ": '" ++ path ++ "'") :-      ("Please create '" ++ path ++ "'.") :+      ("missing " ++ isFile "file" "directory" ++ ": '" ++ showPath path ++ "'") :+      ("Please create '" ++ showPath path ++ "'.") :       ("(" ++ hint ++ ")") :       []   where@@ -61,3 +94,8 @@     isFile a b = case typ of       File -> a       Dir -> b++    showPath :: FilePath -> String+    showPath = case typ of+      File -> id+      Dir -> (++ "/")
src/wai-make-assets.hs view
@@ -1,16 +1,20 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ViewPatterns #-} +{-# OPTIONS_GHC -fno-warn-unused-binds #-}+ import           Data.Maybe import           Network.Wai.Handler.Warp import           System.IO import           WithCli -import           Network.Wai.MakeAssets+import qualified Network.Wai.MakeAssets as MA+import           Network.Wai.MakeAssets hiding (clientDir)  data Args   = Args {-    port :: Maybe Int+    port :: Maybe Int,+    clientDir :: Maybe FilePath   }   deriving (Generic) @@ -18,10 +22,12 @@  main :: IO () main = withCliModified [AddShortOption "port" 'p'] $-  \ (Args (fromMaybe 8000 -> port)) -> do-    let settings =-          setPort port $+  \ args -> do+    let appPort = fromMaybe 8000 (port args)+        settings =+          setPort appPort $           setBeforeMainLoop (hPutStrLn stderr-            ("listening to " ++ show port ++ "...")) $+            ("listening to " ++ show appPort ++ "...")) $           defaultSettings-    runSettings settings =<< serveAssets+        options = maybe def (\ cd -> def{ MA.clientDir = cd }) (clientDir args)+    runSettings settings =<< serveAssets options
test/Network/Wai/MakeAssetsSpec.hs view
@@ -6,8 +6,9 @@ import           Control.Lens import           Data.ByteString.Lazy (isPrefixOf) import           Data.List (intercalate)+import           Network.Wai import           Network.Wai.Handler.Warp-import           Network.Wreq+import           Network.Wreq as Wreq import           System.Directory import           System.IO.Silently import           Test.Hspec@@ -15,6 +16,9 @@  import           Network.Wai.MakeAssets +serveDef :: IO Application+serveDef = serveAssets def+ spec :: Spec spec = do   around_ silence $ do@@ -25,7 +29,7 @@           createDirectoryIfMissing True "assets"           writeFile "assets/foo" "bar"           writeFile "client/Makefile" "all:\n\ttrue"-          testWithApplication serveAssets $ \ port -> do+          testWithApplication serveDef $ \ port -> do             let url = "http://localhost:" ++ show port ++ "/foo"             response <- get url             response ^. responseBody `shouldBe` "bar"@@ -35,17 +39,28 @@           createDirectoryIfMissing True "client"           createDirectoryIfMissing True "assets"           writeFile "client/Makefile" "all:\n\techo bar > ../assets/foo"-          testWithApplication serveAssets $ \ port -> do+          testWithApplication serveDef $ \ port -> do             let url = "http://localhost:" ++ show port ++ "/foo"             response <- get url             response ^. responseBody `shouldBe` "bar\n" +      it "allows to configure the name of the 'client/' directory" $ do+        inTempDirectory $ do+          createDirectoryIfMissing True "custom"+          createDirectoryIfMissing True "assets"+          writeFile "custom/Makefile" "all:\n\techo bar > ../assets/foo"+          let options = def{ clientDir = "custom" }+          testWithApplication (serveAssets options) $ \ 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+          testWithApplication serveDef $ \ port -> do             let url = "http://localhost:" ++ show port ++ "/foo"             response <- getWith acceptErrors url             let body = response ^. responseBody@@ -60,7 +75,7 @@                   "Please create 'client/'." :                   "(You should put sources for assets in there.)" :                   []-            testWithApplication serveAssets (\ _ -> return ())+            testWithApplication serveDef (\ _ -> return ())               `shouldThrow` errorCall expected          it "missing client/Makefile" $ do@@ -72,7 +87,7 @@                   "Please create 'client/Makefile'." :                   "(Which will be invoked to build the assets. It should put compiled assets into 'assets/'.)" :                   []-            testWithApplication serveAssets (\ _ -> return ())+            testWithApplication serveDef (\ _ -> return ())               `shouldThrow` errorCall expected          it "missing assets/" $ do@@ -83,10 +98,10 @@                   "Please create 'assets/'." :                   "(All files in 'assets/' will be served.)" :                   []-            catch (testWithApplication serveAssets (\ _ -> return ())) $+            catch (testWithApplication serveDef (\ _ -> return ())) $               \ (ErrorCall message) -> do                 message `shouldBe` expected -acceptErrors :: Options+acceptErrors :: Wreq.Options acceptErrors = defaults &   checkStatus .~ Just (\ _ _ _ -> Nothing)
wai-make-assets.cabal view
@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack  name:           wai-make-assets-version:        0.1.1+version:        0.2 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@@ -22,6 +22,7 @@ library   hs-source-dirs:       src+  ghc-options: -Wall -fno-warn-name-shadowing   build-depends:       base < 99     , wai-app-static@@ -29,6 +30,8 @@     , warp     , string-conversions     , bytestring+    , data-default+    , filepath     , shake     , http-types     , directory@@ -40,6 +43,7 @@   main-is: wai-make-assets.hs   hs-source-dirs:       src+  ghc-options: -Wall -fno-warn-name-shadowing   build-depends:       base < 99     , wai-app-static@@ -47,6 +51,8 @@     , warp     , string-conversions     , bytestring+    , data-default+    , filepath     , shake     , http-types     , directory@@ -61,6 +67,7 @@   hs-source-dirs:       test     , src+  ghc-options: -Wall -fno-warn-name-shadowing   build-depends:       base < 99     , wai-app-static@@ -68,6 +75,8 @@     , warp     , string-conversions     , bytestring+    , data-default+    , filepath     , shake     , http-types     , directory