diff --git a/yesod-static/Yesod/EmbeddedStatic/Generators.hs b/yesod-static/Yesod/EmbeddedStatic/Generators.hs index c6388865..94e6e03c 100644 --- a/yesod-static/Yesod/EmbeddedStatic/Generators.hs +++ b/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 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 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 to compress CSS. +-- Assumes a script @yuicompressor@ is located in the path. +yuiCSS :: BL.ByteString -> IO BL.ByteString +yuiCSS = compressTool "yuicompressor" ["--type", "css"] + +-- | Use 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. diff --git a/yesod-static/test/FileGeneratorTests.hs b/yesod-static/test/FileGeneratorTests.hs new file mode 100644 index 00000000..d1bffa34 --- /dev/null +++ b/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 diff --git a/yesod-static/test/GeneratorTestUtil.hs b/yesod-static/test/GeneratorTestUtil.hs new file mode 100644 index 00000000..87f744ad --- /dev/null +++ b/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" diff --git a/yesod-static/test/embed-dir/abc/def.txt b/yesod-static/test/embed-dir/abc/def.txt new file mode 100644 index 00000000..89f4668d --- /dev/null +++ b/yesod-static/test/embed-dir/abc/def.txt @@ -0,0 +1 @@ +Yesod Rocks diff --git a/yesod-static/test/embed-dir/foo b/yesod-static/test/embed-dir/foo new file mode 100644 index 00000000..ebd7525b --- /dev/null +++ b/yesod-static/test/embed-dir/foo @@ -0,0 +1 @@ +Bar diff --git a/yesod-static/test/embed-dir/lorem.txt b/yesod-static/test/embed-dir/lorem.txt new file mode 100644 index 00000000..1bb51996 --- /dev/null +++ b/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. diff --git a/yesod-static/test/tests.hs b/yesod-static/test/tests.hs index e9a8625f..11a124c6 100644 --- a/yesod-static/test/tests.hs +++ b/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 diff --git a/yesod-static/yesod-static.cabal b/yesod-static/yesod-static.cabal index e555d7d4..7e0d0ede 100644 --- a/yesod-static/yesod-static.cabal +++ b/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