{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE FlexibleContexts #-}
module Yesod.Static
(
Static (..)
, Route (..)
, StaticRoute
, static
, staticDevel
, combineStylesheets'
, combineScripts'
, CombineSettings
, csStaticDir
, csCssPostProcess
, csJsPostProcess
, csCssPreProcess
, csJsPreProcess
, csCombinedFolder
, staticFiles
, staticFilesList
, staticFilesMap
, staticFilesMergeMap
, publicFiles
, base64md5
, 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 Network.Wai (pathInfo)
import Network.Wai.Application.Static
( StaticSettings (..)
, staticApp
, webAppSettingsWithLookup
, embeddedSettings
)
import WaiAppStatic.Storage.Filesystem (ETagLookup)
newtype Static = Static StaticSettings
type StaticRoute = Route Static
static :: FilePath -> IO Static
static :: FilePath -> IO Static
static dir :: FilePath
dir = do
ETagLookup
hashLookup <- FilePath -> IO ETagLookup
cachedETagLookup FilePath
dir
Static -> IO Static
forall (m :: * -> *) a. Monad m => a -> m a
return (Static -> IO Static) -> Static -> IO Static
forall a b. (a -> b) -> a -> b
$ StaticSettings -> Static
Static (StaticSettings -> Static) -> StaticSettings -> Static
forall a b. (a -> b) -> a -> b
$ FilePath -> ETagLookup -> StaticSettings
webAppSettingsWithLookup FilePath
dir ETagLookup
hashLookup
staticDevel :: FilePath -> IO Static
staticDevel :: FilePath -> IO Static
staticDevel dir :: FilePath
dir = do
ETagLookup
hashLookup <- FilePath -> IO ETagLookup
cachedETagLookupDevel FilePath
dir
Static -> IO Static
forall (m :: * -> *) a. Monad m => a -> m a
return (Static -> IO Static) -> Static -> IO Static
forall a b. (a -> b) -> a -> b
$ StaticSettings -> Static
Static (StaticSettings -> Static) -> StaticSettings -> Static
forall a b. (a -> b) -> a -> b
$ FilePath -> ETagLookup -> StaticSettings
webAppSettingsWithLookup FilePath
dir ETagLookup
hashLookup
embed :: FilePath -> Q Exp
embed :: FilePath -> Q Exp
embed fp :: FilePath
fp = [|Static (embeddedSettings $(embedDir fp))|]
instance RenderRoute Static where
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
/= :: Route Static -> Route Static -> Bool
$c/= :: Route Static -> Route Static -> Bool
== :: Route Static -> Route Static -> Bool
$c== :: Route Static -> Route Static -> Bool
Eq, Int -> Route Static -> ShowS
[Route Static] -> ShowS
Route Static -> FilePath
(Int -> Route Static -> ShowS)
-> (Route Static -> FilePath)
-> ([Route Static] -> ShowS)
-> Show (Route Static)
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Route Static] -> ShowS
$cshowList :: [Route Static] -> ShowS
show :: Route Static -> FilePath
$cshow :: Route Static -> FilePath
showsPrec :: Int -> Route Static -> ShowS
$cshowsPrec :: Int -> 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
readListPrec :: ReadPrec [Route Static]
$creadListPrec :: ReadPrec [Route Static]
readPrec :: ReadPrec (Route Static)
$creadPrec :: ReadPrec (Route Static)
readList :: ReadS [Route Static]
$creadList :: ReadS [Route Static]
readsPrec :: Int -> ReadS (Route Static)
$creadsPrec :: Int -> ReadS (Route Static)
Read)
renderRoute :: Route Static -> ([Text], [(Text, Text)])
renderRoute (StaticRoute x y) = ([Text]
x, [(Text, Text)]
y)
instance ParseRoute Static where
parseRoute :: ([Text], [(Text, Text)]) -> Maybe (Route Static)
parseRoute (x :: [Text]
x, y :: [(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 {..} req :: Request
req =
ParentRunner master
ysreParentRunner HandlerFor master TypedContent
handlert YesodRunnerEnv master
ysreParentEnv ((Route Static -> Route master)
-> Maybe (Route Static) -> Maybe (Route master)
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 set :: 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 :: FilePath -> Bool
notHidden "tmp" = Bool
False
notHidden s :: FilePath
s =
case FilePath
s of
'.':_ -> Bool
False
_ -> Bool
True
getFileListPieces :: FilePath -> IO [[String]]
getFileListPieces :: FilePath -> IO [[FilePath]]
getFileListPieces = (StateT (Map FilePath FilePath) IO [[FilePath]]
-> Map FilePath FilePath -> IO [[FilePath]])
-> Map FilePath FilePath
-> StateT (Map FilePath FilePath) IO [[FilePath]]
-> IO [[FilePath]]
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT (Map FilePath FilePath) IO [[FilePath]]
-> Map FilePath FilePath -> IO [[FilePath]]
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT Map FilePath FilePath
forall k a. Map k a
M.empty (StateT (Map FilePath FilePath) IO [[FilePath]] -> IO [[FilePath]])
-> (FilePath -> StateT (Map FilePath FilePath) IO [[FilePath]])
-> FilePath
-> IO [[FilePath]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
-> ([FilePath] -> [FilePath])
-> StateT (Map FilePath FilePath) IO [[FilePath]])
-> ([FilePath] -> [FilePath])
-> FilePath
-> StateT (Map FilePath FilePath) IO [[FilePath]]
forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath
-> ([FilePath] -> [FilePath])
-> StateT (Map FilePath FilePath) IO [[FilePath]]
go [FilePath] -> [FilePath]
forall a. a -> a
id
where
go :: String
-> ([String] -> [String])
-> StateT (M.Map String String) IO [[String]]
go :: FilePath
-> ([FilePath] -> [FilePath])
-> StateT (Map FilePath FilePath) IO [[FilePath]]
go fp :: FilePath
fp front :: [FilePath] -> [FilePath]
front = do
[FilePath]
allContents <- IO [FilePath] -> StateT (Map FilePath FilePath) IO [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> StateT (Map FilePath FilePath) IO [FilePath])
-> IO [FilePath] -> StateT (Map FilePath FilePath) IO [FilePath]
forall a b. (a -> b) -> a -> b
$ ([FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
notHidden) ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` FilePath -> IO [FilePath]
getDirectoryContents FilePath
fp
let fullPath :: String -> String
fullPath :: ShowS
fullPath f :: FilePath
f = FilePath
fp FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ '/' Char -> ShowS
forall a. a -> [a] -> [a]
: FilePath
f
[FilePath]
files <- IO [FilePath] -> StateT (Map FilePath FilePath) IO [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> StateT (Map FilePath FilePath) IO [FilePath])
-> IO [FilePath] -> StateT (Map FilePath FilePath) IO [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool) -> ShowS -> FilePath -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
fullPath) [FilePath]
allContents
let files' :: [[FilePath]]
files' = (FilePath -> [FilePath]) -> [FilePath] -> [[FilePath]]
forall a b. (a -> b) -> [a] -> [b]
map ([FilePath] -> [FilePath]
front ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return) [FilePath]
files
[[FilePath]]
files'' <- ([FilePath] -> StateT (Map FilePath FilePath) IO [FilePath])
-> [[FilePath]] -> StateT (Map FilePath FilePath) IO [[FilePath]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [FilePath] -> StateT (Map FilePath FilePath) IO [FilePath]
dedupe [[FilePath]]
files'
[FilePath]
dirs <- IO [FilePath] -> StateT (Map FilePath FilePath) IO [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> StateT (Map FilePath FilePath) IO [FilePath])
-> IO [FilePath] -> StateT (Map FilePath FilePath) IO [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (FilePath -> IO Bool
doesDirectoryExist (FilePath -> IO Bool) -> ShowS -> FilePath -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
fullPath) [FilePath]
allContents
[[[FilePath]]]
dirs' <- (FilePath -> StateT (Map FilePath FilePath) IO [[FilePath]])
-> [FilePath] -> StateT (Map FilePath FilePath) IO [[[FilePath]]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\f :: FilePath
f -> FilePath
-> ([FilePath] -> [FilePath])
-> StateT (Map FilePath FilePath) IO [[FilePath]]
go (ShowS
fullPath FilePath
f) ([FilePath] -> [FilePath]
front ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) FilePath
f)) [FilePath]
dirs
[[FilePath]] -> StateT (Map FilePath FilePath) IO [[FilePath]]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[FilePath]] -> StateT (Map FilePath FilePath) IO [[FilePath]])
-> [[FilePath]] -> StateT (Map FilePath FilePath) IO [[FilePath]]
forall a b. (a -> b) -> a -> b
$ [[[FilePath]]] -> [[FilePath]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[[FilePath]]] -> [[FilePath]]) -> [[[FilePath]]] -> [[FilePath]]
forall a b. (a -> b) -> a -> b
$ [[FilePath]]
files'' [[FilePath]] -> [[[FilePath]]] -> [[[FilePath]]]
forall a. a -> [a] -> [a]
: [[[FilePath]]]
dirs'
dedupe :: [String] -> StateT (M.Map String String) IO [String]
dedupe :: [FilePath] -> StateT (Map FilePath FilePath) IO [FilePath]
dedupe = (FilePath -> StateT (Map FilePath FilePath) IO FilePath)
-> [FilePath] -> StateT (Map FilePath FilePath) IO [FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> StateT (Map FilePath FilePath) IO FilePath
dedupe'
dedupe' :: String -> StateT (M.Map String String) IO String
dedupe' :: FilePath -> StateT (Map FilePath FilePath) IO FilePath
dedupe' s :: FilePath
s = do
Map FilePath FilePath
m <- StateT (Map FilePath FilePath) IO (Map FilePath FilePath)
forall (m :: * -> *) s. Monad m => StateT s m s
get
case FilePath -> Map FilePath FilePath -> Maybe FilePath
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FilePath
s Map FilePath FilePath
m of
Just s' :: FilePath
s' -> FilePath -> StateT (Map FilePath FilePath) IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
s'
Nothing -> do
Map FilePath FilePath -> StateT (Map FilePath FilePath) IO ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (Map FilePath FilePath -> StateT (Map FilePath FilePath) IO ())
-> Map FilePath FilePath -> StateT (Map FilePath FilePath) IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> FilePath -> Map FilePath FilePath -> Map FilePath FilePath
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert FilePath
s FilePath
s Map FilePath FilePath
m
FilePath -> StateT (Map FilePath FilePath) IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
s
staticFiles :: FilePath -> Q [Dec]
staticFiles :: FilePath -> Q [Dec]
staticFiles dir :: FilePath
dir = FilePath -> Q [Dec]
mkStaticFiles FilePath
dir
staticFilesList :: FilePath -> [FilePath] -> Q [Dec]
staticFilesList :: FilePath -> [FilePath] -> Q [Dec]
staticFilesList dir :: FilePath
dir fs :: [FilePath]
fs =
FilePath -> [[FilePath]] -> Bool -> Q [Dec]
mkStaticFilesList FilePath
dir ((FilePath -> [FilePath]) -> [FilePath] -> [[FilePath]]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> [FilePath]
split [FilePath]
fs) Bool
True
where
split :: FilePath -> [String]
split :: FilePath -> [FilePath]
split [] = []
split x :: FilePath
x =
let (a :: FilePath
a, b :: FilePath
b) = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '/') FilePath
x
in FilePath
a FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: FilePath -> [FilePath]
split (Int -> ShowS
forall a. Int -> [a] -> [a]
drop 1 FilePath
b)
publicFiles :: FilePath -> Q [Dec]
publicFiles :: FilePath -> Q [Dec]
publicFiles dir :: FilePath
dir = FilePath -> Bool -> Q [Dec]
mkStaticFiles' FilePath
dir Bool
False
staticFilesMap :: FilePath -> M.Map FilePath FilePath -> Q [Dec]
staticFilesMap :: FilePath -> Map FilePath FilePath -> Q [Dec]
staticFilesMap fp :: FilePath
fp m :: Map FilePath FilePath
m = FilePath -> [([FilePath], [FilePath])] -> Bool -> Q [Dec]
mkStaticFilesList' FilePath
fp (((FilePath, FilePath) -> ([FilePath], [FilePath]))
-> [(FilePath, FilePath)] -> [([FilePath], [FilePath])]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, FilePath) -> ([FilePath], [FilePath])
splitBoth [(FilePath, FilePath)]
mapList) Bool
True
where
splitBoth :: (FilePath, FilePath) -> ([FilePath], [FilePath])
splitBoth (k :: FilePath
k, v :: FilePath
v) = (FilePath -> [FilePath]
split FilePath
k, FilePath -> [FilePath]
split FilePath
v)
mapList :: [(FilePath, FilePath)]
mapList = Map FilePath FilePath -> [(FilePath, FilePath)]
forall k a. Map k a -> [(k, a)]
M.toList Map FilePath FilePath
m
split :: FilePath -> [String]
split :: FilePath -> [FilePath]
split [] = []
split x :: FilePath
x =
let (a :: FilePath
a, b :: FilePath
b) = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '/') FilePath
x
in FilePath
a FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: FilePath -> [FilePath]
split (Int -> ShowS
forall a. Int -> [a] -> [a]
drop 1 FilePath
b)
staticFilesMergeMap :: FilePath -> M.Map FilePath FilePath -> Q [Dec]
staticFilesMergeMap :: FilePath -> Map FilePath FilePath -> Q [Dec]
staticFilesMergeMap fp :: FilePath
fp m :: Map FilePath FilePath
m = do
[[FilePath]]
fs <- IO [[FilePath]] -> Q [[FilePath]]
forall (m :: * -> *) a. Quasi m => IO a -> m a
qRunIO (IO [[FilePath]] -> Q [[FilePath]])
-> IO [[FilePath]] -> Q [[FilePath]]
forall a b. (a -> b) -> a -> b
$ FilePath -> IO [[FilePath]]
getFileListPieces FilePath
fp
let filesList :: [FilePath]
filesList = ([FilePath] -> FilePath) -> [[FilePath]] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map [FilePath] -> FilePath
FP.joinPath [[FilePath]]
fs
mergedMapList :: [(FilePath, FilePath)]
mergedMapList = Map FilePath FilePath -> [(FilePath, FilePath)]
forall k a. Map k a -> [(k, a)]
M.toList (Map FilePath FilePath -> [(FilePath, FilePath)])
-> Map FilePath FilePath -> [(FilePath, FilePath)]
forall a b. (a -> b) -> a -> b
$ (Map FilePath FilePath -> FilePath -> Map FilePath FilePath)
-> Map FilePath FilePath -> [FilePath] -> Map FilePath FilePath
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Map FilePath FilePath
-> Map FilePath FilePath -> FilePath -> Map FilePath FilePath
checkedInsert Map FilePath FilePath
invertedMap) Map FilePath FilePath
m [FilePath]
filesList
FilePath -> [([FilePath], [FilePath])] -> Bool -> Q [Dec]
mkStaticFilesList' FilePath
fp (((FilePath, FilePath) -> ([FilePath], [FilePath]))
-> [(FilePath, FilePath)] -> [([FilePath], [FilePath])]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, FilePath) -> ([FilePath], [FilePath])
splitBoth [(FilePath, FilePath)]
mergedMapList) Bool
True
where
splitBoth :: (FilePath, FilePath) -> ([FilePath], [FilePath])
splitBoth (k :: FilePath
k, v :: FilePath
v) = (FilePath -> [FilePath]
split FilePath
k, FilePath -> [FilePath]
split FilePath
v)
swap :: (b, a) -> (a, b)
swap (x :: b
x, y :: a
y) = (a
y, b
x)
mapList :: [(FilePath, FilePath)]
mapList = Map FilePath FilePath -> [(FilePath, FilePath)]
forall k a. Map k a -> [(k, a)]
M.toList Map FilePath FilePath
m
invertedMap :: Map FilePath FilePath
invertedMap = [(FilePath, FilePath)] -> Map FilePath FilePath
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(FilePath, FilePath)] -> Map FilePath FilePath)
-> [(FilePath, FilePath)] -> Map FilePath FilePath
forall a b. (a -> b) -> a -> b
$ ((FilePath, FilePath) -> (FilePath, FilePath))
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, FilePath) -> (FilePath, FilePath)
forall b a. (b, a) -> (a, b)
swap [(FilePath, FilePath)]
mapList
split :: FilePath -> [String]
split :: FilePath -> [FilePath]
split [] = []
split x :: FilePath
x =
let (a :: FilePath
a, b :: FilePath
b) = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '/') FilePath
x
in FilePath
a FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: FilePath -> [FilePath]
split (Int -> ShowS
forall a. Int -> [a] -> [a]
drop 1 FilePath
b)
checkedInsert
:: M.Map FilePath FilePath
-> M.Map FilePath FilePath
-> FilePath
-> M.Map FilePath FilePath
checkedInsert :: Map FilePath FilePath
-> Map FilePath FilePath -> FilePath -> Map FilePath FilePath
checkedInsert iDict :: Map FilePath FilePath
iDict st :: Map FilePath FilePath
st p :: FilePath
p = if FilePath -> Map FilePath FilePath -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member FilePath
p Map FilePath FilePath
iDict
then Map FilePath FilePath
st
else FilePath
-> FilePath -> Map FilePath FilePath -> Map FilePath FilePath
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert FilePath
p FilePath
p Map FilePath FilePath
st
mkHashMap :: FilePath -> IO (M.Map FilePath S8.ByteString)
mkHashMap :: FilePath -> IO (Map FilePath ByteString)
mkHashMap dir :: FilePath
dir = do
[[FilePath]]
fs <- FilePath -> IO [[FilePath]]
getFileListPieces FilePath
dir
[[FilePath]] -> IO [(FilePath, ByteString)]
hashAlist [[FilePath]]
fs IO [(FilePath, ByteString)]
-> ([(FilePath, ByteString)] -> IO (Map FilePath ByteString))
-> IO (Map FilePath ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Map FilePath ByteString -> IO (Map FilePath ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map FilePath ByteString -> IO (Map FilePath ByteString))
-> ([(FilePath, ByteString)] -> Map FilePath ByteString)
-> [(FilePath, ByteString)]
-> IO (Map FilePath ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(FilePath, ByteString)] -> Map FilePath ByteString
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
where
hashAlist :: [[String]] -> IO [(FilePath, S8.ByteString)]
hashAlist :: [[FilePath]] -> IO [(FilePath, ByteString)]
hashAlist fs :: [[FilePath]]
fs = ([FilePath] -> IO (FilePath, ByteString))
-> [[FilePath]] -> IO [(FilePath, ByteString)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [FilePath] -> IO (FilePath, ByteString)
hashPair [[FilePath]]
fs
where
hashPair :: [String] -> IO (FilePath, S8.ByteString)
hashPair :: [FilePath] -> IO (FilePath, ByteString)
hashPair pieces :: [FilePath]
pieces = do let file :: FilePath
file = FilePath -> [FilePath] -> FilePath
pathFromRawPieces FilePath
dir [FilePath]
pieces
FilePath
h <- FilePath -> IO FilePath
base64md5File FilePath
file
(FilePath, ByteString) -> IO (FilePath, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
file, FilePath -> ByteString
S8.pack FilePath
h)
pathFromRawPieces :: FilePath -> [String] -> FilePath
pathFromRawPieces :: FilePath -> [FilePath] -> FilePath
pathFromRawPieces =
(FilePath -> ShowS) -> FilePath -> [FilePath] -> FilePath
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' FilePath -> ShowS
append
where
append :: FilePath -> ShowS
append a :: FilePath
a b :: FilePath
b = FilePath
a FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ '/' Char -> ShowS
forall a. a -> [a] -> [a]
: FilePath
b
cachedETagLookupDevel :: FilePath -> IO ETagLookup
cachedETagLookupDevel :: FilePath -> IO ETagLookup
cachedETagLookupDevel dir :: FilePath
dir = do
Map FilePath ByteString
etags <- FilePath -> IO (Map FilePath ByteString)
mkHashMap FilePath
dir
IORef (Map FilePath EpochTime)
mtimeVar <- Map FilePath EpochTime -> IO (IORef (Map FilePath EpochTime))
forall a. a -> IO (IORef a)
newIORef (Map FilePath EpochTime
forall k a. Map k a
M.empty :: M.Map FilePath EpochTime)
ETagLookup -> IO ETagLookup
forall (m :: * -> *) a. Monad m => a -> m a
return (ETagLookup -> IO ETagLookup) -> ETagLookup -> IO ETagLookup
forall a b. (a -> b) -> a -> b
$ \f :: FilePath
f ->
case FilePath -> Map FilePath ByteString -> Maybe ByteString
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FilePath
f Map FilePath ByteString
etags of
Nothing -> Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
Just checksum :: ByteString
checksum -> do
FileStatus
fs <- FilePath -> IO FileStatus
getFileStatus FilePath
f
let newt :: EpochTime
newt = FileStatus -> EpochTime
modificationTime FileStatus
fs
Map FilePath EpochTime
mtimes <- IORef (Map FilePath EpochTime) -> IO (Map FilePath EpochTime)
forall a. IORef a -> IO a
readIORef IORef (Map FilePath EpochTime)
mtimeVar
EpochTime
oldt <- case FilePath -> Map FilePath EpochTime -> Maybe EpochTime
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FilePath
f Map FilePath EpochTime
mtimes of
Nothing -> IORef (Map FilePath EpochTime) -> Map FilePath EpochTime -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Map FilePath EpochTime)
mtimeVar (FilePath
-> EpochTime -> Map FilePath EpochTime -> Map FilePath EpochTime
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert FilePath
f EpochTime
newt Map FilePath EpochTime
mtimes) IO () -> IO EpochTime -> IO EpochTime
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EpochTime -> IO EpochTime
forall (m :: * -> *) a. Monad m => a -> m a
return EpochTime
newt
Just oldt :: EpochTime
oldt -> EpochTime -> IO EpochTime
forall (m :: * -> *) a. Monad m => a -> m a
return EpochTime
oldt
Maybe ByteString -> IO (Maybe ByteString)
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
$ if EpochTime
newt EpochTime -> EpochTime -> Bool
forall a. Eq a => a -> a -> Bool
/= EpochTime
oldt then Maybe ByteString
forall a. Maybe a
Nothing else ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
checksum
cachedETagLookup :: FilePath -> IO ETagLookup
cachedETagLookup :: FilePath -> IO ETagLookup
cachedETagLookup dir :: FilePath
dir = do
Map FilePath ByteString
etags <- FilePath -> IO (Map FilePath ByteString)
mkHashMap FilePath
dir
ETagLookup -> IO ETagLookup
forall (m :: * -> *) a. Monad m => a -> m a
return (ETagLookup -> IO ETagLookup) -> ETagLookup -> IO ETagLookup
forall a b. (a -> b) -> a -> b
$ (\f :: FilePath
f -> Maybe ByteString -> IO (Maybe ByteString)
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
$ FilePath -> Map FilePath ByteString -> Maybe ByteString
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FilePath
f Map FilePath ByteString
etags)
mkStaticFiles :: FilePath -> Q [Dec]
mkStaticFiles :: FilePath -> Q [Dec]
mkStaticFiles fp :: FilePath
fp = FilePath -> Bool -> Q [Dec]
mkStaticFiles' FilePath
fp Bool
True
mkStaticFiles' :: FilePath
-> Bool
-> Q [Dec]
mkStaticFiles' :: FilePath -> Bool -> Q [Dec]
mkStaticFiles' fp :: FilePath
fp makeHash :: Bool
makeHash = do
[[FilePath]]
fs <- IO [[FilePath]] -> Q [[FilePath]]
forall (m :: * -> *) a. Quasi m => IO a -> m a
qRunIO (IO [[FilePath]] -> Q [[FilePath]])
-> IO [[FilePath]] -> Q [[FilePath]]
forall a b. (a -> b) -> a -> b
$ FilePath -> IO [[FilePath]]
getFileListPieces FilePath
fp
FilePath -> [[FilePath]] -> Bool -> Q [Dec]
mkStaticFilesList FilePath
fp [[FilePath]]
fs Bool
makeHash
mkStaticFilesList
:: FilePath
-> [[String]]
-> Bool
-> Q [Dec]
mkStaticFilesList :: FilePath -> [[FilePath]] -> Bool -> Q [Dec]
mkStaticFilesList fp :: FilePath
fp fs :: [[FilePath]]
fs makeHash :: Bool
makeHash = FilePath -> [([FilePath], [FilePath])] -> Bool -> Q [Dec]
mkStaticFilesList' FilePath
fp ([[FilePath]] -> [[FilePath]] -> [([FilePath], [FilePath])]
forall a b. [a] -> [b] -> [(a, b)]
zip [[FilePath]]
fs [[FilePath]]
fs) Bool
makeHash
mkStaticFilesList'
:: FilePath
-> [([String], [String])]
-> Bool
-> Q [Dec]
mkStaticFilesList' :: FilePath -> [([FilePath], [FilePath])] -> Bool -> Q [Dec]
mkStaticFilesList' fp :: FilePath
fp fs :: [([FilePath], [FilePath])]
fs makeHash :: Bool
makeHash = do
[[Dec]] -> [Dec]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Dec]] -> [Dec]) -> Q [[Dec]] -> Q [Dec]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (([FilePath], [FilePath]) -> Q [Dec])
-> [([FilePath], [FilePath])] -> Q [[Dec]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([FilePath], [FilePath]) -> Q [Dec]
mkRoute [([FilePath], [FilePath])]
fs
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 = '_'
mkRoute :: ([FilePath], [FilePath]) -> Q [Dec]
mkRoute (alias :: [FilePath]
alias, f :: [FilePath]
f) = do
let name' :: FilePath
name' = FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate "_" ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ ShowS -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
replace') [FilePath]
alias
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' -> ShowS
forall a. HasCallStack => FilePath -> a
error "null-named file"
| Char -> Bool
isDigit (FilePath -> Char
forall a. [a] -> a
head FilePath
name') -> '_' Char -> ShowS
forall a. a -> [a] -> [a]
: FilePath
name'
| Char -> Bool
isLower (FilePath -> Char
forall a. [a] -> a
head FilePath
name') -> FilePath
name'
| Bool
otherwise -> '_' Char -> ShowS
forall a. a -> [a] -> [a]
: FilePath
name'
Exp
f' <- [|map pack $(TH.lift f)|]
Exp
qs <- if Bool
makeHash
then do FilePath
hash <- IO FilePath -> Q FilePath
forall (m :: * -> *) a. Quasi m => IO a -> m a
qRunIO (IO FilePath -> Q FilePath) -> IO FilePath -> Q FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
base64md5File (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> FilePath
pathFromRawPieces FilePath
fp [FilePath]
f
[|[(pack "etag", pack $(TH.lift hash))]|]
else Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ [Exp] -> Exp
ListE []
[Dec] -> Q [Dec]
forall (m :: * -> *) a. Monad m => a -> m a
return
[ Name -> Type -> Dec
SigD Name
routeName (Type -> Dec) -> Type -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> Type
ConT ''StaticRoute
, Name -> [Clause] -> Dec
FunD Name
routeName
[ [Pat] -> Body -> [Dec] -> Clause
Clause [] (Exp -> Body
NormalB (Exp -> Body) -> Exp -> Body
forall a b. (a -> b) -> a -> b
$ (Name -> Exp
ConE 'StaticRoute) Exp -> Exp -> Exp
`AppE` Exp
f' Exp -> Exp -> Exp
`AppE` Exp
qs) []
]
]
base64md5File :: FilePath -> IO String
base64md5File :: FilePath -> IO FilePath
base64md5File = (Digest MD5 -> FilePath) -> IO (Digest MD5) -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> FilePath
base64 (ByteString -> FilePath)
-> (Digest MD5 -> ByteString) -> Digest MD5 -> FilePath
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 FilePath)
-> (FilePath -> IO (Digest MD5)) -> FilePath -> IO FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO (Digest MD5)
forall (m :: * -> *) hash.
(MonadIO m, HashAlgorithm hash) =>
FilePath -> m (Digest hash)
hashFile
where encode :: Digest MD5 -> bout
encode d :: 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 -> FilePath
base64md5 lbs :: ByteString
lbs =
ByteString -> FilePath
base64 (ByteString -> FilePath) -> ByteString -> FilePath
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 ()
-> ConduitM ByteString Void Identity (Digest MD5)
-> ConduitT () Void Identity (Digest MD5)
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM ByteString Void Identity (Digest MD5)
forall (m :: * -> *) hash.
(Monad m, HashAlgorithm hash) =>
Consumer ByteString m (Digest hash)
sinkHash
where
encode :: Digest MD5 -> bout
encode d :: 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 -> FilePath
base64 = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
tr
ShowS -> (ByteString -> FilePath) -> ByteString -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
take 8
ShowS -> (ByteString -> FilePath) -> ByteString -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FilePath
S8.unpack
(ByteString -> FilePath)
-> (ByteString -> ByteString) -> ByteString -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Data.ByteString.Base64.encode
where
tr :: Char -> Char
tr '+' = '-'
tr '/' = '_'
tr c :: Char
c = Char
c
data CombineType = JS | CSS
combineStatics' :: CombineType
-> CombineSettings
-> [Route Static]
-> Q Exp
combineStatics' :: CombineType -> CombineSettings -> [Route Static] -> Q Exp
combineStatics' combineType :: CombineType
combineType CombineSettings {..} routes :: [Route Static]
routes = do
Text
texts <- IO Text -> Q Text
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
$ [FilePath] -> ConduitT () (Element [FilePath]) (ResourceT IO) ()
forall (m :: * -> *) mono i.
(Monad m, MonoFoldable mono) =>
mono -> ConduitT i (Element mono) m ()
yieldMany [FilePath]
fps
ConduitT () FilePath (ResourceT IO) ()
-> ConduitM FilePath Void (ResourceT IO) Text
-> ConduitT () Void (ResourceT IO) Text
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (FilePath -> ConduitT FilePath Text (ResourceT IO) ())
-> ConduitT FilePath Text (ResourceT IO) ()
forall (m :: * -> *) i o r.
Monad m =>
(i -> ConduitT i o m r) -> ConduitT i o m ()
awaitForever FilePath -> ConduitT FilePath Text (ResourceT IO) ()
forall (m :: * -> *) a.
(MonadResource m, MonadThrow m) =>
FilePath -> ConduitM a Text m ()
readUTFFile
ConduitT FilePath Text (ResourceT IO) ()
-> ConduitM Text Void (ResourceT IO) Text
-> ConduitM FilePath Void (ResourceT IO) Text
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM Text Void (ResourceT IO) Text
forall (m :: * -> *) lazy strict o.
(Monad m, LazySequence lazy strict) =>
ConduitT strict o m lazy
sinkLazy
Text
ltext <- IO Text -> Q Text
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
$ Text -> IO Text
preProcess Text
texts
ByteString
bs <- IO ByteString -> Q ByteString
forall (m :: * -> *) a. Quasi m => IO a -> m a
qRunIO (IO ByteString -> Q ByteString) -> IO ByteString -> Q ByteString
forall a b. (a -> b) -> a -> b
$ [FilePath] -> ByteString -> IO ByteString
postProcess [FilePath]
fps (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TLE.encodeUtf8 Text
ltext
let hash' :: FilePath
hash' = ByteString -> FilePath
base64md5 ByteString
bs
suffix :: FilePath
suffix = FilePath
csCombinedFolder FilePath -> ShowS
</> FilePath
hash' FilePath -> ShowS
<.> FilePath
extension
fp :: FilePath
fp = FilePath
csStaticDir FilePath -> ShowS
</> FilePath
suffix
IO () -> Q ()
forall (m :: * -> *) a. Quasi m => IO a -> m a
qRunIO (IO () -> Q ()) -> IO () -> Q ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ ShowS
takeDirectory FilePath
fp
FilePath -> ByteString -> IO ()
L.writeFile FilePath
fp ByteString
bs
let pieces :: [FilePath]
pieces = (Text -> FilePath) -> [Text] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Text -> FilePath
T.unpack ([Text] -> [FilePath]) -> [Text] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text]
T.splitOn "/" (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
suffix
[|StaticRoute (map pack pieces) []|]
where
fps :: [FilePath]
fps :: [FilePath]
fps = (Route Static -> FilePath) -> [Route Static] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Route Static -> FilePath
toFP [Route Static]
routes
toFP :: Route Static -> FilePath
toFP (StaticRoute pieces _) = FilePath
csStaticDir FilePath -> ShowS
</> [FilePath] -> FilePath
F.joinPath ((Text -> FilePath) -> [Text] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Text -> FilePath
T.unpack [Text]
pieces)
readUTFFile :: FilePath -> ConduitM a Text m ()
readUTFFile fp :: FilePath
fp = FilePath -> ConduitT a ByteString m ()
forall (m :: * -> *) i.
MonadResource m =>
FilePath -> ConduitT i ByteString m ()
sourceFile FilePath
fp ConduitT a ByteString m ()
-> ConduitM ByteString Text m () -> ConduitM a Text m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM ByteString Text m ()
forall (m :: * -> *). MonadThrow m => ConduitT ByteString Text m ()
decodeUtf8C
postProcess :: [FilePath] -> ByteString -> IO ByteString
postProcess =
case CombineType
combineType of
JS -> [FilePath] -> ByteString -> IO ByteString
csJsPostProcess
CSS -> [FilePath] -> ByteString -> IO ByteString
csCssPostProcess
preProcess :: Text -> IO Text
preProcess =
case CombineType
combineType of
JS -> Text -> IO Text
csJsPreProcess
CSS -> Text -> IO Text
csCssPreProcess
extension :: FilePath
extension =
case CombineType
combineType of
JS -> "js"
CSS -> "css"
data CombineSettings = CombineSettings
{ CombineSettings -> FilePath
csStaticDir :: FilePath
, CombineSettings -> [FilePath] -> ByteString -> IO ByteString
csCssPostProcess :: [FilePath] -> L.ByteString -> IO L.ByteString
, CombineSettings -> [FilePath] -> ByteString -> IO ByteString
csJsPostProcess :: [FilePath] -> L.ByteString -> IO L.ByteString
, CombineSettings -> Text -> IO Text
csCssPreProcess :: TL.Text -> IO TL.Text
, CombineSettings -> Text -> IO Text
csJsPreProcess :: TL.Text -> IO TL.Text
, CombineSettings -> FilePath
csCombinedFolder :: FilePath
}
instance Default CombineSettings where
def :: CombineSettings
def = CombineSettings :: FilePath
-> ([FilePath] -> ByteString -> IO ByteString)
-> ([FilePath] -> ByteString -> IO ByteString)
-> (Text -> IO Text)
-> (Text -> IO Text)
-> FilePath
-> CombineSettings
CombineSettings
{ csStaticDir :: FilePath
csStaticDir = "static"
, csCssPostProcess :: [FilePath] -> ByteString -> IO ByteString
csCssPostProcess = (ByteString -> IO ByteString)
-> [FilePath] -> ByteString -> IO ByteString
forall a b. a -> b -> a
const ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return
, csJsPostProcess :: [FilePath] -> ByteString -> IO ByteString
csJsPostProcess = (ByteString -> IO ByteString)
-> [FilePath] -> ByteString -> IO ByteString
forall a b. a -> b -> a
const ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return
, csCssPreProcess :: Text -> IO Text
csCssPreProcess =
Text -> IO Text
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
. Text -> Text -> Text -> Text
TL.replace "'/static/" "'../"
(Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
TL.replace "\"/static/" "\"../"
, csJsPreProcess :: Text -> IO Text
csJsPreProcess = Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return
, csCombinedFolder :: FilePath
csCombinedFolder = "combined"
}
liftRoutes :: [Route Static] -> Q Exp
liftRoutes :: [Route Static] -> Q Exp
liftRoutes =
([Exp] -> Exp) -> Q [Exp] -> Q Exp
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)
mapM Route Static -> Q Exp
go
where
go :: Route Static -> Q Exp
go :: Route Static -> Q Exp
go (StaticRoute x y) = [|StaticRoute $(liftTexts x) $(liftPairs y)|]
liftTexts :: [Text] -> Q Exp
liftTexts = ([Exp] -> Exp) -> Q [Exp] -> Q Exp
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)
mapM Text -> Q Exp
liftT
liftT :: Text -> Q Exp
liftT t :: Text
t = [|pack $(TH.lift $ T.unpack t)|]
liftPairs :: [(Text, Text)] -> Q Exp
liftPairs = ([Exp] -> Exp) -> Q [Exp] -> Q Exp
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)
mapM (Text, Text) -> Q Exp
liftPair
liftPair :: (Text, Text) -> Q Exp
liftPair (x :: Text
x, y :: Text
y) = [|($(liftT x), $(liftT y))|]
combineStylesheets' :: Bool
-> CombineSettings
-> Name
-> [Route Static]
-> Q Exp
combineStylesheets' :: Bool -> CombineSettings -> Name -> [Route Static] -> Q Exp
combineStylesheets' development :: Bool
development cs :: CombineSettings
cs con :: Name
con routes :: [Route Static]
routes
| Bool
development = [| mapM_ (addStylesheet . $(return $ ConE con)) $(liftRoutes routes) |]
| Bool
otherwise = [| addStylesheet $ $(return $ ConE con) $(combineStatics' CSS cs routes) |]
combineScripts' :: Bool
-> CombineSettings
-> Name
-> [Route Static]
-> Q Exp
combineScripts' :: Bool -> CombineSettings -> Name -> [Route Static] -> Q Exp
combineScripts' development :: Bool
development cs :: CombineSettings
cs con :: Name
con routes :: [Route Static]
routes
| Bool
development = [| mapM_ (addScript . $(return $ ConE con)) $(liftRoutes routes) |]
| Bool
otherwise = [| addScript $ $(return $ ConE con) $(combineStatics' JS cs routes) |]