{-# 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 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 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 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 ([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
ParentRunner master
Route Static -> Route master
ysreToParentRoute :: forall sub parent.
YesodSubRunnerEnv sub parent -> Route sub -> Route parent
ysreParentRunner :: forall sub parent.
YesodSubRunnerEnv sub parent -> ParentRunner parent
ysreParentEnv :: forall sub parent.
YesodSubRunnerEnv sub parent -> YesodRunnerEnv parent
ysreGetSub :: forall sub parent. YesodSubRunnerEnv sub parent -> parent -> sub
ysreParentEnv :: YesodRunnerEnv master
ysreToParentRoute :: Route Static -> Route master
ysreGetSub :: master -> Static
ysreParentRunner :: ParentRunner master
..} 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 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 FilePath
"tmp" = Bool
False
notHidden FilePath
s =
case FilePath
s of
Char
'.':FilePath
_ -> Bool
False
FilePath
_ -> 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 FilePath
fp [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 FilePath
f = FilePath
fp FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'/' 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 (\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' 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 FilePath
s' -> FilePath -> StateT (Map FilePath FilePath) IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
s'
Maybe FilePath
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 FilePath
dir = FilePath -> Q [Dec]
mkStaticFiles FilePath
dir
staticFilesList :: FilePath -> [FilePath] -> Q [Dec]
staticFilesList :: FilePath -> [FilePath] -> Q [Dec]
staticFilesList FilePath
dir [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 FilePath
x =
let (FilePath
a, 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
== Char
'/') FilePath
x
in FilePath
a FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: FilePath -> [FilePath]
split (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 FilePath
b)
publicFiles :: FilePath -> Q [Dec]
publicFiles :: FilePath -> Q [Dec]
publicFiles 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 FilePath
fp 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 (FilePath
k, 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 FilePath
x =
let (FilePath
a, 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
== Char
'/') FilePath
x
in FilePath
a FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: FilePath -> [FilePath]
split (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 FilePath
b)
staticFilesMergeMap :: FilePath -> M.Map FilePath FilePath -> Q [Dec]
staticFilesMergeMap :: FilePath -> Map FilePath FilePath -> Q [Dec]
staticFilesMergeMap FilePath
fp 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 (FilePath
k, FilePath
v) = (FilePath -> [FilePath]
split FilePath
k, FilePath -> [FilePath]
split FilePath
v)
swap :: (b, a) -> (a, b)
swap (b
x, 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 FilePath
x =
let (FilePath
a, 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
== Char
'/') FilePath
x
in FilePath
a FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: FilePath -> [FilePath]
split (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
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 Map FilePath FilePath
iDict Map FilePath FilePath
st 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 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 [[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 [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 FilePath
a FilePath
b = FilePath
a FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'/' Char -> ShowS
forall a. a -> [a] -> [a]
: FilePath
b
cachedETagLookupDevel :: FilePath -> IO ETagLookup
cachedETagLookupDevel :: FilePath -> IO ETagLookup
cachedETagLookupDevel 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
$ \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
Maybe ByteString
Nothing -> Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
Just 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
Maybe EpochTime
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 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 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
$ (\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 FilePath
fp = FilePath -> Bool -> Q [Dec]
mkStaticFiles' FilePath
fp Bool
True
mkStaticFiles' :: FilePath
-> Bool
-> Q [Dec]
mkStaticFiles' :: FilePath -> Bool -> Q [Dec]
mkStaticFiles' FilePath
fp 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 FilePath
fp [[FilePath]]
fs 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' FilePath
fp [([FilePath], [FilePath])]
fs 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' 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 :: ([FilePath], [FilePath]) -> Q [Dec]
mkRoute ([FilePath]
alias, [FilePath]
f) = do
let name' :: FilePath
name' = FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"_" ([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 FilePath
"null-named file"
| Char -> Bool
isDigit (FilePath -> Char
forall a. [a] -> a
head FilePath
name') -> Char
'_' 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
'_' 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 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 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 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 Int
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 Char
'+' = Char
'-'
tr Char
'/' = Char
'_'
tr 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 CombineSettings {FilePath
[FilePath] -> ByteString -> IO ByteString
Text -> IO Text
csCombinedFolder :: FilePath
csJsPreProcess :: Text -> IO Text
csCssPreProcess :: Text -> IO Text
csJsPostProcess :: [FilePath] -> ByteString -> IO ByteString
csCssPostProcess :: [FilePath] -> ByteString -> IO ByteString
csStaticDir :: FilePath
csCombinedFolder :: CombineSettings -> FilePath
csJsPreProcess :: CombineSettings -> Text -> IO Text
csCssPreProcess :: CombineSettings -> Text -> IO Text
csJsPostProcess :: CombineSettings -> [FilePath] -> ByteString -> IO ByteString
csCssPostProcess :: CombineSettings -> [FilePath] -> ByteString -> IO ByteString
csStaticDir :: CombineSettings -> FilePath
..} [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 -> [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 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
CombineType
JS -> [FilePath] -> ByteString -> IO ByteString
csJsPostProcess
CombineType
CSS -> [FilePath] -> 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 :: FilePath
extension =
case CombineType
combineType of
CombineType
JS -> FilePath
"js"
CombineType
CSS -> FilePath
"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 = FilePath
"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 Text
"'/static/" Text
"'../"
(Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
TL.replace Text
"\"/static/" Text
"\"../"
, csJsPreProcess :: Text -> IO Text
csJsPreProcess = Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return
, csCombinedFolder :: FilePath
csCombinedFolder = FilePath
"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 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 (Text
x, Text
y) = [|($(liftT x), $(liftT y))|]
combineStylesheets' :: Bool
-> CombineSettings
-> Name
-> [Route Static]
-> Q Exp
combineStylesheets' :: Bool -> CombineSettings -> Name -> [Route Static] -> Q Exp
combineStylesheets' Bool
development CombineSettings
cs Name
con [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' Bool
development CombineSettings
cs Name
con [Route Static]
routes
| Bool
development = [| mapM_ (addScript . $(return $ ConE con)) $(liftRoutes routes) |]
| Bool
otherwise = [| addScript $ $(return $ ConE con) $(combineStatics' JS cs routes) |]