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

-- |
-- Module      :  Yesod.Static.Streamly
-- Copyright   :  (c) Matthew Mosior 2023
-- License     :  BSD-style
-- Maintainer  :  mattm.github@gmail.com
-- Portability :  portable
--
-- = Streamly-based alternative functionality for Yesod.Static.
--
-- 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.
--
-- If you have large files to cache within your static directory, you may very well need to increase you file descriptor limit in order to utilize the functionality this library provides properly.

module Yesod.Static.Streamly ( -- * Yesod.Static Replacement functions - Smart constructor
                               staticStreamly,
                               staticDevelStreamly,
                               -- * Yesod.Static Replacement functions - Combining CSS/JS
                               combineStylesheetsStreamly',
                               combineScriptsStreamly',
                               -- * Yesod.Static Replacement functions - Template Haskell helpers
                               staticFilesStreamly,
                               staticFilesListStreamly,
                               staticFilesMapStreamly,
                               staticFilesMergeMapStreamly,
                               publicFilesStreamly
                             ) where

import Yesod.Static.Streamly.Internal

import Data.List (foldl')
import qualified Data.Map as M
import Language.Haskell.TH
import Language.Haskell.TH.Syntax as TH
import Network.Wai.Application.Static (webAppSettingsWithLookup)
import qualified System.FilePath as FP
import Yesod.Static

-- | A more performant replacement of
-- [static](https://hackage.haskell.org/package/yesod-static-1.6.1.0/docs/Yesod-Static.html#v:static)
-- found in [Yesod.Static](https://hackage.haskell.org/package/yesod-static-1.6.1.0/docs/Yesod-Static.html).
staticStreamly :: FilePath -- ^ file path of static directory
               -> Int      -- ^ buffer size (0.25 - 0.50 x your L2 cache seems to be best.)
               -> IO Static
staticStreamly :: FilePath -> Int -> IO Static
staticStreamly FilePath
dir Int
size = do
  ETagLookup
hashLookup <- FilePath -> Int -> IO ETagLookup
cachedETagLookupStreamly FilePath
dir
                                         Int
size
  Static -> IO Static
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Static -> IO Static) -> Static -> IO Static
forall a b. (a -> b) -> a -> b
$ StaticSettings -> Static
Static (StaticSettings -> Static) -> StaticSettings -> Static
forall a b. (a -> b) -> a -> b
$ FilePath -> ETagLookup -> StaticSettings
webAppSettingsWithLookup FilePath
dir ETagLookup
hashLookup

-- | A more performant replacement of
-- [staticDevel](https://hackage.haskell.org/package/yesod-static-1.6.1.0/docs/Yesod-Static.html#v:staticDevel)
-- found in [Yesod.Static](https://hackage.haskell.org/package/yesod-static-1.6.1.0/docs/Yesod-Static.html).
staticDevelStreamly :: FilePath -- ^ file path of static directory
                    -> Int      -- ^ buffer size (0.25 - 0.50 x your L2 cache seems to be best.)
                    -> IO Static
staticDevelStreamly :: FilePath -> Int -> IO Static
staticDevelStreamly FilePath
dir Int
size = do
  ETagLookup
hashLookup <- FilePath -> Int -> IO ETagLookup
cachedETagLookupDevelStreamly FilePath
dir
                                              Int
size
  Static -> IO Static
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Static -> IO Static) -> Static -> IO Static
forall a b. (a -> b) -> a -> b
$ StaticSettings -> Static
Static (StaticSettings -> Static) -> StaticSettings -> Static
forall a b. (a -> b) -> a -> b
$ FilePath -> ETagLookup -> StaticSettings
webAppSettingsWithLookup FilePath
dir ETagLookup
hashLookup

-- | A more performant replacement of
-- [combineStylesheets'](https://hackage.haskell.org/package/yesod-static-1.6.1.0/docs/Yesod-Static.html#v:combineStylesheets-39-)
-- found in [Yesod.Static](https://hackage.haskell.org/package/yesod-static-1.6.1.0/docs/Yesod-Static.html).
combineStylesheetsStreamly' :: Bool           -- ^ development? if so, perform no combining
                            -> CombineSettingsStreamly
                            -> Name           -- ^ Static route constructor name, e.g. \'StaticR
                            -> [Route Static] -- ^ files to combine
                            -> Int            -- ^ buffer size (0.25 - 0.50 x your L2 cache seems to be best.)
                            -> Q Exp
combineStylesheetsStreamly' :: Bool
-> CombineSettingsStreamly
-> Name
-> [Route Static]
-> Int
-> Q Exp
combineStylesheetsStreamly' Bool
development CombineSettingsStreamly
cs Name
con [Route Static]
routes Int
size
    | Bool
development = [| mapM_ (addStylesheet . $(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
$ Name -> Exp
ConE Name
con)) $([Route Static] -> Q Exp
liftRoutesStreamly [Route Static]
routes) |]
    | Bool
otherwise = [| addStylesheet $ $(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
$ Name -> Exp
ConE Name
con) $(CombineTypeStreamly
-> CombineSettingsStreamly -> [Route Static] -> Int -> Q Exp
combineStaticsStreamly' CombineTypeStreamly
CSS CombineSettingsStreamly
cs [Route Static]
routes Int
size) |]

-- | A more performant replacement of
-- [combineScripts'](https://hackage.haskell.org/package/yesod-static-1.6.1.0/docs/Yesod-Static.html#v:combineScripts-39-)
-- found in [Yesod.Static](https://hackage.haskell.org/package/yesod-static-1.6.1.0/docs/Yesod-Static.html).
combineScriptsStreamly' :: Bool           -- ^ development? if so, perform no combining
                        -> CombineSettingsStreamly
                        -> Name           -- ^ Static route constructor name, e.g. \'StaticR
                        -> [Route Static] -- ^ files to combine
                        -> Int            -- ^ buffer size (0.25 - 0.50 x your L2 cache seems to be best.)
                        -> Q Exp
combineScriptsStreamly' :: Bool
-> CombineSettingsStreamly
-> Name
-> [Route Static]
-> Int
-> Q Exp
combineScriptsStreamly' Bool
development CombineSettingsStreamly
cs Name
con [Route Static]
routes Int
size
    | Bool
development = [| mapM_ (addScript . $(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
$ Name -> Exp
ConE Name
con)) $([Route Static] -> Q Exp
liftRoutesStreamly [Route Static]
routes) |]
    | Bool
otherwise = [| addScript $ $(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
$ Name -> Exp
ConE Name
con) $(CombineTypeStreamly
-> CombineSettingsStreamly -> [Route Static] -> Int -> Q Exp
combineStaticsStreamly' CombineTypeStreamly
JS CombineSettingsStreamly
cs [Route Static]
routes Int
size) |]


-- | A more performant replacement of
-- [staticFiles](https://hackage.haskell.org/package/yesod-static-1.6.1.0/docs/Yesod-Static.html#v:staticFiles)
-- found in [Yesod.Static](https://hackage.haskell.org/package/yesod-static-1.6.1.0/docs/Yesod-Static.html).
staticFilesStreamly :: FilePath -- ^ file path of static directory
                    -> Int      -- ^ buffer size (0.25 - 0.50 x your L2 cache seems to be best.)
                    -> Q [Dec]
staticFilesStreamly :: FilePath -> Int -> Q [Dec]
staticFilesStreamly FilePath
dir Int
size = FilePath -> Int -> Q [Dec]
mkStaticFilesStreamly FilePath
dir
                                                     Int
size

-- | A more performant replacement of
-- [staticFilesList](https://hackage.haskell.org/package/yesod-static-1.6.1.0/docs/Yesod-Static.html#v:staticFilesList)
-- found in [Yesod.Static](https://hackage.haskell.org/package/yesod-static-1.6.1.0/docs/Yesod-Static.html).
staticFilesListStreamly :: FilePath -- ^ file path of static directory
                        -> [FilePath]
                        -> Int      -- ^ buffer size (0.25 - 0.50 x your L2 cache seems to be best.)
                        -> Q [Dec]
staticFilesListStreamly :: FilePath -> [FilePath] -> Int -> Q [Dec]
staticFilesListStreamly FilePath
dir [FilePath]
fs Int
size = 
  FilePath -> [[FilePath]] -> Bool -> Int -> Q [Dec]
mkStaticFilesListStreamly FilePath
dir
                            ((FilePath -> [FilePath]) -> [FilePath] -> [[FilePath]]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> [FilePath]
split [FilePath]
fs)
                            Bool
True
                            Int
size
    where
      split :: FilePath
            -> [String]
      split :: FilePath -> [FilePath]
split [] = []
      split FilePath
x = let (FilePath
a, FilePath
b) = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') FilePath
x
                  in FilePath
a FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: FilePath -> [FilePath]
split (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
1 FilePath
b)

-- | A more performant replacement of
-- [staticFilesMap](https://hackage.haskell.org/package/yesod-static-1.6.1.0/docs/Yesod-Static.html#v:staticFilesMap)
-- found in [Yesod.Static](https://hackage.haskell.org/package/yesod-static-1.6.1.0/docs/Yesod-Static.html).
staticFilesMapStreamly :: FilePath -- ^ file path of static directory
                       -> M.Map FilePath FilePath 
                       -> Int      -- ^ buffer size (0.25 - 0.50 x your L2 cache seems to be best.)
                       -> Q [Dec]
staticFilesMapStreamly :: FilePath -> Map FilePath FilePath -> Int -> Q [Dec]
staticFilesMapStreamly FilePath
fp Map FilePath FilePath
m Int
size =
  FilePath -> [([FilePath], [FilePath])] -> Bool -> Int -> Q [Dec]
mkStaticFilesListStreamly' FilePath
fp
                             (((FilePath, FilePath) -> ([FilePath], [FilePath]))
-> [(FilePath, FilePath)] -> [([FilePath], [FilePath])]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, FilePath) -> ([FilePath], [FilePath])
splitBoth [(FilePath, FilePath)]
mapList)
                             Bool
True
                             Int
size
    where
      splitBoth :: (FilePath, FilePath) -> ([FilePath], [FilePath])
splitBoth (FilePath
k, FilePath
v) = (FilePath -> [FilePath]
split FilePath
k, FilePath -> [FilePath]
split FilePath
v)
      mapList :: [(FilePath, FilePath)]
mapList = Map FilePath FilePath -> [(FilePath, FilePath)]
forall k a. Map k a -> [(k, a)]
M.toList Map FilePath FilePath
m
      split :: FilePath
            -> [String]
      split :: FilePath -> [FilePath]
split [] = []
      split FilePath
x = let (FilePath
a, FilePath
b) = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') FilePath
x
                  in FilePath
a FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: FilePath -> [FilePath]
split (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
1 FilePath
b)

-- | A more performant replacement of
-- [staticFilesMergeMap](https://hackage.haskell.org/package/yesod-static-1.6.1.0/docs/Yesod-Static.html#v:staticFilesMergeMap)
-- found in [Yesod.Static](https://hackage.haskell.org/package/yesod-static-1.6.1.0/docs/Yesod-Static.html).
staticFilesMergeMapStreamly :: FilePath -- ^ file path of static directory
                            -> M.Map FilePath FilePath
                            -> Int      -- ^ buffer size (0.25 - 0.50 x your L2 cache seems to be best.)
                            -> Q [Dec]
staticFilesMergeMapStreamly :: FilePath -> Map FilePath FilePath -> Int -> Q [Dec]
staticFilesMergeMapStreamly FilePath
fp Map FilePath FilePath
m 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
  let filesList :: [FilePath]
filesList     = ([FilePath] -> FilePath) -> [[FilePath]] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map [FilePath] -> FilePath
FP.joinPath [[FilePath]]
fs
      mergedMapList :: [(FilePath, FilePath)]
mergedMapList = Map FilePath FilePath -> [(FilePath, FilePath)]
forall k a. Map k a -> [(k, a)]
M.toList (Map FilePath FilePath -> [(FilePath, FilePath)])
-> Map FilePath FilePath -> [(FilePath, FilePath)]
forall a b. (a -> b) -> a -> b
$ (Map FilePath FilePath -> FilePath -> Map FilePath FilePath)
-> Map FilePath FilePath -> [FilePath] -> Map FilePath FilePath
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Map FilePath FilePath
-> Map FilePath FilePath -> FilePath -> Map FilePath FilePath
checkedInsert Map FilePath FilePath
invertedMap) Map FilePath FilePath
m [FilePath]
filesList
  FilePath -> [([FilePath], [FilePath])] -> Bool -> Int -> Q [Dec]
mkStaticFilesListStreamly' FilePath
fp
                             (((FilePath, FilePath) -> ([FilePath], [FilePath]))
-> [(FilePath, FilePath)] -> [([FilePath], [FilePath])]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, FilePath) -> ([FilePath], [FilePath])
splitBoth [(FilePath, FilePath)]
mergedMapList)
                             Bool
True
                             Int
size
    where
      splitBoth :: (FilePath, FilePath) -> ([FilePath], [FilePath])
splitBoth (FilePath
k,FilePath
v) = (FilePath -> [FilePath]
split FilePath
k, FilePath -> [FilePath]
split FilePath
v)
      swap :: (b, a) -> (a, b)
swap (b
x,a
y)      = (a
y, b
x)
      mapList :: [(FilePath, FilePath)]
mapList         = Map FilePath FilePath -> [(FilePath, FilePath)]
forall k a. Map k a -> [(k, a)]
M.toList Map FilePath FilePath
m
      invertedMap :: Map FilePath FilePath
invertedMap     = [(FilePath, FilePath)] -> Map FilePath FilePath
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(FilePath, FilePath)] -> Map FilePath FilePath)
-> [(FilePath, FilePath)] -> Map FilePath FilePath
forall a b. (a -> b) -> a -> b
$ ((FilePath, FilePath) -> (FilePath, FilePath))
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, FilePath) -> (FilePath, FilePath)
forall {b} {a}. (b, a) -> (a, b)
swap [(FilePath, FilePath)]
mapList
      split :: FilePath
            -> [String]
      split :: FilePath -> [FilePath]
split [] = []
      split FilePath
x = let (FilePath
a, FilePath
b) = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') FilePath
x
                  in FilePath
a FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: FilePath -> [FilePath]
split (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
1 FilePath
b)
      -- We want to keep mappings for all files that are pre-fingerprinted,
      -- so this function checks against all of the existing fingerprinted files and
      -- only inserts a new mapping if it's not a fingerprinted file.
      checkedInsert
        :: M.Map FilePath FilePath -- inverted dictionary
        -> M.Map FilePath FilePath -- accumulating state
        -> FilePath
        -> M.Map FilePath FilePath
      checkedInsert :: Map FilePath FilePath
-> Map FilePath FilePath -> FilePath -> Map FilePath FilePath
checkedInsert Map FilePath FilePath
iDict Map FilePath FilePath
st FilePath
p = if FilePath -> Map FilePath FilePath -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member FilePath
p Map FilePath FilePath
iDict
                                   then Map FilePath FilePath
st
                                   else FilePath
-> FilePath -> Map FilePath FilePath -> Map FilePath FilePath
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert FilePath
p FilePath
p Map FilePath FilePath
st

-- | A more performant replacement of
-- [publicFiles](https://hackage.haskell.org/package/yesod-static-1.6.1.0/docs/Yesod-Static.html#v:publicFiles)
-- found in [Yesod.Static](https://hackage.haskell.org/package/yesod-static-1.6.1.0/docs/Yesod-Static.html).
publicFilesStreamly :: FilePath -- ^ file path of static directory
                    -> Int      -- ^ buffer size (0.25 - 0.50 x your L2 cache seems to be best.)
                    -> Q [Dec]
publicFilesStreamly :: FilePath -> Int -> Q [Dec]
publicFilesStreamly FilePath
dir Int
size = FilePath -> Bool -> Int -> Q [Dec]
mkStaticFilesStreamly' FilePath
dir
                                                      Bool
False
                                                      Int
size