{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE OverloadedLists   #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports    #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# Language QuasiQuotes       #-}

-- |
-- Module      :  Yesod.Static.Streamly.Internal
-- Copyright   :  (c) Matthew Mosior 2023
-- License     :  BSD-style
-- Maintainer  :  mattm.github@gmail.com
-- Portability :  portable
--
-- = WARNING
--
-- This module is considered __internal__.
--
-- The Package Versioning Policy __does not apply__.
--
-- The contents of this module may change __in any way whatsoever__
-- and __without any warning__ between minor versions of this package.
--
-- Authors importing this library are expected to track development
-- closely.
--
-- All credit goes to the author(s)/maintainer(s) of the
-- [containers](https://hackage.haskell.org/package/containers) library
-- for the above warning text.
--
-- = Description
--
-- This library utilizes [Streamly](https://hackage.haskell.org/package/streamly-core)'s superb performance characteristics to replace some of [Yesod](https://hackage.haskell.org/package/yesod)'s functionality with streamly-based functionality.

module Yesod.Static.Streamly.Internal ( -- * Yesod.Static Replacement functions
                                        mkStaticFilesStreamly,
                                        mkStaticFilesStreamly',
                                        mkStaticFilesListStreamly,
                                        mkStaticFilesListStreamly',
                                        cachedETagLookupStreamly,
                                        mkHashMapStreamly,
                                        notHiddenStreamly,
                                        getFileListPiecesStreamly,
                                        pathFromRawPiecesStreamly,
                                        base64md5FileStreamly,
                                        base64Streamly,
                                        hashFileStreamly,
                                        sinkHashStreamly
                                      ) where

import Control.Monad.Trans.Control (MonadBaseControl)
import Control.Monad.State.Lazy
import "cryptonite" Crypto.Hash (hash,Digest,MD5)
import "cryptonite" Crypto.Hash.IO (HashAlgorithm)
import qualified Data.ByteArray as ByteArray
import Data.ByteString as B (ByteString)
import qualified Data.ByteString.Base64
import qualified Data.ByteString.Char8 as S8
import Data.Char (isLower,isDigit)
import Data.List (foldl',intercalate,sort)
import qualified Data.Map as M
import Language.Haskell.TH
import Language.Haskell.TH.Syntax as TH
import qualified Streamly.Data.Stream as S
import Streamly.Data.Stream.Prelude as StreamlyPrelude
import qualified Streamly.Data.Fold as Fold
import Streamly.External.ByteString as StreamlyByteString
import Streamly.FileSystem.Handle as StreamlyFile (chunkReader)
import Streamly.Internal.Data.Stream.Concurrent.Channel (defaultConfig)
import Streamly.Internal.Data.Stream.MkType (MonadThrow)
import System.Directory (doesDirectoryExist,doesFileExist,getDirectoryContents)
import System.IO (openFile,IOMode(ReadMode))
import WaiAppStatic.Storage.Filesystem (ETagLookup)
import Yesod.Static

-- | A replacement of
-- [mkStaticFiles](https://hackage.haskell.org/package/yesod-static-1.6.1.0/docs/src/Yesod.Static.html#mkStaticFiles).
mkStaticFilesStreamly :: FilePath
                      -> Q [Dec]
mkStaticFilesStreamly :: FilePath -> Q [Dec]
mkStaticFilesStreamly FilePath
fp = FilePath -> Bool -> Q [Dec]
mkStaticFilesStreamly' FilePath
fp Bool
True

-- | A replacement of
-- [mkStaticFiles'](https://hackage.haskell.org/package/yesod-static-1.6.1.0/docs/src/Yesod.Static.html#mkStaticFiles').
mkStaticFilesStreamly' :: FilePath -- ^ static directory
                       -> Bool     -- ^ append checksum query parameter
                       -> Q [Dec]
mkStaticFilesStreamly' :: FilePath -> Bool -> Q [Dec]
mkStaticFilesStreamly' FilePath
fp Bool
makeHash = 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 -> Q [Dec]
mkStaticFilesListStreamly FilePath
fp [[FilePath]]
fs Bool
makeHash

-- | A replacement of
-- [mkStaticFilesList](https://hackage.haskell.org/package/yesod-static-1.6.1.0/docs/src/Yesod.Static.html#mkStaticFilesList).
mkStaticFilesListStreamly :: FilePath -- ^ static directory
                          -> [[String]] -- ^ list of files to create identifiers for
                          -> Bool     -- ^ append checksum query parameter
                          -> Q [Dec]
mkStaticFilesListStreamly :: FilePath -> [[FilePath]] -> Bool -> Q [Dec]
mkStaticFilesListStreamly FilePath
fp [[FilePath]]
fs Bool
makeHash = FilePath -> [([FilePath], [FilePath])] -> Bool -> Q [Dec]
mkStaticFilesListStreamly' FilePath
fp ([[FilePath]] -> [[FilePath]] -> [([FilePath], [FilePath])]
forall a b. [a] -> [b] -> [(a, b)]
zip [[FilePath]]
fs [[FilePath]]
fs) Bool
makeHash

-- | A replacement of
-- [mkStaticFilesList'](https://hackage.haskell.org/package/yesod-static-1.6.1.0/docs/src/Yesod.Static.html#mkStaticFilesList').
mkStaticFilesListStreamly' :: FilePath -- ^ static directory
                           -> [([String], [String])] -- ^ list of files to create identifiers for, where
                                                     -- the first argument of the tuple is the identifier
                                                     -- alias and the second is the actual file name
                           -> Bool     -- ^ append checksum query parameter
                           -> Q [Dec]
mkStaticFilesListStreamly' :: FilePath -> [([FilePath], [FilePath])] -> Bool -> Q [Dec]
mkStaticFilesListStreamly' 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 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]
Control.Monad.State.Lazy.mapM ([FilePath], [FilePath]) -> Q [Dec]
forall {b} {m :: * -> *}.
(Item b ~ Dec, Quote m, Quasi m, IsList b) =>
([FilePath], [FilePath]) -> m b
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]) -> m b
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
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] -> m 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 -> m FilePath
forall a. IO a -> m a
forall (m :: * -> *) a. Quasi m => IO a -> m a
qRunIO (IO FilePath -> m FilePath) -> IO FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
base64md5FileStreamly (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> FilePath
pathFromRawPiecesStreamly FilePath
fp [FilePath]
f
                              [|[(pack "etag", pack $(FilePath -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => FilePath -> m Exp
TH.lift FilePath
hash))]|]
                      else Exp -> m Exp
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> m Exp) -> Exp -> m Exp
forall a b. (a -> b) -> a -> b
$ [Exp] -> Exp
ListE []
          b -> m b
forall a. a -> m 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) []
                  ]
              ]

