{-# LANGUAGE TemplateHaskell, QuasiQuotes, ScopedTypeVariables #-}
-- | A generator is executed at compile time to load a list of entries
-- to embed into the subsite.  This module contains several basic generators,
-- but the design of generators and entries is such that it is straightforward
-- to make custom generators for your own specific purposes, see <#g:4 this section>.
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

  -- * Custom Generators

  -- $example
) where

import Control.Applicative as A ((<$>), (<*>))
import Control.Exception (try, SomeException)
import Control.Monad (forM, when)
import Data.Char (isDigit, isLower)
import Data.Default (def)
import Data.Maybe (isNothing)
import Language.Haskell.TH
import Network.Mime (defaultMimeLookup)
import System.Directory (doesDirectoryExist, getDirectoryContents, findExecutable)
import System.FilePath ((</>))
import Text.Jasmine (minifym)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL
import Conduit
import qualified Data.Text as T
import qualified System.Process as Proc
import System.Exit (ExitCode (ExitSuccess))
import Control.Concurrent.Async (Concurrently (..))
import System.IO (hClose)
import Data.List (sort)

import Yesod.EmbeddedStatic.Types

-- | Embed a single file.  Equivalent to passing the same string twice to 'embedFileAt'.
embedFile :: FilePath -> Generator
embedFile :: FilePath -> Generator
embedFile f :: FilePath
f = FilePath -> FilePath -> Generator
embedFileAt FilePath
f FilePath
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 :: FilePath -> FilePath -> Generator
embedFileAt loc :: FilePath
loc f :: FilePath
f = do
    let mime :: MimeType
mime = FileName -> MimeType
defaultMimeLookup (FileName -> MimeType) -> FileName -> MimeType
forall a b. (a -> b) -> a -> b
$ FilePath -> FileName
T.pack FilePath
f
    let entry :: Entry
entry = Entry
forall a. Default a => a
def {
                    ebHaskellName :: Maybe Name
ebHaskellName = Name -> Maybe Name
forall a. a -> Maybe a
Just (Name -> Maybe Name) -> Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ FilePath -> Name
pathToName FilePath
loc
                  , ebLocation :: FilePath
ebLocation = FilePath
loc
                  , ebMimeType :: MimeType
ebMimeType = MimeType
mime
                  , ebProductionContent :: IO ByteString
ebProductionContent = (MimeType -> ByteString) -> IO MimeType -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MimeType -> ByteString
BL.fromStrict (FilePath -> IO MimeType
BS.readFile FilePath
f)
                  , ebDevelReload :: ExpQ
ebDevelReload = [| fmap BL.fromStrict
                                       (BS.readFile $(litE $ stringL f)) |]
                  }
    [Entry] -> Generator
