{-# 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,
base64md5FileStreamly,
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)
import qualified Data.ByteString.Base64
import qualified Data.ByteString.Char8 as S8
import Data.Char (isLower,isDigit)
import Data.IORef (readIORef,newIORef,writeIORef)
import Data.List (foldl',intercalate,sort)
import qualified Data.Map as M
import Data.Text (pack)
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 (doesDirectoryExist,doesFileExist,getDirectoryContents)
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 :: FilePath -> Int -> Q [Dec]
mkStaticFilesStreamly FilePath
fp Int
size = FilePath -> Bool -> Int -> Q [Dec]
mkStaticFilesStreamly' FilePath
fp Bool
True Int
size
mkStaticFilesStreamly' :: FilePath
-> Bool
-> Int
-> Q [Dec]
mkStaticFilesStreamly' :: FilePath -> Bool -> Int -> Q [Dec]
mkStaticFilesStreamly' FilePath
fp Bool
makeHash Int
size = do
[[FilePath]]
fs <- IO [[FilePath]] -> Q [[FilePath]]
forall a. IO a -> Q a
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]]
getFileListPiecesStreamly FilePath
fp
FilePath -> [[FilePath]] -> Bool -> Int -> Q [Dec]
mkStaticFilesListStreamly FilePath
fp [[FilePath]]
fs Bool
makeHash Int
size
mkStaticFilesListStreamly :: FilePath
-> [[String]]
-> Bool
-> Int
-> Q [Dec]
mkStaticFilesListStreamly :: FilePath -> [[FilePath]] -> Bool -> Int -> Q [Dec]
mkStaticFilesListStreamly FilePath
fp [[FilePath]]
fs Bool
makeHash Int
size = FilePath -> [([FilePath], [FilePath])] -> Bool -> Int -> Q [Dec]
mkStaticFilesListStreamly' FilePath
fp ([[FilePath]] -> [[FilePath]] -> [([FilePath], [FilePath])]
forall a b. [a] -> [b] -> [(a, b)]
zip [[FilePath]]
fs [[FilePath]]
fs) Bool
makeHash Int
size
mkStaticFilesListStreamly' :: FilePath
-> [([String], [String])]
-> Bool
-> Int
-> Q [Dec]
mkStaticFilesListStreamly' :: FilePath -> [([FilePath], [FilePath])] -> Bool -> Int -> Q [Dec]
mkStaticFilesListStreamly' FilePath
fp [([FilePath], [FilePath])]
fs Bool
makeHash Int
size =
[[Dec]] -> [Dec]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Dec]] -> [Dec]) -> Q [[Dec]] -> Q [Dec]
forall a b. (a -> b) -> Q a -> Q b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (([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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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]
Data.List.intercalate FilePath
"_" ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Char) -> FilePath -> FilePath
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 a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null FilePath
name' -> FilePath -> FilePath
forall a. HasCallStack => FilePath -> a
error FilePath
"null-named file"
| Char -> Bool
isDigit (FilePath -> Char
forall a. HasCallStack => [a] -> a
head FilePath
name') -> Char
'_' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
name'
| Char -> Bool
isLower (FilePath -> Char
forall a. HasCallStack => [a] -> a
head FilePath
name') -> FilePath
name'
| Bool
otherwise -> Char
'_' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
name'
Exp
f' <- [|map pack $([FilePath] -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => [FilePath] -> m Exp
TH.lift [FilePath]
f)|]
Exp
qs <- if Bool
makeHash
then do FilePath
hash <- IO FilePath -> Q FilePath
forall a. IO a -> Q a
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 -> Int -> IO FilePath
base64md5FileStreamly (FilePath -> [FilePath] -> FilePath
pathFromRawPiecesStreamly FilePath
fp [FilePath]
f)
Int
size
[|[(pack "etag",pack $(FilePath -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => FilePath -> m Exp
TH.lift FilePath
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 :: FilePath -> Int -> IO ETagLookup
cachedETagLookupDevelStreamly FilePath
dir Int
size = do
Map FilePath ByteString
etags <- FilePath -> Int -> IO (Map FilePath ByteString)
mkHashMapStreamly FilePath
dir
Int
size
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 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
$ \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 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 <- 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 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 :: FilePath -> Int -> IO ETagLookup
cachedETagLookupStreamly FilePath
dir Int
size = do
Map FilePath ByteString
etags <- FilePath -> Int -> IO (Map FilePath ByteString)
mkHashMapStreamly FilePath
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
$ (\FilePath
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
$ 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)
mkHashMapStreamly :: FilePath
-> Int
-> IO (M.Map FilePath S8.ByteString)
mkHashMapStreamly :: FilePath -> Int -> IO (Map FilePath ByteString)
mkHashMapStreamly FilePath
dir Int
size = do
[[FilePath]]
fs <- FilePath -> IO [[FilePath]]
getFileListPiecesStreamly FilePath
dir
[[FilePath]] -> IO [(FilePath, ByteString)]
hashAlist [[FilePath]]
fs IO [(FilePath, ByteString)]
-> ([(FilePath, ByteString)] -> IO (Map FilePath ByteString))
-> IO (Map FilePath 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 FilePath ByteString -> IO (Map FilePath ByteString)
forall a. a -> IO a
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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
pathFromRawPiecesStreamly FilePath
dir [FilePath]
pieces
FilePath
h <- FilePath -> Int -> IO FilePath
base64md5FileStreamly FilePath
file
Int
size
(FilePath, ByteString) -> IO (FilePath, ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
file,FilePath -> ByteString
S8.pack FilePath
h)
notHiddenStreamly :: FilePath
-> Bool
notHiddenStreamly :: FilePath -> Bool
notHiddenStreamly FilePath
"tmp" = Bool
False
notHiddenStreamly FilePath
s =
case FilePath
s of
Char
'.':FilePath
_ -> Bool
False
FilePath
_ -> Bool
True
getFileListPiecesStreamly :: FilePath
-> IO [[String]]
getFileListPiecesStreamly :: FilePath -> IO [[FilePath]]
getFileListPiecesStreamly = (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 a. IO a -> StateT (Map FilePath FilePath) IO a
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]
Prelude.filter FilePath -> Bool
notHiddenStreamly) ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` FilePath -> IO [FilePath]
getDirectoryContents FilePath
fp
let fullPath :: String -> String
fullPath :: FilePath -> FilePath
fullPath FilePath
f = FilePath
fp FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Char
'/' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
f
[FilePath]
files <- IO [FilePath] -> StateT (Map FilePath FilePath) IO [FilePath]
forall a. IO a -> StateT (Map FilePath FilePath) IO a
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)
-> (FilePath -> FilePath) -> FilePath -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
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 a. a -> [a]
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [FilePath] -> StateT (Map FilePath FilePath) IO [FilePath]
dedupe [[FilePath]]
files'
[FilePath]
dirs <- IO [FilePath] -> StateT (Map FilePath FilePath) IO [FilePath]
forall a. IO a -> StateT (Map FilePath FilePath) IO a
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)
-> (FilePath -> FilePath) -> FilePath -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\FilePath
f -> FilePath
-> ([FilePath] -> [FilePath])
-> StateT (Map FilePath FilePath) IO [[FilePath]]
go (FilePath -> FilePath
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 a. a -> StateT (Map FilePath FilePath) IO a
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 s (m :: * -> *). MonadState s m => 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 a. a -> StateT (Map FilePath FilePath) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
s'
Maybe FilePath
Nothing -> do Map FilePath FilePath -> StateT (Map FilePath FilePath) IO ()
forall s (m :: * -> *). MonadState s m => 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 a. a -> StateT (Map FilePath FilePath) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
s
pathFromRawPiecesStreamly :: FilePath
-> [String]
-> FilePath
pathFromRawPiecesStreamly :: FilePath -> [FilePath] -> FilePath
pathFromRawPiecesStreamly =
(FilePath -> FilePath -> FilePath)
-> FilePath -> [FilePath] -> FilePath
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' FilePath -> FilePath -> FilePath
append
where
append :: FilePath -> FilePath -> FilePath
append FilePath
a FilePath
b = FilePath
a FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Char
'/' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
b
base64md5FileStreamly :: FilePath
-> Int
-> IO String
base64md5FileStreamly :: FilePath -> Int -> IO FilePath
base64md5FileStreamly FilePath
fp Int
size = (Digest MD5 -> FilePath) -> IO (Digest MD5) -> IO FilePath
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> FilePath
base64Streamly (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) -> IO (Digest MD5) -> IO FilePath
forall a b. (a -> b) -> a -> b
$ (FilePath -> Int -> IO (Digest MD5)
forall (m :: * -> *) hash.
(MonadIO m, HashAlgorithm hash) =>
FilePath -> Int -> m (Digest hash)
hashFileStreamly FilePath
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)
base64Streamly :: B.ByteString
-> String
base64Streamly :: ByteString -> FilePath
base64Streamly = (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
tr
(FilePath -> FilePath)
-> (ByteString -> FilePath) -> ByteString -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
Prelude.take Int
8
(FilePath -> FilePath)
-> (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
hashFileStreamly :: ( MonadIO m
, Crypto.Hash.IO.HashAlgorithm hash
)
=> FilePath
-> Int
-> m (Crypto.Hash.Digest hash)
hashFileStreamly :: forall (m :: * -> *) hash.
(MonadIO m, HashAlgorithm hash) =>
FilePath -> Int -> m (Digest hash)
hashFileStreamly FilePath
fp Int
size = do
let lazyfile :: Stream IO (Array Word8)
lazyfile = Unfold IO (Int, FilePath) (Array Word8)
-> (Int, FilePath) -> Stream IO (Array Word8)
forall (m :: * -> *) a b.
Applicative m =>
Unfold m a b -> a -> Stream m b
S.unfold Unfold IO (Int, FilePath) (Array Word8)
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
Unfold m (Int, FilePath) (Array Word8)
StreamlyInternalFile.chunkReaderWith (Int -> Int
arrayPayloadSize (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024),FilePath
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