-- | A replacement of
-- [cachedETagLookup](https://hackage.haskell.org/package/yesod-static-1.6.1.0/docs/src/Yesod.Static.html#cachedETagLookup).
cachedETagLookupStreamly :: FilePath
                         -> IO ETagLookup
cachedETagLookupStreamly :: FilePath -> IO ETagLookup
cachedETagLookupStreamly FilePath
dir = do
  Map FilePath ByteString
etags <- FilePath -> IO (Map FilePath ByteString)
mkHashMapStreamly FilePath
dir
  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)

-- | A replacement of
-- [mkHashMap](https://hackage.haskell.org/package/yesod-static-1.6.1.0/docs/src/Yesod.Static.html#mkHashMap).
mkHashMapStreamly :: FilePath
                  -> IO (M.Map FilePath S8.ByteString)
mkHashMapStreamly :: FilePath -> IO (Map FilePath ByteString)
mkHashMapStreamly FilePath
dir = 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]
Control.Monad.State.Lazy.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 -> IO FilePath
base64md5FileStreamly FilePath
file
                                 (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)

-- | A replacement of
-- [notHidden](https://hackage.haskell.org/package/yesod-static-1.6.1.0/docs/src/Yesod.Static.html#notHidden).
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

-- | A replacement of
-- [getFileListPieces](https://hackage.haskell.org/package/yesod-static-1.6.1.0/docs/src/Yesod.Static.html#getFileListPieces).
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]
Control.Monad.State.Lazy.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]
Control.Monad.State.Lazy.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]
Control.Monad.State.Lazy.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]
Control.Monad.State.Lazy.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'
    
    -- Reuse data buffers for identical strings
    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]
Control.Monad.State.Lazy.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