forall (m :: * -> *) a. Monad m => a -> m a
return [Entry
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 :: FilePath -> FilePath -> IO [(FilePath, FilePath)]
getRecursiveContents prefix :: FilePath
prefix topdir :: FilePath
topdir = do
  [FilePath]
names <- [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
getDirectoryContents FilePath
topdir
  let properNames :: [FilePath]
properNames = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [".", ".."]) [FilePath]
names
  [[(FilePath, FilePath)]]
paths <- [FilePath]
-> (FilePath -> IO [(FilePath, FilePath)])
-> IO [[(FilePath, FilePath)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
properNames ((FilePath -> IO [(FilePath, FilePath)])
 -> IO [[(FilePath, FilePath)]])
-> (FilePath -> IO [(FilePath, FilePath)])
-> IO [[(FilePath, FilePath)]]
forall a b. (a -> b) -> a -> b
$ \name :: FilePath
name -> do
    let path :: FilePath
path = FilePath
topdir FilePath -> FilePath -> FilePath
</> FilePath
name
    let loc :: FilePath
loc = if FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
prefix then FilePath
name else FilePath
prefix FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "/" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
name
    Bool
isDirectory <- FilePath -> IO Bool
doesDirectoryExist FilePath
path
    if Bool
isDirectory
      then FilePath -> FilePath -> IO [(FilePath, FilePath)]
getRecursiveContents FilePath
loc FilePath
path
      else [(FilePath, FilePath)] -> IO [(FilePath, FilePath)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(FilePath
loc, FilePath
path)]
  [(FilePath, FilePath)] -> IO [(FilePath, FilePath)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[(FilePath, FilePath)]] -> [(FilePath, FilePath)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(FilePath, FilePath)]]
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 :: FilePath -> Generator
embedDir = FilePath -> FilePath -> Generator
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 :: FilePath -> FilePath -> Generator
embedDirAt loc :: FilePath
loc dir :: FilePath
dir = do
    [(FilePath, FilePath)]
files <- IO [(FilePath, FilePath)] -> Q [(FilePath, FilePath)]
forall a. IO a -> Q a
runIO (IO [(FilePath, FilePath)] -> Q [(FilePath, FilePath)])
-> IO [(FilePath, FilePath)] -> Q [(FilePath, FilePath)]
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO [(FilePath, FilePath)]
getRecursiveContents FilePath
loc FilePath
dir
    [[Entry]] -> [Entry]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Entry]] -> [Entry]) -> Q [[Entry]] -> Generator
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((FilePath, FilePath) -> Generator)
-> [(FilePath, FilePath)] -> Q [[Entry]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((FilePath -> FilePath -> Generator)
-> (FilePath, FilePath) -> Generator
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry FilePath -> FilePath -> Generator
embedFileAt) [(FilePath, FilePath)]
files

-- | Concatinate a list of files and embed it at the location.  Equivalent to passing @return@ to
--   'concatFilesWith'.
concatFiles :: Location -> [FilePath] -> Generator
concatFiles :: FilePath -> [FilePath] -> Generator
concatFiles loc :: FilePath
loc files :: [FilePath]
files = FilePath
-> (ByteString -> IO ByteString) -> [FilePath] -> Generator
concatFilesWith FilePath
loc ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath]
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 :: FilePath
-> (ByteString -> IO ByteString) -> [FilePath] -> Generator
concatFilesWith loc :: FilePath
loc process :: ByteString -> IO ByteString
process files :: [FilePath]
files = do
    let load :: IO ByteString
load = do FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "Creating " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
loc
                  [ByteString] -> ByteString
BL.concat ([ByteString] -> ByteString) -> IO [ByteString] -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> IO ByteString) -> [FilePath] -> IO [ByteString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO ByteString
BL.readFile [FilePath]
files IO ByteString -> (ByteString -> IO ByteString) -> IO ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> IO ByteString
process
        expFiles :: ExpQ
expFiles = [ExpQ] -> ExpQ
listE ([ExpQ] -> ExpQ) -> [ExpQ] -> ExpQ
forall a b. (a -> b) -> a -> b
$ (FilePath -> ExpQ) -> [FilePath] -> [ExpQ]
forall a b. (a -> b) -> [a] -> [b]
map (Lit -> ExpQ
litE (Lit -> ExpQ) -> (FilePath -> Lit) -> FilePath -> ExpQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Lit
stringL) [FilePath]
files
        expCt :: ExpQ
expCt = [| BL.concat <$> mapM BL.readFile $expFiles |]
        mime :: MimeType
mime = FileName -> MimeType
defaultMimeLookup (FileName -> MimeType) -> FileName -> MimeType
forall a b. (a -> b) -> a -> b
$ FilePath -> FileName
T.pack FilePath
loc
    [Entry] -> Generator
forall (m :: * -> *) a. Monad m => a -> m a
return [Entry
forall a. Default a => a
def { ebHaskellName :: Maybe Name
ebHaskellName = Name -> Maybe Name
forall a. a -> Maybe a
Just (Name -> Maybe Name) -> Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ FilePath -> Name
pathToName FilePath
loc
                , ebLocation :: FilePath
ebLocation = FilePath
loc
                , ebMimeType :: MimeType
ebMimeType = MimeType
mime
                , ebProductionContent :: IO ByteString
ebProductionContent = IO ByteString
load
                , ebDevelReload :: ExpQ
ebDevelReload = ExpQ
expCt
                }]

-- | Convienient rexport of 'minifym' with a type signature to work with 'concatFilesWith'.
jasmine :: BL.ByteString -> IO BL.ByteString
jasmine :: ByteString -> IO ByteString
jasmine ct :: ByteString
ct = ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ (FilePath -> ByteString)
-> (ByteString -> ByteString)
-> Either FilePath ByteString
-> ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ByteString -> FilePath -> ByteString
forall a b. a -> b -> a
const ByteString
ct) ByteString -> ByteString
forall a. a -> a
id (Either FilePath ByteString -> ByteString)
-> Either FilePath ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Either FilePath ByteString
minifym ByteString
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 :: ByteString -> IO ByteString
uglifyJs = FilePath -> [FilePath] -> ByteString -> IO ByteString
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 :: ByteString -> IO ByteString
yuiJavascript = FilePath -> [FilePath] -> ByteString -> IO ByteString
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 :: ByteString -> IO ByteString
yuiCSS = FilePath -> [FilePath] -> ByteString -> IO ByteString
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 :: ByteString -> IO ByteString
closureJs = FilePath -> [FilePath] -> ByteString -> IO ByteString
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 :: FilePath -> [FilePath] -> ByteString -> IO ByteString
compressTool f :: FilePath
f opts :: [FilePath]
opts ct :: ByteString
ct = do
    Maybe FilePath
