{-# LANGUAGE OverloadedLists   #-}
{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      :  Yesod.Default.Util.Streamly
-- Copyright   :  (c) Matthew Mosior 2023
-- License     :  BSD-style
-- Maintainer  :  mattm.github@gmail.com
-- Portability :  portable
--
-- = Streamly-based alternative functionality for Yesod.Default.Util.
--
-- 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.Default.Util.Streamly ( -- * Yesod.Default.Util Replacement function
                                     addStaticContentExternalStreamly 
                                   ) where

import Control.Monad (unless)
import Data.ByteString.Lazy as L (ByteString)
import Data.Text as DText (Text,pack,unpack)
import Streamly.External.ByteString.Lazy as StreamlyLByteString
import qualified Streamly.Internal.FileSystem.File as StreamlyFile
import System.Directory (doesFileExist,createDirectoryIfMissing)
import Yesod.Core

-- | A more performant replacement of
-- [addStaticContentExternal](https://hackage.haskell.org/package/yesod-1.6.2.1/docs/Yesod-Default-Util.html#v:addStaticContentExternal)
-- found in [Yesod.Default.Util](https://hackage.haskell.org/package/yesod-1.6.2.1/docs/Yesod-Default-Util.html).
addStaticContentExternalStreamly :: (L.ByteString -> Either a L.ByteString) -- ^ javascript minifier
                                 -> (L.ByteString -> String) -- ^ hash function to determine file name
                                 -> FilePath -- ^ location of static directory. files will be placed within a "tmp" subfolder
                                 -> ([Text] -> Route master) -- ^ route constructor, taking a list of pieces
                                 -> Text -- ^ filename extension
                                 -> Text -- ^ mime type
                                 -> L.ByteString -- ^ file contents
                                 -> HandlerFor master (Maybe (Either Text (Route master, [(Text, Text)])))
addStaticContentExternalStreamly :: forall a master.
(ByteString -> Either a ByteString)
-> (ByteString -> String)
-> String
-> ([Text] -> Route master)
-> Text
-> Text
-> ByteString
-> HandlerFor
     master (Maybe (Either Text (Route master, [(Text, Text)])))
addStaticContentExternalStreamly ByteString -> Either a ByteString
minify ByteString -> String
hash String
staticDir [Text] -> Route master
toRoute Text
ext' Text
_ ByteString
content = do
    IO () -> HandlerFor master ()
forall a. IO a -> HandlerFor master a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HandlerFor master ()) -> IO () -> HandlerFor master ()
forall a b. (a -> b) -> a -> b
$ Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
statictmp
    Bool
exists <- IO Bool -> HandlerFor master Bool
forall a. IO a -> HandlerFor master a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> HandlerFor master Bool)
-> IO Bool -> HandlerFor master Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
fn'
    Bool -> HandlerFor master () -> HandlerFor master ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists (HandlerFor master () -> HandlerFor master ())
-> HandlerFor master () -> HandlerFor master ()
forall a b. (a -> b) -> a -> b
$
      IO () -> HandlerFor master ()
forall a. IO a -> HandlerFor master a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HandlerFor master ()) -> IO () -> HandlerFor master ()
forall a b. (a -> b) -> a -> b
$ String -> Stream IO (Array Word8) -> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
String -> Stream m (Array a) -> m ()
StreamlyFile.fromChunks String
fn'
                                       (ByteString -> Stream IO (Array Word8)
forall (m :: * -> *).
Monad m =>
ByteString -> Stream m (Array Word8)
StreamlyLByteString.toChunks ByteString
content')
    Maybe (Either Text (Route master, [(Text, Text)]))
-> HandlerFor
     master (Maybe (Either Text (Route master, [(Text, Text)])))
forall a. a -> HandlerFor master a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Either Text (Route master, [(Text, Text)]))
 -> HandlerFor
      master (Maybe (Either Text (Route master, [(Text, Text)]))))
-> Maybe (Either Text (Route master, [(Text, Text)]))
-> HandlerFor
     master (Maybe (Either Text (Route master, [(Text, Text)])))
forall a b. (a -> b) -> a -> b
$ Either Text (Route master, [(Text, Text)])
-> Maybe (Either Text (Route master, [(Text, Text)]))
forall a. a -> Maybe a
Just (Either Text (Route master, [(Text, Text)])
 -> Maybe (Either Text (Route master, [(Text, Text)])))
-> Either Text (Route master, [(Text, Text)])
-> Maybe (Either Text (Route master, [(Text, Text)]))
forall a b. (a -> b) -> a -> b
$ (Route master, [(Text, Text)])
-> Either Text (Route master, [(Text, Text)])
forall a b. b -> Either a b
Right ([Text] -> Route master
toRoute [Text
Item [Text]
"tmp", String -> Text
DText.pack String
fn], [])
  where
    fn, statictmp, fn' :: FilePath
    -- by basing the hash off of the un-minified content, we avoid a costly
    -- minification if the file already exists
    fn :: String
fn = ByteString -> String
hash ByteString
content String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
'.' Char -> String -> String
forall a. a -> [a] -> [a]
: Text -> String
unpack Text
ext'
    statictmp :: String
statictmp = String
staticDir String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/tmp/"
    fn' :: String
fn' = String
statictmp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fn

    content' :: L.ByteString
    content' :: ByteString
content'
        | Text
ext' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"js" = (a -> ByteString)
-> (ByteString -> ByteString) -> Either a ByteString -> ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ByteString -> a -> ByteString
forall a b. a -> b -> a
const ByteString
content) ByteString -> ByteString
forall a. a -> a
id (Either a ByteString -> ByteString)
-> Either a ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Either a ByteString
minify ByteString
content
        | Bool
otherwise = ByteString
content