{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}

{- | Create a 'XStaticFile' served as /\/my-file.txt/ or /\/xstatic\/my-file.txt/:

@
myFile :: XStaticFile
myFile = $(embedXStaticFile ".\/data\/my-file.txt")
@
-}
module XStatic.TH (
    embedXStaticFile,
    embedXStaticFileVersion,

    -- * re-export from "XStatic"
    XStaticFile,
) where

import Codec.Compression.GZip qualified as GZip
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.ByteString.Char8 (pack)
import Data.ByteString.Char8 qualified as BS8
import Data.Digest.Pure.SHA qualified as SHA
import Data.List qualified
import Data.Maybe (fromMaybe)
import Data.Text qualified as Text
import Data.Version (Version (..), showVersion)
import Language.Haskell.TH (Exp (AppE))
import Language.Haskell.TH qualified as TH
import Language.Haskell.TH.Syntax qualified as TH
import Network.Mime qualified as Mime
import XStatic (XStaticFile (..), isGzip)

doEmbedXStaticFile ::
    FilePath ->
    Maybe ByteString ->
    TH.Q TH.Exp
doEmbedXStaticFile :: FilePath -> Maybe ByteString -> Q Exp
doEmbedXStaticFile FilePath
fp Maybe ByteString
etag = do
    ByteString
buf <- forall a. IO a -> Q a
TH.runIO (FilePath -> IO ByteString
BS.readFile FilePath
fp)
    Exp
contentE <- forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
TH.lift (ByteString -> ByteString
ensureCompress ByteString
buf)
    Exp
nameE <- forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
TH.lift ByteString
clean_name
    Exp
mimeE <- forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
TH.lift (FileName -> ByteString
Mime.defaultMimeLookup (FilePath -> FileName
Text.pack FilePath
fp_without_gz))
    Exp
etagE <- forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
TH.lift (forall a. a -> Maybe a -> a
fromMaybe (ByteString -> ByteString
hashBuf ByteString
buf) Maybe ByteString
etag)

    Exp
mkXF <- [|XStaticFile|]
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$!
        Exp
mkXF
            Exp -> Exp -> Exp
`AppE` Exp
nameE
            Exp -> Exp -> Exp
`AppE` Exp
contentE
            Exp -> Exp -> Exp
`AppE` Exp
etagE
            Exp -> Exp -> Exp
`AppE` Exp
mimeE
  where
    hashBuf :: ByteString -> ByteString
hashBuf = FilePath -> ByteString
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Digest t -> FilePath
SHA.showDigest forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Digest SHA1State
SHA.sha1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BS.fromStrict
    ensureCompress :: ByteString -> ByteString
ensureCompress ByteString
buf
        | ByteString -> Bool
isGzip ByteString
buf = ByteString
buf
        | Bool
otherwise = ByteString -> ByteString
BS.toStrict (ByteString -> ByteString
GZip.compress (ByteString -> ByteString
BS.fromStrict ByteString
buf))

    fp_without_gz :: FilePath
fp_without_gz = FilePath -> FilePath -> FilePath
stripSuffix FilePath
".gz" FilePath
fp
    clean_name :: ByteString
clean_name =
        FilePath -> ByteString
pack
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => a -> a -> a
mappend FilePath
"/"
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> FilePath
stripSuffix FilePath
"index.html"
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> FilePath
stripPrefix FilePath
"data/"
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'/')
            forall a b. (a -> b) -> a -> b
$ FilePath
fp_without_gz
    stripSuffix :: String -> String -> String
    stripSuffix :: FilePath -> FilePath -> FilePath
stripSuffix FilePath
s FilePath
n = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath
stripPrefix (forall a. [a] -> [a]
reverse FilePath
s) (forall a. [a] -> [a]
reverse FilePath
n)
    stripPrefix :: String -> String -> String
    stripPrefix :: FilePath -> FilePath -> FilePath
stripPrefix FilePath
p FilePath
n = forall a. a -> Maybe a -> a
fromMaybe FilePath
n (forall a. Eq a => [a] -> [a] -> Maybe [a]
Data.List.stripPrefix FilePath
p FilePath
n)

{- | Embed a static file in its compressed form.

The following rules are applied to convert a local filepath to the expected request path:

  * /./, /\// and \"/data\//\" prefix are removed
  * \"/.gz/\" and \"/index.html/\" suffix are removed
-}
embedXStaticFile :: FilePath -> TH.Q TH.Exp
embedXStaticFile :: FilePath -> Q Exp
embedXStaticFile FilePath
fp = FilePath -> Maybe ByteString -> Q Exp
doEmbedXStaticFile FilePath
fp forall a. Maybe a
Nothing

-- | Same as 'embedXStaticFile', but using the provided 'Version' for the 'xfETag' value.
embedXStaticFileVersion :: FilePath -> Version -> TH.Q TH.Exp
embedXStaticFileVersion :: FilePath -> Version -> Q Exp
embedXStaticFileVersion FilePath
fp Version
version = FilePath -> Maybe ByteString -> Q Exp
doEmbedXStaticFile FilePath
fp (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Version -> ByteString
versionToEtag Version
version)

versionToEtag :: Version -> ByteString
versionToEtag :: Version -> ByteString
versionToEtag = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ByteString -> [ByteString]
BS8.split Char
'.' forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ByteString
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> FilePath
showVersion