mpath <- FilePath -> IO (Maybe FilePath)
findExecutable FilePath
f
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isNothing Maybe FilePath
mpath) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        FilePath -> IO ()
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "Unable to find " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
f
    let p :: CreateProcess
p = (FilePath -> [FilePath] -> CreateProcess
Proc.proc FilePath
f [FilePath]
opts)
                { std_in :: StdStream
Proc.std_in = StdStream
Proc.CreatePipe
                , std_out :: StdStream
Proc.std_out = StdStream
Proc.CreatePipe
                }
    (Just hin :: Handle
hin, Just hout :: Handle
hout, _, ph :: ProcessHandle
ph) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
Proc.createProcess CreateProcess
p
    (compressed :: ByteString
compressed, (), code :: ExitCode
code) <- Concurrently (ByteString, (), ExitCode)
-> IO (ByteString, (), ExitCode)
forall a. Concurrently a -> IO a
runConcurrently (Concurrently (ByteString, (), ExitCode)
 -> IO (ByteString, (), ExitCode))
-> Concurrently (ByteString, (), ExitCode)
-> IO (ByteString, (), ExitCode)
forall a b. (a -> b) -> a -> b
$ (,,)
        (ByteString -> () -> ExitCode -> (ByteString, (), ExitCode))
-> Concurrently ByteString
-> Concurrently (() -> ExitCode -> (ByteString, (), ExitCode))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
A.<$> IO ByteString -> Concurrently ByteString
forall a. IO a -> Concurrently a
Concurrently (ConduitT () Void IO ByteString -> IO ByteString
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void IO ByteString -> IO ByteString)
-> ConduitT () Void IO ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Handle -> ConduitT () MimeType IO ()
forall (m :: * -> *) i.
MonadIO m =>
Handle -> ConduitT i MimeType m ()
sourceHandle Handle
hout ConduitT () MimeType IO ()
-> ConduitM MimeType Void IO ByteString
-> ConduitT () Void IO ByteString
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM MimeType Void IO ByteString
forall (m :: * -> *) lazy strict o.
(Monad m, LazySequence lazy strict) =>
ConduitT strict o m lazy
sinkLazy)
        Concurrently (() -> ExitCode -> (ByteString, (), ExitCode))
-> Concurrently ()
-> Concurrently (ExitCode -> (ByteString, (), ExitCode))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
A.<*> IO () -> Concurrently ()
forall a. IO a -> Concurrently a
Concurrently (Handle -> ByteString -> IO ()
BL.hPut Handle
hin ByteString
ct IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hClose Handle
hin)
        Concurrently (ExitCode -> (ByteString, (), ExitCode))
-> Concurrently ExitCode -> Concurrently (ByteString, (), ExitCode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
A.<*> IO ExitCode -> Concurrently ExitCode
forall a. IO a -> Concurrently a
Concurrently (ProcessHandle -> IO ExitCode
Proc.waitForProcess ProcessHandle
ph)
    if ExitCode
code ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
        then do
            FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "Compressed successfully with " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
f
            ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
compressed
        else FilePath -> IO ByteString
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO ByteString) -> FilePath -> IO ByteString
forall a b. (a -> b) -> a -> b
$ "compressTool: compression failed with " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
f


-- | 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 :: [ByteString -> IO ByteString] -> ByteString -> IO ByteString
tryCompressTools [] x :: ByteString
x = ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
x
tryCompressTools (p :: ByteString -> IO ByteString
p:ps :: [ByteString -> IO ByteString]
ps) x :: ByteString
x = do
    Either SomeException ByteString