-- | A replacement of
-- [pathFromRawPieces](https://hackage.haskell.org/package/yesod-static-1.6.1.0/docs/src/Yesod.Static.html#pathFromRawPieces).
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

-- | A replacement of
-- [base64md5File](https://hackage.haskell.org/package/yesod-static-1.6.1.0/docs/src/Yesod.Static.html#base64md5File).
base64md5FileStreamly :: FilePath
                      -> IO String
base64md5FileStreamly :: FilePath -> IO FilePath
base64md5FileStreamly = (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)
-> (FilePath -> IO (Digest MD5)) -> FilePath -> IO FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO (Digest MD5)
forall (m :: * -> *) hash.
(MonadBaseControl IO m, MonadThrow m, MonadIO m,
 HashAlgorithm hash) =>
FilePath -> m (Digest hash)
hashFileStreamly
    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)

-- | A replacement of
-- [base64](https://hackage.haskell.org/package/yesod-static-1.6.1.0/docs/src/Yesod.Static.html#base64).
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

-- | A more performant replacement of
-- [hashFile](https://hackage.haskell.org/package/cryptohash-conduit-0.1.1/docs/src/Crypto-Hash-Conduit.html#hashFile)
-- found in [Crypto.Hash.Conduit](https://hackage.haskell.org/package/cryptohash-conduit-0.1.1/docs/Crypto-Hash-Conduit.html).
hashFileStreamly :: ( MonadBaseControl IO m
                    , MonadThrow m
                    , MonadIO m
                    ,Crypto.Hash.IO.HashAlgorithm hash
                    )
                 => FilePath
                 -> m (Crypto.Hash.Digest hash)
hashFileStreamly :: forall (m :: * -> *) hash.
(MonadBaseControl IO m, MonadThrow m, MonadIO m,
 HashAlgorithm hash) =>
FilePath -> m (Digest hash)
hashFileStreamly FilePath
fp = do
  Handle
shandle <- IO Handle -> m Handle
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Handle -> m Handle) -> IO Handle -> m Handle
forall a b. (a -> b) -> a -> b
$ FilePath -> IOMode -> IO Handle
openFile FilePath
fp IOMode
ReadMode
  let lazyfile :: Stream m (Array Word8)
lazyfile  = Unfold m Handle (Array Word8) -> Handle -> Stream m (Array Word8)
forall (m :: * -> *) a b.
Applicative m =>
Unfold m a b -> a -> Stream m b
S.unfold Unfold m Handle (Array Word8)
forall (m :: * -> *). MonadIO m => Unfold m Handle (Array Word8)
StreamlyFile.chunkReader Handle
shandle
  let parconfig :: Config
parconfig = do let parconfigmaxthreads :: Config
parconfigmaxthreads              = Int -> Config -> Config
maxThreads (-Int
1) Config
defaultConfig
                     let parconfigmaxbufferandmaxthreads :: Config
parconfigmaxbufferandmaxthreads  = Int -> Config -> Config
maxBuffer  (-Int
1) Config
parconfigmaxthreads
                     Bool -> Config -> Config
eager Bool
True Config
parconfigmaxbufferandmaxthreads
  let lazyfilef :: Stream m ByteString
lazyfilef = (Config -> Config) -> Stream m ByteString -> Stream m ByteString
forall (m :: * -> *) a.
MonadAsync m =>
(Config -> Config) -> Stream m a -> Stream m a
StreamlyPrelude.parEval (Config -> Config -> Config
forall a b. a -> b -> a
const (Config -> Config -> Config)
-> (Config -> Config) -> Config -> Config -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Config
forall a. a -> a
id (Config -> Config -> Config) -> Config -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Config
parconfig)
                                          ((Array Word8 -> ByteString)
-> Stream m (Array Word8) -> Stream m ByteString
forall a b. (a -> b) -> Stream m a -> Stream m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Array Word8 -> ByteString
StreamlyByteString.fromArray Stream m (Array Word8)
lazyfile)
  ByteString
lazyfileff <- Fold m ByteString ByteString -> Stream m ByteString -> m ByteString
forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> Stream m a -> m b
S.fold ((ByteString -> ByteString -> ByteString)
-> ByteString -> Fold m ByteString ByteString
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> Fold m a b
Fold.foldl' ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
(<>) ByteString
forall a. Monoid a => a
mempty) Stream m ByteString
lazyfilef
  ByteString -> m (Digest hash)
forall (m :: * -> *) hash.
(Monad m, HashAlgorithm hash) =>
ByteString -> m (Digest hash)
sinkHashStreamly ByteString
lazyfileff
  

-- | A more performant replacement of
-- [sinkHash](https://hackage.haskell.org/package/cryptohash-conduit-0.1.1/docs/src/Crypto-Hash-Conduit.html#sinkHash)
-- found in [Crypto.Hash.Conduit](https://hackage.haskell.org/package/cryptohash-conduit-0.1.1/docs/Crypto-Hash-Conduit.html).
sinkHashStreamly :: ( Monad m
                    , Crypto.Hash.IO.HashAlgorithm hash
                    )
                 => B.ByteString
                 -> m (Crypto.Hash.Digest hash)
sinkHashStreamly :: forall (m :: * -> *) hash.
(Monad m, HashAlgorithm hash) =>
ByteString -> m (Digest hash)
sinkHashStreamly ByteString
bscontent = 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 ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
hash ByteString
bscontent