{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# Language QuasiQuotes #-}
module Yesod.Static.Streamly.Internal (
mkStaticFilesStreamly,
mkStaticFilesStreamly',
mkStaticFilesListStreamly,
mkStaticFilesListStreamly',
cachedETagLookupDevelStreamly,
cachedETagLookupStreamly,
mkHashMapStreamly,
notHiddenStreamly,
getFileListPiecesStreamly,
pathFromRawPiecesStreamly,
CombineTypeStreamly(..),
CombineSettingsStreamly(..),
liftRoutesStreamly,
combineStaticsStreamly',
base64md5FileStreamly,
base64md5Streamly,
base64Streamly,
hashFileStreamly,
sinkHashStreamly
) where
import Control.Monad.State.Strict
import "cryptonite" Crypto.Hash (hashlazy,Digest,MD5)
import "cryptonite" Crypto.Hash.IO (HashAlgorithm)
import qualified Data.ByteArray as ByteArray
import Data.ByteString as B (ByteString)
import Data.ByteString.Lazy as L (ByteString,concat,writeFile)
import qualified Data.ByteString.Base64
import qualified Data.ByteString.Char8 as S8
import Data.Char (isLower,isDigit)
import Data.Default
import Data.IORef (readIORef,newIORef,writeIORef)
import Data.List (foldl',intercalate,sort)
import qualified Data.Map as M
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TLE
import Language.Haskell.TH
import Language.Haskell.TH.Syntax as TH
import qualified Streamly.Data.Stream as S
import Streamly.External.ByteString.Lazy as StreamlyLByteString (fromChunksIO)
import Streamly.Internal.FileSystem.File as StreamlyInternalFile (chunkReaderWith)
import Streamly.Internal.System.IO (arrayPayloadSize)
import System.Directory (createDirectoryIfMissing,doesDirectoryExist,doesFileExist,getDirectoryContents)
import System.FilePath ((</>), (<.>), takeDirectory)
import qualified System.FilePath as F
import System.PosixCompat.Files (getFileStatus,modificationTime)
import System.Posix.Types (EpochTime)
import WaiAppStatic.Storage.Filesystem (ETagLookup)
import Yesod.Static
mkStaticFilesStreamly :: FilePath
-> Int
-> Q [Dec]
mkStaticFilesStreamly :: String -> Int -> Q [Dec]
mkStaticFilesStreamly String
fp Int
size = String -> Bool -> Int -> Q [Dec]
mkStaticFilesStreamly' String
fp Bool
True Int
size
mkStaticFilesStreamly' :: FilePath
-> Bool
-> Int
-> Q [Dec]
mkStaticFilesStreamly' :: String -> Bool -> Int -> Q [Dec]
mkStaticFilesStreamly' String
fp Bool
makeHash Int
size = do
[[String]]
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]]
getFileListPiecesStreamly String
fp
String -> [[String]] -> Bool -> Int -> Q [Dec]
mkStaticFilesListStreamly String
fp [[String]]
fs Bool
makeHash Int
size
mkStaticFilesListStreamly :: FilePath
-> [[String]]
-> Bool
-> Int
-> Q [Dec]
mkStaticFilesListStreamly :: String -> [[String]] -> Bool -> Int -> Q [Dec]
mkStaticFilesListStreamly String
fp [[String]]
fs Bool
makeHash Int
size = String -> [([String], [String])] -> Bool -> Int -> Q [Dec]
mkStaticFilesListStreamly' String
fp ([[String]] -> [[String]] -> [([String], [String])]
forall a b. [a] -> [b] -> [(a, b)]
zip [[String]]
fs [[String]]
fs) Bool
makeHash Int
size
mkStaticFilesListStreamly' :: FilePath
-> [([String], [String])]
-> Bool
-> Int
-> Q [Dec]
mkStaticFilesListStreamly' :: String -> [([String], [String])] -> Bool -> Int -> Q [Dec]
mkStaticFilesListStreamly' String
fp [([String], [String])]
fs Bool
makeHash Int
size =
[[Dec]] -> [Dec]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
Prelude.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]
Data.List.intercalate String
"_" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Char) -> String -> String
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
Prelude.null String
name' -> String -> String
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 -> String -> String
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 -> String -> String
forall a. a -> [a] -> [a]
: String
name'
Exp
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)|]
Exp
qs <- if Bool
makeHash
then do String
hash <- 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 -> Int -> IO String
base64md5FileStreamly (String -> [String] -> String
pathFromRawPiecesStreamly String
fp [String]
f)
Int
size
[|[(pack "etag",pack $(String -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => String -> m Exp
TH.lift String
hash))]|]
else 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
$ [Exp] -> Exp
ListE []
[Dec] -> Q [Dec]
forall a. a -> Q a
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) []
]
]
cachedETagLookupDevelStreamly :: FilePath
-> Int
-> IO ETagLookup
cachedETagLookupDevelStreamly :: String -> Int -> IO ETagLookup
cachedETagLookupDevelStreamly String
dir Int
size = do
Map String ByteString
etags <- String -> Int -> IO (Map String ByteString)
mkHashMapStreamly String
dir
Int
size
IORef (Map String EpochTime)
mtimeVar <- Map String EpochTime -> IO (IORef (Map String EpochTime))
forall a. a -> IO (IORef a)
newIORef (Map String EpochTime
forall k a. Map k a
M.empty :: M.Map FilePath EpochTime)
ETagLookup -> IO ETagLookup
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ETagLookup -> IO ETagLookup) -> ETagLookup -> IO ETagLookup
forall a b. (a -> b) -> a -> b
$ \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
FileStatus
fs <- String -> IO FileStatus
getFileStatus String
f
let newt :: EpochTime
newt = FileStatus -> EpochTime
modificationTime FileStatus
fs
Map String EpochTime
mtimes <- IORef (Map String EpochTime) -> IO (Map String EpochTime)
forall a. IORef a -> IO a
readIORef IORef (Map String EpochTime)
mtimeVar
EpochTime
oldt <- case String -> Map String EpochTime -> Maybe EpochTime
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
f Map String EpochTime
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
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
$ 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
cachedETagLookupStreamly :: FilePath
-> Int
-> IO ETagLookup
cachedETagLookupStreamly :: String -> Int -> IO ETagLookup
cachedETagLookupStreamly String
dir Int
size = do
Map String ByteString
etags <- String -> Int -> IO (Map String ByteString)
mkHashMapStreamly String
dir
Int
size
ETagLookup -> IO ETagLookup
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ETagLookup -> IO ETagLookup) -> ETagLookup -> IO ETagLookup
forall a b. (a -> b) -> a -> b
$ (\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)
mkHashMapStreamly :: FilePath
-> Int
-> IO (M.Map FilePath S8.ByteString)
mkHashMapStreamly :: String -> Int -> IO (Map String ByteString)
mkHashMapStreamly String
dir Int
size = do
[[String]]
fs <- String -> IO [[String]]
getFileListPiecesStreamly String
dir
[[String]] -> IO [(String, ByteString)]
hashAlist [[String]]
fs IO [(String, ByteString)]
-> ([(String, ByteString)] -> IO (Map String ByteString))
-> IO (Map String ByteString)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Map String ByteString -> IO (Map String ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map String ByteString -> IO (Map String ByteString))
-> ([(String, ByteString)] -> Map String ByteString)
-> [(String, ByteString)]
-> IO (Map String ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, ByteString)] -> Map String ByteString
forall k a. Ord k => [(k, a)] -> Map k a
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
pathFromRawPiecesStreamly String
dir [String]
pieces
String
h <- String -> Int -> IO String
base64md5FileStreamly String
file
Int
size
(String, ByteString) -> IO (String, ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
file,String -> ByteString
S8.pack String
h)
notHiddenStreamly :: FilePath
-> Bool
notHiddenStreamly :: String -> Bool
notHiddenStreamly String
"tmp" = Bool
False
notHiddenStreamly String
s =
case String
s of
Char
'.':String
_ -> Bool
False
String
_ -> Bool
True
getFileListPiecesStreamly :: FilePath
-> IO [[String]]
getFileListPiecesStreamly :: String -> IO [[String]]
getFileListPiecesStreamly = (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
[String]
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]
Prelude.filter String -> Bool
notHiddenStreamly) ([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 -> String
fullPath String
f = String
fp String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
'/' Char -> String -> String
forall a. a -> [a] -> [a]
: String
f
[String]
files <- 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 -> IO Bool) -> [String] -> IO [String]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (String -> IO Bool
doesFileExist (String -> IO Bool) -> (String -> String) -> String -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
fullPath) [String]
allContents
let files' :: [[String]]
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
[[String]]
files'' <- ([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 [[String]]
files'
[String]
dirs <- 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 -> IO Bool) -> [String] -> IO [String]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (String -> IO Bool
doesDirectoryExist (String -> IO Bool) -> (String -> String) -> String -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
fullPath) [String]
allContents
[[[String]]]
dirs' <- (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
f -> String
-> ([String] -> [String])
-> StateT (Map String String) IO [[String]]
go (String -> String
fullPath String
f) ([String] -> [String]
front ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) String
f)) [String]
dirs
[[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]] -> StateT (Map String String) IO [[String]])
-> [[String]] -> StateT (Map String String) IO [[String]]
forall a b. (a -> b) -> a -> b
$ [[[String]]] -> [[String]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
Prelude.concat ([[[String]]] -> [[String]]) -> [[[String]]] -> [[String]]
forall a b. (a -> b) -> a -> b
$ [[String]]
files'' [[String]] -> [[[String]]] -> [[[String]]]
forall a. a -> [a] -> [a]
: [[[String]]]
dirs'
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
Map String String
m <- StateT (Map String String) IO (Map String String)
forall s (m :: * -> *). MonadState s m => m s
get
case String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
s Map String String
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 s (m :: * -> *). MonadState s m => 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
pathFromRawPiecesStreamly :: FilePath
-> [String]
-> FilePath
pathFromRawPiecesStreamly :: String -> [String] -> String
pathFromRawPiecesStreamly =
(String -> String -> String) -> 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 -> String -> String
append
where
append :: String -> String -> String
append String
a String
b = String
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
'/' Char -> String -> String
forall a. a -> [a] -> [a]
: String
b
data CombineTypeStreamly = JS | CSS
data CombineSettingsStreamly = CombineSettingsStreamly
{ CombineSettingsStreamly -> String
csStaticDir :: FilePath
, CombineSettingsStreamly -> [String] -> ByteString -> IO ByteString
csCssPostProcess :: [FilePath] -> L.ByteString -> IO L.ByteString
, CombineSettingsStreamly -> [String] -> ByteString -> IO ByteString
csJsPostProcess :: [FilePath] -> L.ByteString -> IO L.ByteString
, CombineSettingsStreamly -> Text -> IO Text
csCssPreProcess :: TL.Text -> IO TL.Text
, CombineSettingsStreamly -> Text -> IO Text
csJsPreProcess :: TL.Text -> IO TL.Text
, CombineSettingsStreamly -> String
csCombinedFolder :: FilePath
}
instance Default CombineSettingsStreamly where
def :: CombineSettingsStreamly
def = CombineSettingsStreamly
{ csStaticDir :: String
csStaticDir = String
"static"
, 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
, 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"
}
liftRoutesStreamly :: [Route Static]
-> Q Exp
liftRoutesStreamly :: [Route Static] -> Q Exp
liftRoutesStreamly =
([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))|]
combineStaticsStreamly' :: CombineTypeStreamly
-> CombineSettingsStreamly
-> [Route Static]
-> Int
-> Q Exp
combineStaticsStreamly' :: CombineTypeStreamly
-> CombineSettingsStreamly -> [Route Static] -> Int -> Q Exp
combineStaticsStreamly' CombineTypeStreamly
combineType CombineSettingsStreamly {String
[String] -> ByteString -> IO ByteString
Text -> IO Text
csStaticDir :: CombineSettingsStreamly -> String
csCssPostProcess :: CombineSettingsStreamly -> [String] -> ByteString -> IO ByteString
csJsPostProcess :: CombineSettingsStreamly -> [String] -> ByteString -> IO ByteString
csCssPreProcess :: CombineSettingsStreamly -> Text -> IO Text
csJsPreProcess :: CombineSettingsStreamly -> Text -> IO Text
csCombinedFolder :: CombineSettingsStreamly -> 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 Int
size = do
[ByteString]
texts <- IO [ByteString] -> Q [ByteString]
forall a. IO a -> Q a
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
$ (String -> IO ByteString) -> [String] -> IO [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
fp -> do let lazyfile :: Stream IO (Array Word8)
lazyfile = Unfold IO (Int, String) (Array Word8)
-> (Int, String) -> Stream IO (Array Word8)
forall (m :: * -> *) a b.
Applicative m =>
Unfold m a b -> a -> Stream m b
S.unfold Unfold IO (Int, String) (Array Word8)
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
Unfold m (Int, String) (Array Word8)
StreamlyInternalFile.chunkReaderWith (Int -> Int
arrayPayloadSize (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024),String
fp)
ByteString
lazybs <- IO ByteString -> IO ByteString
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> IO ByteString) -> IO ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Stream IO (Array Word8) -> IO ByteString
StreamlyLByteString.fromChunksIO Stream IO (Array Word8)
lazyfile
ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
lazybs
)
[String]
fps
let textss :: ByteString
textss = [ByteString] -> ByteString
L.concat [ByteString]
texts
let textsss :: Text
textsss = ByteString -> Text
TLE.decodeUtf8 ByteString
textss
Text
ltext <- 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
$ Text -> IO Text
preProcess Text
textsss
ByteString
bs <- IO ByteString -> Q ByteString
forall a. IO a -> Q a
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
$ [String] -> ByteString -> IO ByteString
postProcess [String]
fps (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TLE.encodeUtf8 Text
ltext
let hash' :: String
hash' = ByteString -> String
base64md5Streamly ByteString
bs
suffix :: String
suffix = String
csCombinedFolder String -> String -> String
</> String
hash' String -> String -> String
<.> String
extension
fp :: String
fp = String
csStaticDir String -> String -> String
</> String
suffix
IO () -> Q ()
forall a. IO a -> Q a
forall (m :: * -> *) a. Quasi m => IO a -> m a
qRunIO (IO () -> Q ()) -> IO () -> Q ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
takeDirectory String
fp
String -> ByteString -> IO ()
L.writeFile String
fp ByteString
bs
let pieces :: [String]
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 -> String -> String
</> [String] -> String
F.joinPath ((Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack [Text]
pieces)
postProcess :: [String] -> ByteString -> IO ByteString
postProcess =
case CombineTypeStreamly
combineType of
CombineTypeStreamly
JS -> [String] -> ByteString -> IO ByteString
csJsPostProcess
CombineTypeStreamly
CSS -> [String] -> ByteString -> IO ByteString
csCssPostProcess
preProcess :: Text -> IO Text
preProcess =
case CombineTypeStreamly
combineType of
CombineTypeStreamly
JS -> Text -> IO Text
csJsPreProcess
CombineTypeStreamly
CSS -> Text -> IO Text
csCssPreProcess
extension :: String
extension =
case CombineTypeStreamly
combineType of
CombineTypeStreamly
JS -> String
"js"
CombineTypeStreamly
CSS -> String
"css"
base64md5FileStreamly :: FilePath
-> Int
-> IO String
base64md5FileStreamly :: String -> Int -> IO String
base64md5FileStreamly String
fp Int
size = (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
base64Streamly (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) -> IO (Digest MD5) -> IO String
forall a b. (a -> b) -> a -> b
$ (String -> Int -> IO (Digest MD5)
forall (m :: * -> *) hash.
(MonadIO m, HashAlgorithm hash) =>
String -> Int -> m (Digest hash)
hashFileStreamly String
fp Int
size)
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 :: Crypto.Hash.Digest MD5)
base64md5Streamly :: L.ByteString
-> String
base64md5Streamly :: ByteString -> String
base64md5Streamly ByteString
lbs = do
let hashedlbs :: Digest MD5
hashedlbs = ByteString -> Digest MD5
forall a. HashAlgorithm a => ByteString -> Digest a
hashlazy ByteString
lbs
ByteString -> String
base64Streamly (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ Digest MD5 -> ByteString
forall {bout}. ByteArray bout => Digest MD5 -> bout
encode Digest MD5
hashedlbs
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)
base64Streamly :: B.ByteString
-> String
base64Streamly :: ByteString -> String
base64Streamly = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
tr
(String -> String)
-> (ByteString -> String) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
Prelude.take Int
8
(String -> String)
-> (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
hashFileStreamly :: ( MonadIO m
, Crypto.Hash.IO.HashAlgorithm hash
)
=> FilePath
-> Int
-> m (Crypto.Hash.Digest hash)
hashFileStreamly :: forall (m :: * -> *) hash.
(MonadIO m, HashAlgorithm hash) =>
String -> Int -> m (Digest hash)
hashFileStreamly String
fp Int
size = do
let lazyfile :: Stream IO (Array Word8)
lazyfile = Unfold IO (Int, String) (Array Word8)
-> (Int, String) -> Stream IO (Array Word8)
forall (m :: * -> *) a b.
Applicative m =>
Unfold m a b -> a -> Stream m b
S.unfold Unfold IO (Int, String) (Array Word8)
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
Unfold m (Int, String) (Array Word8)
StreamlyInternalFile.chunkReaderWith (Int -> Int
arrayPayloadSize (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024),String
fp)
ByteString
lazyfilef <- IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Stream IO (Array Word8) -> IO ByteString
StreamlyLByteString.fromChunksIO Stream IO (Array Word8)
lazyfile
ByteString -> m (Digest hash)
forall (m :: * -> *) hash.
(Monad m, HashAlgorithm hash) =>
ByteString -> m (Digest hash)
sinkHashStreamly ByteString
lazyfilef
sinkHashStreamly :: ( Monad m
, Crypto.Hash.IO.HashAlgorithm hash
)
=> L.ByteString
-> m (Crypto.Hash.Digest hash)
sinkHashStreamly :: forall (m :: * -> *) hash.
(Monad m, HashAlgorithm hash) =>
ByteString -> m (Digest hash)
sinkHashStreamly ByteString
blcontent = Digest hash -> m (Digest hash)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Digest hash -> m (Digest hash)) -> Digest hash -> m (Digest hash)
forall a b. (a -> b) -> a -> b
$ ByteString -> Digest hash
forall a. HashAlgorithm a => ByteString -> Digest a
hashlazy ByteString
blcontent