mres <- IO ByteString -> IO (Either SomeException ByteString)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO ByteString -> IO (Either SomeException ByteString))
-> IO ByteString -> IO (Either SomeException ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ByteString
p ByteString
x
    case Either SomeException ByteString
mres of
        Left (SomeException
err :: SomeException) -> do
            FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ SomeException -> FilePath
forall a. Show a => a -> FilePath
show SomeException
err
            [ByteString -> IO ByteString] -> ByteString -> IO ByteString
tryCompressTools [ByteString -> IO ByteString]
ps ByteString
x
        Right res :: ByteString
res -> ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
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.
pathToName :: FilePath -> Name
pathToName :: FilePath -> Name
pathToName f :: FilePath
f = Name
routeName
    where
      replace :: Char -> Char
replace c :: Char
c
        | 'A' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= 'Z' = Char
c
        | 'a' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= 'z' = Char
c
        | '0' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '9' = Char
c
        | Bool
otherwise = '_'
      name :: FilePath
name = (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
replace FilePath
f
      routeName :: Name
routeName = FilePath -> Name
mkName (FilePath -> Name) -> FilePath -> Name
forall a b. (a -> b) -> a -> b
$
            case () of
                ()
                    | FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
name -> FilePath -> FilePath
forall a. HasCallStack => FilePath -> a
error "null-named file"
                    | Char -> Bool
isDigit (FilePath -> Char
forall a. [a] -> a
head FilePath
name) -> '_' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
name
                    | Char -> Bool
isLower (FilePath -> Char
forall a. [a] -> a
head FilePath
name) -> FilePath
name
                    | Bool
otherwise -> '_' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
name


-- $example
-- Here is an example of creating your own custom generator.
-- Because of template haskell stage restrictions, you must define generators in a
-- different module from where you use them.  The following generator will embed a
-- JSON document that contains the compile time.
--
-- >{-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-}
-- >module CompileTime where
-- >
-- >import Data.Aeson
-- >import Data.Default
-- >import Data.Time
-- >import Yesod.EmbeddedStatic.Generators
-- >import Yesod.EmbeddedStatic.Types
-- >import qualified Data.ByteString.Lazy as BL
-- >
-- >getTime :: IO BL.ByteString
-- >getTime = do
-- >    t <- getCurrentTime
-- >    return $ encode $
-- >        object [ "compile_time" .= show t ]
-- >
-- >timeGenerator :: Location -> Generator
-- >timeGenerator loc =
-- >    return $ [def
-- >        { ebHaskellName = Just $ pathToName loc
-- >        , ebLocation    = loc
-- >        , ebMimeType    = "application/json"
-- >        , ebProductionContent = getTime
-- >        , ebDevelReload = [| getTime |]
-- >        }]
--
-- Notice how the @getTime@ action is given as both 'ebProductionContent' and
-- 'ebDevelReload'.  The result is that during development, the @getTime@ action
-- will be re-executed on every request so the time returned will be different
-- for each reload.  When compiling for production, the @getTime@ action will
-- be executed once at compile time to produce the content to embed and never
-- called at runtime.
--
-- Here is a small example yesod program using this generator.  Try toggling
-- the development argument to @mkEmbeddedStatic@.
-- 
-- >{-# LANGUAGE TemplateHaskell, QuasiQuotes, TypeFamilies #-}
-- >module Main where
-- >
-- >import Yesod
-- >import Yesod.EmbeddedStatic
-- >import CompileTime (timeGenerator)
-- >
-- >mkEmbeddedStatic True "eStatic" [timeGenerator "compile-time.json"]
-- >
-- >-- The above will generate variables
-- >-- eStatic :: EmbeddedStatic
-- >-- compile_time_json :: Route EmbeddedStatic
-- >
-- >data MyApp = MyApp { getStatic :: EmbeddedStatic }
-- >
-- >mkYesod "MyApp" [parseRoutes|
-- >/ HomeR GET
-- >/static StaticR EmbeddedStatic getStatic
-- >|]
-- >
-- >instance Yesod MyApp
-- >
-- >getHomeR :: Handler Html
-- >getHomeR = defaultLayout $ [whamlet|
-- ><h1>Hello
-- ><p>Check the 
-- >    <a href=@{StaticR compile_time_json}>compile time
-- >|]
-- >
-- >main :: IO ()
-- >main = warp 3000 $ MyApp eStatic