    {-# LANGUAGE QuasiQuotes #-}
    {-# LANGUAGE TemplateHaskell #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE CPP #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE RecordWildCards #-}
    {-# LANGUAGE FlexibleContexts #-}
    ---------------------------------------------------------
    --
    -- | Serve static files from a Yesod app.
    --
    -- This is great for developing your application, but also for a
    -- dead-simple deployment.  Caching headers are automatically
    -- taken care of.
    --
    -- If you are running a proxy server (like Apache or Nginx),
    -- you may want to have that server do the static serving instead.
    --
    -- In fact, in an ideal setup you'll serve your static files from
    -- a separate domain name to save time on transmitting
    -- cookies. In that case, you may wish to use 'urlParamRenderOverride'
    -- to redirect requests to this subsite to a separate domain
    -- name.
    --
    -- Note that this module's static subsite ignores all files and
    -- directories that are hidden by Unix conventions (i.e. start
    -- with a dot, such as @\".ssh\"@) and the directory "tmp" on the
    -- root of the directory with static files.
    module Yesod.Static
        ( -- * Subsite
          Static (..)
        , Route (..)
        , StaticRoute
          -- * Smart constructor
        , static
        , staticDevel
          -- * Combining CSS/JS
          -- $combining
        , combineStylesheets'
        , combineScripts'
          -- ** Settings
        , CombineSettings
        , csStaticDir
        , csCssPostProcess
        , csJsPostProcess
        , csCssPreProcess
        , csJsPreProcess
        , csCombinedFolder
          -- * Template Haskell helpers
        , staticFiles
        , staticFilesList
        , staticFilesMap
        , staticFilesMergeMap
        , publicFiles
          -- * Hashing
        , base64md5
          -- * Embed
        , embed
    #ifdef TEST_EXPORT
        , getFileListPieces
    #endif
        ) where

    import System.Directory
    import qualified System.FilePath as FP
    import Control.Monad
    import Data.FileEmbed (embedDir)

    import Yesod.Core
    import Yesod.Core.Types

    import Data.List (intercalate, sort)
    import Language.Haskell.TH
    import Language.Haskell.TH.Syntax as TH

    import Crypto.Hash.Conduit (hashFile, sinkHash)
    import Crypto.Hash (MD5, Digest)
    import Control.Monad.Trans.State

    import qualified Data.ByteArray as ByteArray
    import qualified Data.ByteString.Base64
    import qualified Data.ByteString.Char8 as S8
    import qualified Data.ByteString.Lazy as L
    import Data.Text (Text, pack)
    import qualified Data.Text as T
    import qualified Data.Map as M
    import Data.IORef (readIORef, newIORef, writeIORef)
    import Data.Char (isLower, isDigit)
    import Data.List (foldl')
    import qualified Data.ByteString as S
    import System.PosixCompat.Files (getFileStatus, modificationTime)
    import System.Posix.Types (EpochTime)
    import Conduit
    import System.FilePath ((</>), (<.>), takeDirectory)
    import qualified System.FilePath as F
    import qualified Data.Text.Lazy as TL
    import qualified Data.Text.Lazy.Encoding as TLE
    import Data.Default
    --import Text.Lucius (luciusRTMinified)

    import Network.Wai (pathInfo)
    import Network.Wai.Application.Static
        ( StaticSettings (..)
        , staticApp
        , webAppSettingsWithLookup
        , embeddedSettings
        )
    import WaiAppStatic.Storage.Filesystem (ETagLookup)

    -- | Type used for the subsite with static contents.
    newtype Static = Static StaticSettings

    type StaticRoute = Route Static

    -- | Produce a default value of 'Static' for a given file
    -- folder.
    --
    -- Does not have index files or directory listings.  The static
    -- files' contents /must not/ change, however new files can be
    -- added.
    static :: FilePath -> IO Static
    static :: String -> IO Static
    static String
    dir = do
        hashLookup <- String -> IO ETagLookup
    cachedETagLookup String
    dir
        return $ Static $ webAppSettingsWithLookup dir hashLookup

    -- | Same as 'static', but does not assumes that the files do not
    -- change and checks their modification time whenever a request
    -- is made.
    staticDevel :: FilePath -> IO Static
    staticDevel :: String -> IO Static
    staticDevel String
    dir = do
        hashLookup <- String -> IO ETagLookup
    cachedETagLookupDevel String
    dir
        return $ Static $ webAppSettingsWithLookup dir hashLookup

    -- | Produce a 'Static' based on embedding all of the static files' contents in the
    -- executable at compile time.
    --
    -- You should use "Yesod.EmbeddedStatic" instead, it is much more powerful.
    --
    -- Nota Bene: if you replace the scaffolded 'static' call in Settings/StaticFiles.hs
    -- you will need to change the scaffolded addStaticContent.  Otherwise, some of your
    -- assets will be 404'ed.  This is because by default yesod will generate compile those
    -- assets to @static/tmp@ which for 'static' is fine since they are served out of the
    -- directory itself.  With embedded static, that will not work.
    -- You can easily change @addStaticContent@ to @\_ _ _ -> return Nothing@ as a workaround.
    -- This will cause yesod to embed those assets into the generated HTML file itself.
    embed :: FilePath -> Q Exp
    embed :: String -> Q Exp
    embed String
    fp = [|Static (embeddedSettings $(String -> Q Exp
    embedDir String
    fp))|]

    instance RenderRoute Static where
        -- | A route on the static subsite (see also 'staticFiles').
        --
        -- You may use this constructor directly to manually link to a
        -- static file.  The first argument is the sub-path to the file
        -- being served whereas the second argument is the key-value
        -- pairs in the query string.  For example,
        --
        -- > StaticRoute $ StaticR [\"thumb001.jpg\"] [(\"foo\", \"5\"), (\"bar\", \"choc\")]
        --
        -- would generate a url such as
        -- @http://www.example.com/static/thumb001.jpg?foo=5&bar=choc@
        -- The StaticRoute constructor can be used when the URL cannot be
        -- statically generated at compile-time (e.g. when generating
        -- image galleries).
        data Route Static = StaticRoute [Text] [(Text, Text)]
            deriving (Route Static -> Route Static -> Bool
    (Route Static -> Route Static -> Bool)
    -> (Route Static -> Route Static -> Bool) -> Eq (Route Static)
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Route Static -> Route Static -> Bool
    == :: Route Static -> Route Static -> Bool
    $c/= :: Route Static -> Route Static -> Bool
    /= :: Route Static -> Route Static -> Bool
    Eq, Int -> Route Static -> ShowS
    [Route Static] -> ShowS
    Route Static -> String
    (Int -> Route Static -> ShowS)
    -> (Route Static -> String)
    -> ([Route Static] -> ShowS)
    -> Show (Route Static)
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Route Static -> ShowS
    showsPrec :: Int -> Route Static -> ShowS
    $cshow :: Route Static -> String
    show :: Route Static -> String
    $cshowList :: [Route Static] -> ShowS
    showList :: [Route Static] -> ShowS
    Show, ReadPrec [Route Static]
    ReadPrec (Route Static)
    Int -> ReadS (Route Static)
    ReadS [Route Static]
    (Int -> ReadS (Route Static))
    -> ReadS [Route Static]
    -> ReadPrec (Route Static)
    -> ReadPrec [Route Static]
    -> Read (Route Static)
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS (Route Static)
    readsPrec :: Int -> ReadS (Route Static)
    $creadList :: ReadS [Route Static]
    readList :: ReadS [Route Static]
    $creadPrec :: ReadPrec (Route Static)
    readPrec :: ReadPrec (Route Static)
    $creadListPrec :: ReadPrec [Route Static]
    readListPrec :: ReadPrec [Route Static]
    Read)
        renderRoute :: Route Static -> ([Text], [(Text, Text)])
    renderRoute (StaticRoute [Text]
    x [(Text, Text)]
    y) = ([Text]
    x, [(Text, Text)]
    y)
    instance ParseRoute Static where
        parseRoute :: ([Text], [(Text, Text)]) -> Maybe (Route Static)
    parseRoute ([Text]
    x, [(Text, Text)]
    y) = Route Static -> Maybe (Route Static)
    forall a. a -> Maybe a
    Just (Route Static -> Maybe (Route Static))
    -> Route Static -> Maybe (Route Static)
    forall a b. (a -> b) -> a -> b
    $ [Text] -> [(Text, Text)] -> Route Static
    StaticRoute [Text]
    x [(Text, Text)]
    y

    instance YesodSubDispatch Static master where
        yesodSubDispatch :: YesodSubRunnerEnv Static master -> Application
    yesodSubDispatch YesodSubRunnerEnv {YesodRunnerEnv master
    master -> Static
    Route Static -> Route master
    ParentRunner master
    ysreParentRunner :: ParentRunner master
    ysreGetSub :: master -> Static
    ysreToParentRoute :: Route Static -> Route master
    ysreParentEnv :: YesodRunnerEnv master
    ysreParentEnv :: forall sub parent.
    YesodSubRunnerEnv sub parent -> YesodRunnerEnv parent
    ysreToParentRoute :: forall sub parent.
    YesodSubRunnerEnv sub parent -> Route sub -> Route parent
    ysreGetSub :: forall sub parent. YesodSubRunnerEnv sub parent -> parent -> sub
    ysreParentRunner :: forall sub parent.
    YesodSubRunnerEnv sub parent -> ParentRunner parent
    ..} Request
    req =
            ParentRunner master
    ysreParentRunner HandlerFor master TypedContent
    handlert YesodRunnerEnv master
    ysreParentEnv ((Route Static -> Route master)
    -> Maybe (Route Static) -> Maybe (Route master)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Route Static -> Route master
    ysreToParentRoute Maybe (Route Static)
    route) Request
    req
          where
            route :: Maybe (Route Static)
    route = Route Static -> Maybe (Route Static)
    forall a. a -> Maybe a
    Just (Route Static -> Maybe (Route Static))
    -> Route Static -> Maybe (Route Static)
    forall a b. (a -> b) -> a -> b
    $ [Text] -> [(Text, Text)] -> Route Static
    StaticRoute (Request -> [Text]
    pathInfo Request
    req) []

            Static StaticSettings
    set = master -> Static
    ysreGetSub (master -> Static) -> master -> Static
    forall a b. (a -> b) -> a -> b
    $ YesodRunnerEnv master -> master
    forall site. YesodRunnerEnv site -> site
    yreSite (YesodRunnerEnv master -> master)
    -> YesodRunnerEnv master -> master
    forall a b. (a -> b) -> a -> b
    $ YesodRunnerEnv master
    ysreParentEnv
            handlert :: HandlerFor master TypedContent
    handlert = Application -> HandlerFor master TypedContent
    forall (m :: * -> *) b. MonadHandler m => Application -> m b
    sendWaiApplication (Application -> HandlerFor master TypedContent)
    -> Application -> HandlerFor master TypedContent
    forall a b. (a -> b) -> a -> b
    $ StaticSettings -> Application
    staticApp StaticSettings
    set

    notHidden :: FilePath -> Bool
    notHidden :: String -> Bool
    notHidden String
    "tmp" = Bool
    False
    notHidden String
    s =
        case String
    s of
            Char
    '.':String
    _ -> Bool
    False
            String
    _ -> Bool
    True

    getFileListPieces :: FilePath -> IO [[String]]
    getFileListPieces :: String -> IO [[String]]
    getFileListPieces = (StateT (Map String String) IO [[String]]
     -> Map String String -> IO [[String]])
    -> Map String String
    -> StateT (Map String String) IO [[String]]
    -> IO [[String]]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip StateT (Map String String) IO [[String]]
    -> Map String String -> IO [[String]]
    forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
    evalStateT Map String String
    forall k a. Map k a
    M.empty (StateT (Map String String) IO [[String]] -> IO [[String]])
    -> (String -> StateT (Map String String) IO [[String]])
    -> String
    -> IO [[String]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String
     -> ([String] -> [String])
     -> StateT (Map String String) IO [[String]])
    -> ([String] -> [String])
    -> String
    -> StateT (Map String String) IO [[String]]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip String
    -> ([String] -> [String])
    -> StateT (Map String String) IO [[String]]
    go [String] -> [String]
    forall a. a -> a
    id
      where
        go :: String
           -> ([String] -> [String])
           -> StateT (M.Map String String) IO [[String]]
        go :: String
    -> ([String] -> [String])
    -> StateT (Map String String) IO [[String]]
    go String
    fp [String] -> [String]
    front = do
            allContents <- IO [String] -> StateT (Map String String) IO [String]
    forall a. IO a -> StateT (Map String String) IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO [String] -> StateT (Map String String) IO [String])
    -> IO [String] -> StateT (Map String String) IO [String]
    forall a b. (a -> b) -> a -> b
    $ ([String] -> [String]
    forall a. Ord a => [a] -> [a]
    sort ([String] -> [String])
    -> ([String] -> [String]) -> [String] -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter String -> Bool
    notHidden) ([String] -> [String]) -> IO [String] -> IO [String]
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` String -> IO [String]
    getDirectoryContents String
    fp
            let fullPath :: String -> String
                fullPath String
    f = String
    fp String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Char
    '/' Char -> ShowS
    forall a. a -> [a] -> [a]
    : String
    f
            files <- liftIO $ filterM (doesFileExist . fullPath) allContents
            let files' = (String -> [String]) -> [String] -> [[String]]
    forall a b. (a -> b) -> [a] -> [b]
    map ([String] -> [String]
    front ([String] -> [String])
    -> (String -> [String]) -> String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    forall a. a -> [a]
    forall (m :: * -> *) a. Monad m => a -> m a
    return) [String]
    files
            files'' <- mapM dedupe files'
            dirs <- liftIO $ filterM (doesDirectoryExist . fullPath) allContents
            dirs' <- mapM (\String
    f -> String
    -> ([String] -> [String])
    -> StateT (Map String String) IO [[String]]
    go (ShowS
    fullPath String
    f) ([String] -> [String]
    front ([String] -> [String])
    -> ([String] -> [String]) -> [String] -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (:) String
    f)) dirs
            return $ concat $ files'' : dirs'

        -- Reuse data buffers for identical strings
        dedupe :: [String] -> StateT (M.Map String String) IO [String]
        dedupe :: [String] -> StateT (Map String String) IO [String]
    dedupe = (String -> StateT (Map String String) IO String)
    -> [String] -> StateT (Map String String) IO [String]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM String -> StateT (Map String String) IO String
    dedupe'

        dedupe' :: String -> StateT (M.Map String String) IO String
        dedupe' :: String -> StateT (Map String String) IO String
    dedupe' String
    s = do
            m <- StateT (Map String String) IO (Map String String)
    forall (m :: * -> *) s. Monad m => StateT s m s
    get
            case M.lookup s m of
                Just String
    s' -> String -> StateT (Map String String) IO String
    forall a. a -> StateT (Map String String) IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    s'
                Maybe String
    Nothing -> do
                    Map String String -> StateT (Map String String) IO ()
    forall (m :: * -> *) s. Monad m => s -> StateT s m ()
    put (Map String String -> StateT (Map String String) IO ())
    -> Map String String -> StateT (Map String String) IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> String -> Map String String -> Map String String
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert String
    s String
    s Map String String
    m
                    String -> StateT (Map String String) IO String
    forall a. a -> StateT (Map String String) IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    s

    -- | Template Haskell function that automatically creates routes
    -- for all of your static files.
    --
    -- For example, if you used
    --
    -- > staticFiles "static/"
    --
    -- and you had files @\"static\/style.css\"@ and
    -- @\"static\/js\/script.js\"@, then the following top-level
    -- definitions would be created:
    --
    -- > style_css    = StaticRoute ["style.css"]    []
    -- > js_script_js = StaticRoute ["js", "script.js"] []
    --
    -- Note that dots (@.@), dashes (@-@) and slashes (@\/@) are
    -- replaced by underscores (@\_@) to create valid Haskell
    -- identifiers.
    staticFiles :: FilePath -> Q [Dec]
    staticFiles :: String -> Q [Dec]
    staticFiles String
    dir = String -> Q [Dec]
    mkStaticFiles String
    dir

    -- | Same as 'staticFiles', but takes an explicit list of files
    -- to create identifiers for. The files path given are relative
    -- to the static folder. For example, to create routes for the
    -- files @\"static\/js\/jquery.js\"@ and
    -- @\"static\/css\/normalize.css\"@, you would use:
    --
    -- > staticFilesList "static" ["js/jquery.js", "css/normalize.css"]
    --
    -- This can be useful when you have a very large number of static
    -- files, but only need to refer to a few of them from Haskell.
    staticFilesList :: FilePath -> [FilePath] -> Q [Dec]
    staticFilesList :: String -> [String] -> Q [Dec]
    staticFilesList String
    dir [String]
    fs =
        String -> [[String]] -> Bool -> Q [Dec]
    mkStaticFilesList String
    dir ((String -> [String]) -> [String] -> [[String]]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> [String]
    split [String]
    fs) Bool
    True
      where
        split :: FilePath -> [String]
        split :: String -> [String]
    split [] = []
        split String
    x =
            let (String
    a, String
    b) = (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '/') String
    x
             in String
    a String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : String -> [String]
    split (Int -> ShowS
    forall a. Int -> [a] -> [a]
    drop Int
    1 String
    b)

    -- | Same as 'staticFiles', but doesn't append an ETag to the
    -- query string.
    --
    -- Using 'publicFiles' will speed up the compilation, since there
    -- won't be any need for hashing files during compile-time.
    -- However, since the ETag ceases to be part of the URL, the
    -- 'Static' subsite won't be able to set the expire date too far
    -- on the future.  Browsers still will be able to cache the
    -- contents, however they'll need send a request to the server to
    -- see if their copy is up-to-date.
    publicFiles :: FilePath -> Q [Dec]
    publicFiles :: String -> Q [Dec]
    publicFiles String
    dir = String -> Bool -> Q [Dec]
    mkStaticFiles' String
    dir Bool
    False

    -- | Similar to 'staticFilesList', but takes a mapping of
    -- unmunged names to fingerprinted file names.
    --
    -- @since 1.5.3
    staticFilesMap :: FilePath -> M.Map FilePath FilePath -> Q [Dec]
    staticFilesMap :: String -> Map String String -> Q [Dec]
    staticFilesMap String
    fp Map String String
    m = String -> [([String], [String])] -> Bool -> Q [Dec]
    mkStaticFilesList' String
    fp (((String, String) -> ([String], [String]))
    -> [(String, String)] -> [([String], [String])]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, String) -> ([String], [String])
    splitBoth [(String, String)]
    mapList) Bool
    True
      where
        splitBoth :: (String, String) -> ([String], [String])
    splitBoth (String
    k, String
    v) = (String -> [String]
    split String
    k, String -> [String]
    split String
    v)
        mapList :: [(String, String)]
    mapList = Map String String -> [(String, String)]
    forall k a. Map k a -> [(k, a)]
    M.toList Map String String
    m
        split :: FilePath -> [String]
        split :: String -> [String]
    split [] = []
        split String
    x =
            let (String
    a, String
    b) = (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '/') String
    x
             in String
    a String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : String -> [String]
    split (Int -> ShowS
    forall a. Int -> [a] -> [a]
    drop Int
    1 String
    b)

    -- | Similar to 'staticFilesMergeMap', but also generates identifiers
    -- for all files in the specified directory that don't have a
    -- fingerprinted version.
    --
    -- @since 1.5.3
    staticFilesMergeMap :: FilePath -> M.Map FilePath FilePath -> Q [Dec]
    staticFilesMergeMap :: String -> Map String String -> Q [Dec]
    staticFilesMergeMap String
    fp Map String String
    m = do
      fs <- IO [[String]] -> Q [[String]]
    forall a. IO a -> Q a
    forall (m :: * -> *) a. Quasi m => IO a -> m a
    qRunIO (IO [[String]] -> Q [[String]]) -> IO [[String]] -> Q [[String]]
    forall a b. (a -> b) -> a -> b
    $ String -> IO [[String]]
    getFileListPieces String
    fp
      let filesList = ([String] -> String) -> [[String]] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map [String] -> String
    FP.joinPath [[String]]
    fs
          mergedMapList = Map String String -> [(String, String)]
    forall k a. Map k a -> [(k, a)]
    M.toList (Map String String -> [(String, String)])
    -> Map String String -> [(String, String)]
    forall a b. (a -> b) -> a -> b
    $ (Map String String -> String -> Map String String)
    -> Map String String -> [String] -> Map String String
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' (Map String String
    -> Map String String -> String -> Map String String
    checkedInsert Map String String
    invertedMap) Map String String
    m [String]
    filesList
      mkStaticFilesList' fp (map splitBoth mergedMapList) True
      where
        splitBoth :: (String, String) -> ([String], [String])
    splitBoth (String
    k, String
    v) = (String -> [String]
    split String
    k, String -> [String]
    split String
    v)
        swap :: (b, a) -> (a, b)
    swap (b
    x, a
    y) = (a
    y, b
    x)
        mapList :: [(String, String)]
    mapList = Map String String -> [(String, String)]
    forall k a. Map k a -> [(k, a)]
    M.toList Map String String
    m
        invertedMap :: Map String String
    invertedMap = [(String, String)] -> Map String String
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([(String, String)] -> Map String String)
    -> [(String, String)] -> Map String String
    forall a b. (a -> b) -> a -> b
    $ ((String, String) -> (String, String))
    -> [(String, String)] -> [(String, String)]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, String) -> (String, String)
    forall {b} {a}. (b, a) -> (a, b)
    swap [(String, String)]
    mapList
        split :: FilePath -> [String]
        split :: String -> [String]
    split [] = []
        split String
    x =
            let (String
    a, String
    b) = (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '/') String
    x
             in String
    a String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : String -> [String]
    split (Int -> ShowS
    forall a. Int -> [a] -> [a]
    drop Int
    1 String
    b)
        -- We want to keep mappings for all files that are pre-fingerprinted,
        -- so this function checks against all of the existing fingerprinted files and
        -- only inserts a new mapping if it's not a fingerprinted file.
        checkedInsert
          :: M.Map FilePath FilePath -- inverted dictionary
          -> M.Map FilePath FilePath -- accumulating state
          -> FilePath
          -> M.Map FilePath FilePath
        checkedInsert :: Map String String
    -> Map String String -> String -> Map String String
    checkedInsert Map String String
    iDict Map String String
    st String
    p = if String -> Map String String -> Bool
    forall k a. Ord k => k -> Map k a -> Bool
    M.member String
    p Map String String
    iDict
          then Map String String
    st
          else String -> String -> Map String String -> Map String String
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert String
    p String
    p Map String String
    st

    mkHashMap :: FilePath -> IO (M.Map FilePath S8.ByteString)
    mkHashMap :: String -> IO (Map String ByteString)
    mkHashMap String
    dir = do
        fs <- String -> IO [[String]]
    getFileListPieces String
    dir
        hashAlist fs >>= return . M.fromList
      where
        hashAlist :: [[String]] -> IO [(FilePath, S8.ByteString)]
        hashAlist :: [[String]] -> IO [(String, ByteString)]
    hashAlist [[String]]
    fs = ([String] -> IO (String, ByteString))
    -> [[String]] -> IO [(String, ByteString)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM [String] -> IO (String, ByteString)
    hashPair [[String]]
    fs
          where
            hashPair :: [String] -> IO (FilePath, S8.ByteString)
            hashPair :: [String] -> IO (String, ByteString)
    hashPair [String]
    pieces = do let file :: String
    file = String -> [String] -> String
    pathFromRawPieces String
    dir [String]
    pieces
                                 h <- String -> IO String
    base64md5File String
    file
                                 return (file, S8.pack h)

    pathFromRawPieces :: FilePath -> [String] -> FilePath
    pathFromRawPieces :: String -> [String] -> String
    pathFromRawPieces =
        (String -> ShowS) -> String -> [String] -> String
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' String -> ShowS
    append
      where
        append :: String -> ShowS
    append String
    a String
    b = String
    a String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Char
    '/' Char -> ShowS
    forall a. a -> [a] -> [a]
    : String
    b

    cachedETagLookupDevel :: FilePath -> IO ETagLookup
    cachedETagLookupDevel :: String -> IO ETagLookup
    cachedETagLookupDevel String
    dir = do
        etags <- String -> IO (Map String ByteString)
    mkHashMap String
    dir
        mtimeVar <- newIORef (M.empty :: M.Map FilePath EpochTime)
        return $ \String
    f ->
          case String -> Map String ByteString -> Maybe ByteString
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup String
    f Map String ByteString
    etags of
            Maybe ByteString
    Nothing -> Maybe ByteString -> IO (Maybe ByteString)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe ByteString
    forall a. Maybe a
    Nothing
            Just ByteString
    checksum -> do
              fs <- String -> IO FileStatus
    getFileStatus String
    f
              let newt = FileStatus -> EpochTime
    modificationTime FileStatus
    fs
              mtimes <- readIORef mtimeVar
              oldt <- case M.lookup f mtimes of
                Maybe EpochTime
    Nothing -> IORef (Map String EpochTime) -> Map String EpochTime -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef (Map String EpochTime)
    mtimeVar (String -> EpochTime -> Map String EpochTime -> Map String EpochTime
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert String
    f EpochTime
    newt Map String EpochTime
    mtimes) IO () -> IO EpochTime -> IO EpochTime
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> EpochTime -> IO EpochTime
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return EpochTime
    newt
                Just EpochTime
    oldt -> EpochTime -> IO EpochTime
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return EpochTime
    oldt
              return $ if newt /= oldt then Nothing else Just checksum

    cachedETagLookup :: FilePath -> IO ETagLookup
    cachedETagLookup :: String -> IO ETagLookup
    cachedETagLookup String
    dir = do
        etags <- String -> IO (Map String ByteString)
    mkHashMap String
    dir
        return $ (\String
    f -> Maybe ByteString -> IO (Maybe ByteString)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe ByteString -> IO (Maybe ByteString))
    -> Maybe ByteString -> IO (Maybe ByteString)
    forall a b. (a -> b) -> a -> b
    $ String -> Map String ByteString -> Maybe ByteString
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup String
    f Map String ByteString
    etags)

    mkStaticFiles :: FilePath -> Q [Dec]
    mkStaticFiles :: String -> Q [Dec]
    mkStaticFiles String
    fp = String -> Bool -> Q [Dec]
    mkStaticFiles' String
    fp Bool
    True

    mkStaticFiles' :: FilePath -- ^ static directory
                   -> Bool     -- ^ append checksum query parameter
                   -> Q [Dec]
    mkStaticFiles' :: String -> Bool -> Q [Dec]
    mkStaticFiles' String
    fp Bool
    makeHash = do
        fs <- IO [[String]] -> Q [[String]]
    forall a. IO a -> Q a
    forall (m :: * -> *) a. Quasi m => IO a -> m a
    qRunIO (IO [[String]] -> Q [[String]]) -> IO [[String]] -> Q [[String]]
    forall a b. (a -> b) -> a -> b
    $ String -> IO [[String]]
    getFileListPieces String
    fp
        mkStaticFilesList fp fs makeHash

    mkStaticFilesList
        :: FilePath -- ^ static directory
        -> [[String]] -- ^ list of files to create identifiers for
        -> Bool     -- ^ append checksum query parameter
        -> Q [Dec]
    mkStaticFilesList :: String -> [[String]] -> Bool -> Q [Dec]
    mkStaticFilesList String
    fp [[String]]
    fs Bool
    makeHash = String -> [([String], [String])] -> Bool -> Q [Dec]
    mkStaticFilesList' String
    fp ([[String]] -> [[String]] -> [([String], [String])]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [[String]]
    fs [[String]]
    fs) Bool
    makeHash

    mkStaticFilesList'
        :: FilePath -- ^ static directory
        -> [([String], [String])] -- ^ list of files to create identifiers for, where
                                  -- the first argument of the tuple is the identifier
                                  -- alias and the second is the actual file name
        -> Bool     -- ^ append checksum query parameter
        -> Q [Dec]
    mkStaticFilesList' :: String -> [([String], [String])] -> Bool -> Q [Dec]
    mkStaticFilesList' String
    fp [([String], [String])]
    fs Bool
    makeHash = do
        [[Dec]] -> [Dec]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[Dec]] -> [Dec]) -> Q [[Dec]] -> Q [Dec]
    forall a b. (a -> b) -> Q a -> Q b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` (([String], [String]) -> Q [Dec])
    -> [([String], [String])] -> Q [[Dec]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM ([String], [String]) -> Q [Dec]
    mkRoute [([String], [String])]
    fs
      where
        replace' :: Char -> Char
    replace' Char
    c
            | Char
    '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
    <= Char
    'Z' = Char
    c
            | Char
    '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
    <= Char
    'z' = Char
    c
            | Char
    '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
    <= Char
    '9' = Char
    c
            | Bool
    otherwise = Char
    '_'
        mkRoute :: ([String], [String]) -> Q [Dec]
    mkRoute ([String]
    alias, [String]
    f) = do
            let name' :: String
    name' = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    "_" ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ ShowS -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Char -> Char) -> ShowS
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    replace') [String]
    alias
                routeName :: Name
    routeName = String -> Name
    mkName (String -> Name) -> String -> Name
    forall a b. (a -> b) -> a -> b
    $
                    case () of
                        ()
                            | String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    name' -> ShowS
    forall a. HasCallStack => String -> a
    error String
    "null-named file"
                            | Char -> Bool
    isDigit (String -> Char
    forall a. HasCallStack => [a] -> a
    head String
    name') -> Char
    '_' Char -> ShowS
    forall a. a -> [a] -> [a]
    : String
    name'
                            | Char -> Bool
    isLower (String -> Char
    forall a. HasCallStack => [a] -> a
    head String
    name') -> String
    name'
                            | Bool
    otherwise -> Char
    '_' Char -> ShowS
    forall a. a -> [a] -> [a]
    : String
    name'
            f' <- [|map pack $([String] -> Q Exp
    forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
    forall (m :: * -> *). Quote m => [String] -> m Exp
    TH.lift [String]
    f)|]
            qs <- if makeHash
                        then do hash <- qRunIO $ base64md5File $ pathFromRawPieces fp f
                                [|[(pack "etag", pack $(TH.lift hash))]|]
                        else return $ ListE []
            return
                [ SigD routeName $ ConT ''StaticRoute
                , FunD routeName
                    [ Clause [] (NormalB $ (ConE 'StaticRoute) `AppE` f' `AppE` qs) []
                    ]
                ]

    base64md5File :: FilePath -> IO String
    base64md5File :: String -> IO String
    base64md5File = (Digest MD5 -> String) -> IO (Digest MD5) -> IO String
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (ByteString -> String
    base64 (ByteString -> String)
    -> (Digest MD5 -> ByteString) -> Digest MD5 -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Digest MD5 -> ByteString
    forall {bout}. ByteArray bout => Digest MD5 -> bout
    encode) (IO (Digest MD5) -> IO String)
    -> (String -> IO (Digest MD5)) -> String -> IO String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> IO (Digest MD5)
    forall (m :: * -> *) hash.
    (MonadIO m, HashAlgorithm hash) =>
    String -> m (Digest hash)
    hashFile
        where encode :: Digest MD5 -> bout
    encode Digest MD5
    d = Digest MD5 -> bout
    forall bin bout.
    (ByteArrayAccess bin, ByteArray bout) =>
    bin -> bout
    ByteArray.convert (Digest MD5
    d :: Digest MD5)

    base64md5 :: L.ByteString -> String
    base64md5 :: ByteString -> String
    base64md5 ByteString
    lbs =
                ByteString -> String
    base64 (ByteString -> String) -> ByteString -> String
    forall a b. (a -> b) -> a -> b
    $ Digest MD5 -> ByteString
    forall {bout}. ByteArray bout => Digest MD5 -> bout
    encode
              (Digest MD5 -> ByteString) -> Digest MD5 -> ByteString
    forall a b. (a -> b) -> a -> b
    $ ConduitT () Void Identity (Digest MD5) -> Digest MD5
    forall r. ConduitT () Void Identity r -> r
    runConduitPure
              (ConduitT () Void Identity (Digest MD5) -> Digest MD5)
    -> ConduitT () Void Identity (Digest MD5) -> Digest MD5
    forall a b. (a -> b) -> a -> b
    $ ByteString -> ConduitT () ByteString Identity ()
    forall (m :: * -> *) lazy strict i.
    (Monad m, LazySequence lazy strict) =>
    lazy -> ConduitT i strict m ()
    Conduit.sourceLazy ByteString
    lbs ConduitT () ByteString Identity ()
    -> ConduitT ByteString Void Identity (Digest MD5)
    -> ConduitT () Void Identity (Digest MD5)
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .| ConduitT ByteString Void Identity (Digest MD5)
    Consumer ByteString Identity (Digest MD5)
    forall (m :: * -> *) hash.
    (Monad m, HashAlgorithm hash) =>
    Consumer ByteString m (Digest hash)
    sinkHash
      where
        encode :: Digest MD5 -> bout
    encode Digest MD5
    d = Digest MD5 -> bout
    forall bin bout.
    (ByteArrayAccess bin, ByteArray bout) =>
    bin -> bout
    ByteArray.convert (Digest MD5
    d :: Digest MD5)

    base64 :: S.ByteString -> String
    base64 :: ByteString -> String
    base64 = (Char -> Char) -> ShowS
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    tr
           ShowS -> (ByteString -> String) -> ByteString -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> ShowS
    forall a. Int -> [a] -> [a]
    take Int
    8
           ShowS -> (ByteString -> String) -> ByteString -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> String
    S8.unpack
           (ByteString -> String)
    -> (ByteString -> ByteString) -> ByteString -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString
    Data.ByteString.Base64.encode
      where
        tr :: Char -> Char
    tr Char
    '+' = Char
    '-'
        tr Char
    '/' = Char
    '_'
        tr Char
    c   = Char
    c

    -- $combining
    --
    -- A common scenario on a site is the desire to include many external CSS and
    -- Javascript files on every page. Doing so via the Widget functionality in
    -- Yesod will work, but would also mean that the same content will be
    -- downloaded many times. A better approach would be to combine all of these
    -- files together into a single static file and serve that as a static resource
    -- for every page. That resource can be cached on the client, and bandwidth
    -- usage reduced.
    --
    -- This could be done as a manual process, but that becomes tedious. Instead,
    -- you can use some Template Haskell code which will combine these files into a
    -- single static file at compile time.

    data CombineType = JS | CSS

    combineStatics' :: CombineType
                    -> CombineSettings
                    -> [Route Static] -- ^ files to combine
                    -> Q Exp
    combineStatics' :: CombineType -> CombineSettings -> [Route Static] -> Q Exp
    combineStatics' CombineType
    combineType CombineSettings {String
    [String] -> ByteString -> IO ByteString
    Text -> IO Text
    csStaticDir :: CombineSettings -> String
    csCssPostProcess :: CombineSettings -> [String] -> ByteString -> IO ByteString
    csJsPostProcess :: CombineSettings -> [String] -> ByteString -> IO ByteString
    csCssPreProcess :: CombineSettings -> Text -> IO Text
    csJsPreProcess :: CombineSettings -> Text -> IO Text
    csCombinedFolder :: CombineSettings -> String
    csStaticDir :: String
    csCssPostProcess :: [String] -> ByteString -> IO ByteString
    csJsPostProcess :: [String] -> ByteString -> IO ByteString
    csCssPreProcess :: Text -> IO Text
    csJsPreProcess :: Text -> IO Text
    csCombinedFolder :: String
    ..} [Route Static]
    routes = do
        texts <- IO Text -> Q Text
    forall a. IO a -> Q a
    forall (m :: * -> *) a. Quasi m => IO a -> m a
    qRunIO (IO Text -> Q Text) -> IO Text -> Q Text
    forall a b. (a -> b) -> a -> b
    $ ConduitT () Void (ResourceT IO) Text -> IO Text
    forall (m :: * -> *) r.
    MonadUnliftIO m =>
    ConduitT () Void (ResourceT m) r -> m r
    runConduitRes
                        (ConduitT () Void (ResourceT IO) Text -> IO Text)
    -> ConduitT () Void (ResourceT IO) Text -> IO Text
    forall a b. (a -> b) -> a -> b
    $ [String] -> ConduitT () (Element [String]) (ResourceT IO) ()
    forall (m :: * -> *) mono i.
    (Monad m, MonoFoldable mono) =>
    mono -> ConduitT i (Element mono) m ()
    yieldMany [String]
    fps
                       ConduitT () String (ResourceT IO) ()
    -> ConduitT String Void (ResourceT IO) Text
    -> ConduitT () Void (ResourceT IO) Text
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .| (String -> ConduitT String Text (ResourceT IO) ())
    -> ConduitT String Text (ResourceT IO) ()
    forall (m :: * -> *) i o r.
    Monad m =>
    (i -> ConduitT i o m r) -> ConduitT i o m ()
    awaitForever String -> ConduitT String Text (ResourceT IO) ()
    forall {m :: * -> *} {a}.
    (MonadResource m, MonadThrow m) =>
    String -> ConduitT a Text m ()
    readUTFFile
                       ConduitT String Text (ResourceT IO) ()
    -> ConduitT Text Void (ResourceT IO) Text
    -> ConduitT String Void (ResourceT IO) Text
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .| ConduitT Text Void (ResourceT IO) Text
    forall (m :: * -> *) lazy strict o.
    (Monad m, LazySequence lazy strict) =>
    ConduitT strict o m lazy
    sinkLazy
        ltext <- qRunIO $ preProcess texts
        bs    <- qRunIO $ postProcess fps $ TLE.encodeUtf8 ltext
        let hash' = ByteString -> String
    base64md5 ByteString
    bs
            suffix = String
    csCombinedFolder String -> ShowS
    </> String
    hash' String -> ShowS
    <.> String
    extension
            fp = String
    csStaticDir String -> ShowS
    </> String
    suffix
        qRunIO $ do
            createDirectoryIfMissing True $ takeDirectory fp
            L.writeFile fp bs
        let pieces = (Text -> String) -> [Text] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Text -> String
    T.unpack ([Text] -> [String]) -> [Text] -> [String]
    forall a b. (a -> b) -> a -> b
    $ HasCallStack => Text -> Text -> [Text]
    Text -> Text -> [Text]
    T.splitOn Text
    "/" (Text -> [Text]) -> Text -> [Text]
    forall a b. (a -> b) -> a -> b
    $ String -> Text
    T.pack String
    suffix
        [|StaticRoute (map pack pieces) []|]
      where
        fps :: [FilePath]
        fps :: [String]
    fps = (Route Static -> String) -> [Route Static] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Route Static -> String
    toFP [Route Static]
    routes
        toFP :: Route Static -> String
    toFP (StaticRoute [Text]
    pieces [(Text, Text)]
    _) = String
    csStaticDir String -> ShowS
    </> [String] -> String
    F.joinPath ((Text -> String) -> [Text] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Text -> String
    T.unpack [Text]
    pieces)
        readUTFFile :: String -> ConduitT a Text m ()
    readUTFFile String
    fp = String -> ConduitT a ByteString m ()
    forall (m :: * -> *) i.
    MonadResource m =>
    String -> ConduitT i ByteString m ()
    sourceFile String
    fp ConduitT a ByteString m ()
    -> ConduitT ByteString Text m () -> ConduitT a Text m ()
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .| ConduitT ByteString Text m ()
    forall (m :: * -> *). MonadThrow m => ConduitT ByteString Text m ()
    decodeUtf8C
        postProcess :: [String] -> ByteString -> IO ByteString
    postProcess =
            case CombineType
    combineType of
                CombineType
    JS -> [String] -> ByteString -> IO ByteString
    csJsPostProcess
                CombineType
    CSS -> [String] -> ByteString -> IO ByteString
    csCssPostProcess
        preProcess :: Text -> IO Text
    preProcess =
            case CombineType
    combineType of
                CombineType
    JS -> Text -> IO Text
    csJsPreProcess
                CombineType
    CSS -> Text -> IO Text
    csCssPreProcess
        extension :: String
    extension =
            case CombineType
    combineType of
                CombineType
    JS -> String
    "js"
                CombineType
    CSS -> String
    "css"

    -- | Data type for holding all settings for combining files.
    --
    -- This data type is a settings type. For more information, see:
    --
    -- <http://www.yesodweb.com/book/settings-types>
    --
    -- Since 1.2.0
    data CombineSettings = CombineSettings
        { CombineSettings -> String
    csStaticDir :: FilePath
        -- ^ File path containing static files.
        --
        -- Default: static
        --
        -- Since 1.2.0
        , CombineSettings -> [String] -> ByteString -> IO ByteString
    csCssPostProcess :: [FilePath] -> L.ByteString -> IO L.ByteString
        -- ^ Post processing to be performed on CSS files.
        --
        -- Default: Pass-through.
        --
        -- Since 1.2.0
        , CombineSettings -> [String] -> ByteString -> IO ByteString
    csJsPostProcess :: [FilePath] -> L.ByteString -> IO L.ByteString
        -- ^ Post processing to be performed on Javascript files.
        --
        -- Default: Pass-through.
        --
        -- Since 1.2.0
        , CombineSettings -> Text -> IO Text
    csCssPreProcess :: TL.Text -> IO TL.Text
        -- ^ Pre-processing to be performed on CSS files.
        --
        -- Default: convert all occurences of /static/ to ../
        --
        -- Since 1.2.0
        , CombineSettings -> Text -> IO Text
    csJsPreProcess :: TL.Text -> IO TL.Text
        -- ^ Pre-processing to be performed on Javascript files.
        --
        -- Default: Pass-through.
        --
        -- Since 1.2.0
        , CombineSettings -> String
    csCombinedFolder :: FilePath
        -- ^ Subfolder to put combined files into.
        --
        -- Default: combined
        --
        -- Since 1.2.0
        }

    instance Default CombineSettings where
        def :: CombineSettings
    def = CombineSettings
            { csStaticDir :: String
    csStaticDir = String
    "static"
            {- Disabled due to: https://github.com/yesodweb/yesod/issues/623
            , csCssPostProcess = \fps ->
                  either (error . (errorIntro fps)) (return . TLE.encodeUtf8)
                . flip luciusRTMinified []
                . TLE.decodeUtf8
            -}
            , csCssPostProcess :: [String] -> ByteString -> IO ByteString
    csCssPostProcess = (ByteString -> IO ByteString)
    -> [String] -> ByteString -> IO ByteString
    forall a b. a -> b -> a
    const ByteString -> IO ByteString
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return
            , csJsPostProcess :: [String] -> ByteString -> IO ByteString
    csJsPostProcess = (ByteString -> IO ByteString)
    -> [String] -> ByteString -> IO ByteString
    forall a b. a -> b -> a
    const ByteString -> IO ByteString
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return
               -- FIXME The following borders on a hack. With combining of files,
               -- the final location of the CSS is no longer fixed, so relative
               -- references will break. Instead, we switched to using /static/
               -- absolute references. However, when served from a separate domain
               -- name, this will break too. The solution is that, during
               -- development, we keep /static/, and in the combining phase, we
               -- replace /static with a relative reference to the parent folder.
            , csCssPreProcess :: Text -> IO Text
    csCssPreProcess =
                  Text -> IO Text
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return
                (Text -> IO Text) -> (Text -> Text) -> Text -> IO Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HasCallStack => Text -> Text -> Text -> Text
    Text -> Text -> Text -> Text
    TL.replace Text
    "'/static/" Text
    "'../"
                (Text -> Text) -> (Text -> Text) -> Text -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HasCallStack => Text -> Text -> Text -> Text
    Text -> Text -> Text -> Text
    TL.replace Text
    "\"/static/" Text
    "\"../"
            , csJsPreProcess :: Text -> IO Text
    csJsPreProcess = Text -> IO Text
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return
            , csCombinedFolder :: String
    csCombinedFolder = String
    "combined"
            }

    liftRoutes :: [Route Static] -> Q Exp
    liftRoutes :: [Route Static] -> Q Exp
    liftRoutes =
        ([Exp] -> Exp) -> Q [Exp] -> Q Exp
    forall a b. (a -> b) -> Q a -> Q b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [Exp] -> Exp
    ListE (Q [Exp] -> Q Exp)
    -> ([Route Static] -> Q [Exp]) -> [Route Static] -> Q Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Route Static -> Q Exp) -> [Route Static] -> Q [Exp]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Route Static -> Q Exp
    go
      where
        go :: Route Static -> Q Exp
        go :: Route Static -> Q Exp
    go (StaticRoute [Text]
    x [(Text, Text)]
    y) = [|StaticRoute $([Text] -> Q Exp
    liftTexts [Text]
    x) $([(Text, Text)] -> Q Exp
    liftPairs [(Text, Text)]
    y)|]

        liftTexts :: [Text] -> Q Exp
    liftTexts = ([Exp] -> Exp) -> Q [Exp] -> Q Exp
    forall a b. (a -> b) -> Q a -> Q b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [Exp] -> Exp
    ListE (Q [Exp] -> Q Exp) -> ([Text] -> Q [Exp]) -> [Text] -> Q Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text -> Q Exp) -> [Text] -> Q [Exp]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Text -> Q Exp
    forall {m :: * -> *}. Quote m => Text -> m Exp
    liftT
        liftT :: Text -> m Exp
    liftT Text
    t = [|pack $(String -> m Exp
    forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
    forall (m :: * -> *). Quote m => String -> m Exp
    TH.lift (String -> m Exp) -> String -> m Exp
    forall a b. (a -> b) -> a -> b
    $ Text -> String
    T.unpack Text
    t)|]

        liftPairs :: [(Text, Text)] -> Q Exp
    liftPairs = ([Exp] -> Exp) -> Q [Exp] -> Q Exp
    forall a b. (a -> b) -> Q a -> Q b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [Exp] -> Exp
    ListE (Q [Exp] -> Q Exp)
    -> ([(Text, Text)] -> Q [Exp]) -> [(Text, Text)] -> Q Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Text, Text) -> Q Exp) -> [(Text, Text)] -> Q [Exp]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Text, Text) -> Q Exp
    forall {m :: * -> *}. Quote m => (Text, Text) -> m Exp
    liftPair
        liftPair :: (Text, Text) -> m Exp
    liftPair (Text
    x, Text
    y) = [|($(Text -> m Exp
    forall {m :: * -> *}. Quote m => Text -> m Exp
    liftT Text
    x), $(Text -> m Exp
    forall {m :: * -> *}. Quote m => Text -> m Exp
    liftT Text
    y))|]

    -- | Combine multiple CSS files together. Common usage would be:
    --
    -- >>> combineStylesheets' development def 'StaticR [style1_css, style2_css]
    --
    -- Where @development@ is a variable in your site indicated whether you are in
    -- development or production mode.
    --
    -- Since 1.2.0
    combineStylesheets' :: Bool -- ^ development? if so, perform no combining
                        -> CombineSettings
                        -> Name -- ^ Static route constructor name, e.g. \'StaticR
                        -> [Route Static] -- ^ files to combine
                        -> Q Exp
    combineStylesheets' :: Bool -> CombineSettings -> Name -> [Route Static] -> Q Exp
    combineStylesheets' Bool
    development CombineSettings
    cs Name
    con [Route Static]
    routes
        | Bool
    development = [| mapM_ (addStylesheet . $(Exp -> Q Exp
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp -> Q Exp) -> Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Name -> Exp
    ConE Name
    con)) $([Route Static] -> Q Exp
    liftRoutes [Route Static]
    routes) |]
        | Bool
    otherwise = [| addStylesheet $ $(Exp -> Q Exp
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp -> Q Exp) -> Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Name -> Exp
    ConE Name
    con) $(CombineType -> CombineSettings -> [Route Static] -> Q Exp
    combineStatics' CombineType
    CSS CombineSettings
    cs [Route Static]
    routes) |]

    -- | Combine multiple JS files together. Common usage would be:
    --
    -- >>> combineScripts' development def 'StaticR [script1_js, script2_js]
    --
    -- Where @development@ is a variable in your site indicated whether you are in
    -- development or production mode.
    --
    -- Since 1.2.0
    combineScripts' :: Bool -- ^ development? if so, perform no combining
                    -> CombineSettings
                    -> Name -- ^ Static route constructor name, e.g. \'StaticR
                    -> [Route Static] -- ^ files to combine
                    -> Q Exp
    combineScripts' :: Bool -> CombineSettings -> Name -> [Route Static] -> Q Exp
    combineScripts' Bool
    development CombineSettings
    cs Name
    con [Route Static]
    routes
        | Bool
    development = [| mapM_ (addScript . $(Exp -> Q Exp
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp -> Q Exp) -> Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Name -> Exp
    ConE Name
    con)) $([Route Static] -> Q Exp
    liftRoutes [Route Static]
    routes) |]
        | Bool
    otherwise = [| addScript $ $(Exp -> Q Exp
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp -> Q Exp) -> Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Name -> Exp
    ConE Name
    con) $(CombineType -> CombineSettings -> [Route Static] -> Q Exp
    combineStatics' CombineType
    JS CombineSettings
    cs [Route Static]
    routes) |]