{-# 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
-- 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 (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 Data.Text (pack)
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

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

-- | 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
                       -> Int      -- ^ buffer size
                       -> 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

-- | 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
                          -> Int        -- ^ buffer size
                          -> 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

-- | 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
                           -> Int                    -- ^ buffer size
                           -> 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) []
                                     ]
                                 ]

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

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

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

-- | 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 :: String -> Bool
notHiddenStreamly String
"tmp" = Bool
False
notHiddenStreamly String
s     =
  case String
s of
    Char
'.':String
_ -> Bool
False
    String
_     -> 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 :: 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'
    
    -- Reuse data buffers for identical strings
    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

-- | 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 :: 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

-- | A replacement of
-- [CombineType](https://hackage.haskell.org/package/yesod-static-1.6.1.0/docs/src/Yesod.Static.html#CombineType).
data CombineTypeStreamly = JS | CSS

-- | A replacement of
-- [CombineSettings](https://hackage.haskell.org/package/yesod-static-1.6.1.0/docs/Yesod-Static.html#t:CombineSettings).
data CombineSettingsStreamly = CombineSettingsStreamly
    { CombineSettingsStreamly -> String
csStaticDir :: FilePath
    -- ^ File path containing static files.
    --
    -- Default: static
    --
    -- Since 1.2.0
    , CombineSettingsStreamly -> [String] -> ByteString -> IO ByteString
csCssPostProcess :: [FilePath] -> L.ByteString -> IO L.ByteString
    -- ^ Post processing to be performed on CSS files.
    --
    -- Default: Pass-through.
    --
    -- Since 1.2.0
    , CombineSettingsStreamly -> [String] -> ByteString -> IO ByteString
csJsPostProcess :: [FilePath] -> L.ByteString -> IO L.ByteString
    -- ^ Post processing to be performed on Javascript files.
    --
    -- Default: Pass-through.
    --
    -- Since 1.2.0
    , CombineSettingsStreamly -> Text -> IO Text
csCssPreProcess :: TL.Text -> IO TL.Text
    -- ^ Pre-processing to be performed on CSS files.
    --
    -- Default: convert all occurences of /static/ to ../
    --
    -- Since 1.2.0
    , CombineSettingsStreamly -> Text -> IO Text
csJsPreProcess :: TL.Text -> IO TL.Text
    -- ^ Pre-processing to be performed on Javascript files.
    --
    -- Default: Pass-through.
    --
    -- Since 1.2.0
    , CombineSettingsStreamly -> String
csCombinedFolder :: FilePath
    -- ^ Subfolder to put combined files into.
    --
    -- Default: combined
    --
    -- Since 1.2.0
    }

instance Default CombineSettingsStreamly where
    def :: CombineSettingsStreamly
def = CombineSettingsStreamly
        { csStaticDir :: String
csStaticDir = String
"static"
        {- Disabled due to: https://github.com/yesodweb/yesod/issues/623
        , csCssPostProcess = \fps ->
              either (error . (errorIntro fps)) (return . TLE.encodeUtf8)
            . flip luciusRTMinified []
            . TLE.decodeUtf8
        -}
        , 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
           -- FIXME The following borders on a hack. With combining of files,
           -- the final location of the CSS is no longer fixed, so relative
           -- references will break. Instead, we switched to using /static/
           -- absolute references. However, when served from a separate domain
           -- name, this will break too. The solution is that, during
           -- development, we keep /static/, and in the combining phase, we
           -- replace /static with a relative reference to the parent folder.
        , 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"
        }

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

-- | A more performant replacement of
-- [combineStatics'](https://hackage.haskell.org/package/yesod-static-1.6.1.0/docs/src/Yesod.Static.html#combineStatics').
combineStaticsStreamly' :: CombineTypeStreamly
                        -> CombineSettingsStreamly
                        -> [Route Static] -- ^ files to combine
                        -> 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"

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

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

-- | 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 -> 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

-- | 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 :: ( 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
  
-- | 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
                    )
                 => 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