{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
module Yesod.Default.Util.Streamly (
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
addStaticContentExternalStreamly :: (L.ByteString -> Either a L.ByteString)
-> (L.ByteString -> String)
-> FilePath
-> ([Text] -> Route master)
-> Text
-> Text
-> L.ByteString
-> 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
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