static: add several embedded generators

This constains the generators to embed files, directories,
and javascript compression

yesod-static/Yesod/EmbeddedStatic/Generators.hs

@@ -6,6 +6,21 @@
 module Yesod.EmbeddedStatic.Generators (
   -- * Generators
     Location
+  , embedFile
+  , embedFileAt
+  , embedDir
+  , embedDirAt
+  , concatFiles
+  , concatFilesWith
+
+  -- * Compression options for 'concatFilesWith'
+  , jasmine
+  , uglifyJs
+  , yuiJavascript
+  , yuiCSS
+  , closureJs
+  , compressTool
+  , tryCompressTools
 
   -- * Util
   , pathToName
@@ -15,11 +30,187 @@ module Yesod.EmbeddedStatic.Generators (
   -- $example
 ) where
 
+import Control.Applicative ((<$>))
+import Control.Exception (try, SomeException)
+import Control.Monad (forM)
+import Control.Monad.Trans.Resource (runResourceT)
 import Data.Char (isDigit, isLower)
+import Data.Conduit (($$), (=$))
+import Data.Conduit.Process (proc, conduitProcess)
 import Language.Haskell.TH
+import Network.Mime (defaultMimeLookup)
+import System.Directory (doesDirectoryExist, getDirectoryContents)
+import System.FilePath ((</>))
+import Text.Jasmine (minifym)
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.Conduit.List as C
+import qualified Data.Text as T
 
 import Yesod.EmbeddedStatic.Types
 
+-- | Embed a single file.  Equivalent to passing the same string twice to 'embedFileAt'.
+embedFile :: FilePath -> Generator
+embedFile f = embedFileAt f f
+
+-- | Embed a single file at a given location within the static subsite and generate a
+--   route variable based on the location via 'pathToName'.  The @FilePath@ must be a relative
+--   path to the directory in which you run @cabal build@.  During development, the file located
+--   at this filepath will be reloaded on every request.  When compiling for production, the contents
+--   of the file will be embedded into the executable and so the file does not need to be
+--   distributed along with the executable.
+embedFileAt :: Location -> FilePath -> Generator
+embedFileAt loc f = do
+    let mime = defaultMimeLookup $ T.pack f
+    let entry = Entry {
+                    ebHaskellName = Just $ pathToName loc
+                  , ebLocation = loc
+                  , ebMimeType = mime
+                  , ebProductionContent = BL.readFile f
+                  , ebDevelReload = [| BL.readFile $(litE $ stringL f) |]
+                  , ebDevelExtraFiles = Nothing
+                  }
+    return [entry]
+
+-- | List all files recursively in a directory
+getRecursiveContents :: Location -- ^ The directory to search
+                     -> FilePath   -- ^ The prefix to add to the filenames
+                     -> IO [(Location,FilePath)]
+getRecursiveContents prefix topdir = do
+  names <- getDirectoryContents topdir
+  let properNames = filter (`notElem` [".", ".."]) names
+  paths <- forM properNames $ \name -> do
+    let path = topdir </> name
+    let loc = if null prefix then name else prefix ++ "/" ++ name
+    isDirectory <- doesDirectoryExist path
+    if isDirectory
+      then getRecursiveContents loc path
+      else return [(loc, path)]
+  return (concat paths)
+
+-- | Embed all files in a directory into the static subsite.
+-- 
+-- Equivalent to passing the empty string as the location to 'embedDirAt',
+-- so the directory path itself is not part of the resource locations (and so
+-- also not part of the generated route variable names).
+embedDir :: FilePath -> Generator
+embedDir = embedDirAt ""
+
+-- | Embed all files in a directory to a given location within the static subsite.
+--
+-- The directory tree rooted at the 'FilePath' (which must be relative to the directory in
+-- which you run @cabal build@) is embedded into the static subsite at the given
+-- location.  Also, route variables will be created based on the final location
+-- of each file.  For example, if a directory \"static\" contains the files
+--
+-- * css/bootstrap.css
+--
+-- * js/jquery.js
+--
+-- * js/bootstrap.js
+-- 
+-- then @embedDirAt \"somefolder\" \"static\"@ will
+--
+-- * Make the file @static\/css\/bootstrap.css@ available at the location
+--   @somefolder\/css\/bootstrap.css@ within the static subsite and similarly
+--   for the other two files.
+--
+-- * Create variables @somefolder_css_bootstrap_css@, @somefolder_js_jquery_js@,
+--   @somefolder_js_bootstrap_js@ all of type @Route EmbeddedStatic@.
+--
+-- * During development, the files will be reloaded on every request.  During
+--   production, the contents of all files will be embedded into the executable.
+--
+-- * During development, files that are added to the directory while the server
+--   is running will not be detected.  You need to recompile the module which
+--   contains the call to @mkEmbeddedStatic@.  This will also generate new route
+--   variables for the new files.
+embedDirAt :: Location -> FilePath -> Generator
+embedDirAt loc dir = do
+    files <- runIO $ getRecursiveContents loc dir
+    concat <$> mapM (uncurry embedFileAt) files
+
+-- | Concatinate a list of files and embed it at the location.  Equivalent to passing @return@ to
+--   'concatFilesWith'.
+concatFiles :: Location -> [FilePath] -> Generator
+concatFiles loc files = concatFilesWith loc return files
+
+-- | Concatinate a list of files into a single 'BL.ByteString', run the resulting content through the given
+--   function, embed it at the given location, and create a haskell variable name for the route based on
+--   the location.
+--
+--   The processing function is only run when compiling for production, and the processing function is
+--   executed at compile time.  During development, on every request the files listed are reloaded,
+--   concatenated, and served as a single resource at the given location without being processed.
+concatFilesWith :: Location -> (BL.ByteString -> IO BL.ByteString) -> [FilePath] -> Generator
+concatFilesWith loc process files = do
+    let load = do putStrLn $ "Creating " ++ loc
+                  BL.concat <$> mapM BL.readFile files >>= process
+        expFiles = listE $ map (litE . stringL) files
+        expCt = [| BL.concat <$> mapM BL.readFile $expFiles |]
+        mime = defaultMimeLookup $ T.pack loc
+    return [Entry (Just $ pathToName loc) loc mime load expCt Nothing]
+
+-- | Convienient rexport of 'minifym' with a type signature to work with 'concatFilesWith'.
+jasmine :: BL.ByteString -> IO BL.ByteString
+jasmine ct = return $ either (const ct) id $ minifym ct
+
+-- | Use <https://github.com/mishoo/UglifyJS2 UglifyJS2> to compress javascript.
+-- Assumes @uglifyjs@ is located in the path and uses options @[\"-m\", \"-c\"]@
+-- to both mangle and compress and the option \"-\" to cause uglifyjs to read from
+-- standard input.
+uglifyJs :: BL.ByteString -> IO BL.ByteString
+uglifyJs = compressTool "uglifyjs" ["-m", "-c", "-"]
+
+-- | Use <http://yui.github.io/yuicompressor/ YUI Compressor> to compress javascript.
+-- Assumes a script @yuicompressor@ is located in the path.  If not, you can still
+-- use something like
+--
+-- > compressTool "java" ["-jar", "/path/to/yuicompressor.jar", "--type", "js"]
+yuiJavascript :: BL.ByteString -> IO BL.ByteString
+yuiJavascript = compressTool "yuicompressor" ["--type", "js"]
+
+-- | Use <http://yui.github.io/yuicompressor/ YUI Compressor> to compress CSS.
+-- Assumes a script @yuicompressor@ is located in the path.
+yuiCSS :: BL.ByteString -> IO BL.ByteString
+yuiCSS = compressTool "yuicompressor" ["--type", "css"]
+
+-- | Use <https://developers.google.com/closure/compiler/ Closure> to compress
+-- javascript using the default options.  Assumes a script @closure@ is located in
+-- the path. If not, you can still run using
+--
+-- > compressTool "java" ["-jar", "/path/to/compiler.jar"]
+closureJs :: BL.ByteString -> IO BL.ByteString
+closureJs = compressTool "closure" []
+
+-- | Helper to convert a process into a compression function.  The process
+-- should be set up to take input from standard input and write to standard output.
+compressTool :: FilePath -- ^ program
+             -> [String] -- ^ options
+             -> BL.ByteString -> IO BL.ByteString
+compressTool f opts ct = do
+    let src = C.sourceList $ BL.toChunks ct
+        p = proc f opts
+        sink = C.consume
+    compressed <- runResourceT (src $$ conduitProcess p =$ sink)
+    return $ BL.fromChunks compressed
+
+
+-- | Try a list of processing functions (like the compressions above) one by one until
+-- one succeeds (does not raise an exception).  Once a processing function succeeds,
+-- none of the remaining functions are used.  If none succeeds, the input is just
+-- returned unprocessed.  This is helpful if you are distributing
+-- code on hackage and do not know what compressors the user will have installed.  You
+-- can list several and they will be tried in order until one succeeds.
+tryCompressTools :: [BL.ByteString -> IO BL.ByteString] -> BL.ByteString -> IO BL.ByteString
+tryCompressTools [] x = return x
+tryCompressTools (p:ps) x = do
+    mres <- try $ p x
+    case mres of
+        Left (err :: SomeException) -> do
+            putStrLn $ show err
+            tryCompressTools ps x
+        Right res -> return res
+
 -- | Clean up a path to make it a valid haskell name by replacing all non-letters
 --   and non-numbers by underscores.  In addition, if the path starts with a capital
 --   letter or number add an initial underscore.

yesod-static/test/FileGeneratorTests.hs

@@ -0,0 +1,92 @@
+{-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-}
+module FileGeneratorTests (fileGenSpecs) where
+
+import Control.Exception
+import Control.Monad (forM_)
+import GeneratorTestUtil
+import Test.Hspec
+import Test.HUnit (assertFailure, assertEqual)
+import Yesod.EmbeddedStatic.Generators
+import qualified Data.ByteString.Lazy as BL
+
+-- | Embeds the LICENSE file
+license :: GenTestResult
+license = $(embedFile "LICENSE" >>= 
+            testOneEntry (Just "_LICENSE") "LICENSE" (BL.readFile "LICENSE")
+           )
+
+licenseAt :: GenTestResult
+licenseAt = $(embedFileAt "abc.txt" "LICENSE" >>=
+              testOneEntry (Just "abc_txt") "abc.txt" (BL.readFile "LICENSE")
+             )
+
+embDir :: [GenTestResult]
+embDir = $(embedDir "test/embed-dir" >>=
+           testEntries 
+            [ (Just "abc_def_txt", "abc/def.txt", BL.readFile "test/embed-dir/abc/def.txt")
+            , (Just "lorem_txt", "lorem.txt", BL.readFile "test/embed-dir/lorem.txt")
+            , (Just "foo", "foo", BL.readFile "test/embed-dir/foo")
+            ]
+          )
+
+embDirAt :: [GenTestResult]
+embDirAt = $(embedDirAt "xxx" "test/embed-dir" >>=
+           testEntries 
+            [ (Just "xxx_abc_def_txt", "xxx/abc/def.txt", BL.readFile "test/embed-dir/abc/def.txt")
+            , (Just "xxx_lorem_txt", "xxx/lorem.txt", BL.readFile "test/embed-dir/lorem.txt")
+            , (Just "xxx_foo", "xxx/foo", BL.readFile "test/embed-dir/foo")
+            ]
+          )
+
+concatR :: GenTestResult
+concatR = $(concatFiles "out.txt" [ "test/embed-dir/abc/def.txt", "test/embed-dir/foo"] >>=
+            testOneEntry (Just "out_txt") "out.txt" (return "Yesod Rocks\nBar\n")
+           )
+
+-- The transform function should only run at compile for the production content
+concatWithR :: GenTestResult
+concatWithR = $(concatFilesWith "out2.txt"
+                                (\x -> return $ x `BL.append` "Extra")
+                                [ "test/embed-dir/abc/def.txt", "test/embed-dir/foo"] >>=
+                testOneEntry (Just "out2_txt") "out2.txt" (return "Yesod Rocks\nBar\nExtra")
+               )
+            
+fileGenSpecs :: Spec
+fileGenSpecs = do
+    describe "Embed File" $ do
+        it "embeds a single file" $
+            assertGenResult (BL.readFile "LICENSE") license
+        it "embeds a single file at a location" $
+            assertGenResult (BL.readFile "LICENSE") licenseAt
+
+    describe "Embed Directory" $ do
+        it "embeds a directory" $
+            forM_ [embDir, embDirAt] $ \d -> case d of
+                [GenError e] -> assertFailure e
+                [def, foo, lorem] -> do
+                    assertGenResult (BL.readFile "test/embed-dir/abc/def.txt") def
+                    assertGenResult (BL.readFile "test/embed-dir/foo") foo
+                    assertGenResult (BL.readFile "test/embed-dir/lorem.txt") lorem
+                _ -> assertFailure "Bad directory list"
+
+    describe "Concat Files" $ do
+        it "simple concat" $
+            assertGenResult (return "Yesod Rocks\nBar\n") concatR
+        it "concat with processing function" $
+            assertGenResult (return "Yesod Rocks\nBar\n") concatWithR -- no Extra since this is development
+
+    describe "Compress" $ do
+        it "compress tool function" $ do
+            out <- compressTool "runhaskell" [] "main = putStrLn \"Hello World\""
+            assertEqual "" "Hello World\n" out
+
+        it "tryCompressTools" $ do
+            out <- flip tryCompressTools "abcdef" 
+                            [ const $ throwIO $ ErrorCall "An expected error"
+                            , const $ return "foo"
+                            , const $ return "bar"
+                            ]
+            assertEqual "" "foo" out
+            out2 <- flip tryCompressTools "abcdef"
+                            [ const $ throwIO $ ErrorCall "An expected error"]
+            assertEqual "" "abcdef" out2

yesod-static/test/GeneratorTestUtil.hs

@@ -0,0 +1,59 @@
+{-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-}
+module GeneratorTestUtil where
+
+import Control.Applicative
+import Control.Monad (when)
+import Data.List (sortBy)
+import Language.Haskell.TH
+import Test.HUnit
+import Yesod.EmbeddedStatic.Types
+import qualified Data.ByteString.Lazy as BL
+
+-- We test the generators by executing them at compile time
+-- and sticking the result into the GenTestResult.  We then
+-- test the GenTestResult at runtime.  But to test the ebDevelReload
+-- we must run the action at runtime so that is also embedded.
+-- Because of template haskell stage restrictions, this code
+-- needs to be in a separate module.
+
+data GenTestResult = GenError String
+                   | GenSuccessWithDevel (IO BL.ByteString)
+
+-- | Creates a GenTestResult at compile time by testing the entry.
+testEntry :: Maybe String -> Location -> IO BL.ByteString -> Entry -> ExpQ
+testEntry name _ _ e | ebHaskellName e /= (mkName <$> name) =
+    [| GenError ("haskell name " ++ $(litE $ stringL $ show $ ebHaskellName e)
+                                 ++ " /= "
+                                 ++ $(litE $ stringL $ show name)) |]
+testEntry _ loc _ e  | ebLocation e /= loc =
+    [| GenError ("location " ++ $(litE $ stringL $ show $ ebLocation e)) |]
+testEntry _ _ act e = do
+    expected <- runIO act
+    actual <- runIO $ ebProductionContent e
+    if expected == actual
+        then [| GenSuccessWithDevel $(ebDevelReload e) |]
+        else [| GenError "production content" |]
+
+testOneEntry :: Maybe String -> Location -> IO BL.ByteString -> [Entry] -> ExpQ
+testOneEntry name loc ct [e] = testEntry name loc ct e
+testOneEntry _ _ _ _ = [| GenError "not exactly one entry" |]
+
+-- | Tests a list of entries 
+testEntries :: [(Maybe String, Location, IO BL.ByteString)] -> [Entry] -> ExpQ
+testEntries a b | length a /= length b = [| [GenError "lengths differ"] |]
+testEntries a b = listE $ zipWith f a' b'
+    where 
+        a' = sortBy (\(_,l1,_) (_,l2,_) -> compare l1 l2) a
+        b' = sortBy (\e1 e2 -> ebLocation e1 `compare` ebLocation e2) b
+        f (name, loc, ct) e = testEntry name loc ct e
+
+-- | Use this at runtime to assert the 'GenTestResult' is OK
+assertGenResult :: (IO BL.ByteString) -- ^ expected development content
+                -> GenTestResult -- ^ test result created at compile time
+                -> Assertion
+assertGenResult _ (GenError e) = assertFailure ("invalid " ++ e)
+assertGenResult mexpected (GenSuccessWithDevel mactual) = do
+    expected <- mexpected
+    actual <- mactual
+    when (expected /= actual) $
+        assertFailure "invalid devel content"

yesod-static/test/embed-dir/abc/def.txt

@@ -0,0 +1 @@
+Yesod Rocks

yesod-static/test/embed-dir/foo

@@ -0,0 +1 @@
+Bar

yesod-static/test/embed-dir/lorem.txt

@@ -0,0 +1,6 @@
+Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eiusmod tempor
+incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis
+nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat.
+Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu
+fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in
+culpa qui officia deserunt mollit anim id est laborum.

yesod-static/test/tests.hs

@@ -4,9 +4,11 @@ import Test.Hspec
 import YesodStaticTest (specs)
 import EmbedProductionTest (embedProductionSpecs)
 import EmbedDevelTest (embedDevSpecs)
+import FileGeneratorTests (fileGenSpecs)
 
 main :: IO ()
 main = hspec $ do
     specs
     embedProductionSpecs
     embedDevSpecs
+    fileGenSpecs

yesod-static/yesod-static.cabal

@@ -17,6 +17,9 @@ extra-source-files:
   test/fs/tmp/ignored
   test/fs/.ignored
   test/fs/foo
+  test/embed-dir/foo
+  test/embed-dir/lorem.txt
+  test/embed-dir/abc/def.txt
 
 library
     build-depends:   base                  >= 4        && < 5
@@ -43,6 +46,10 @@ library
                    , data-default
                    , shakespeare-css       >= 1.0.3
                    , mime-types            >= 0.1
+                   , hjsmin
+                   , process-conduit       >= 1.0      && < 1.1
+                   , filepath              >= 1.3
+                   , resourcet             >= 0.4
 
     exposed-modules: Yesod.Static
                      Yesod.EmbeddedStatic
@@ -88,6 +95,10 @@ test-suite tests
                    , data-default
                    , shakespeare-css
                    , mime-types
+                   , hjsmin
+                   , process-conduit
+                   , filepath
+                   , resourcet
 
     ghc-options:     -Wall