{-|
Module: IHP.FileStorage.Preprocessor.ImageMagick
Description: Preprocessor for images. Requires that you add @imagemagick@ to the @otherDeps@ inside the project's @default.nix.
Copyright: (c) digitally induced GmbH, 2021
-}
module IHP.FileStorage.Preprocessor.ImageMagick
( applyImageMagick
) where

import IHP.Prelude

import qualified Network.Wai.Parse as Wai
import qualified Data.ByteString.Lazy as LBS
import qualified System.IO.Temp as Temp
import qualified System.Process as Process


-- | Converts the image to the specified output format and applies specified image magick transforms
--
-- __Example:__ Transform an uploaded image to a PNG file, resize it to 512x512 and strip meta data
--
-- > let uploadLogo = uploadToStorageWithOptions $ def
-- >         { preprocess = applyImageMagick "png" ["-resize", "512x512^", "-gravity", "north", "-extent" , "512x512", "-quality", "100%", "-strip"] }
-- >
-- > company <- fetch companyId
-- > company
-- >     |> fill @'["name"]
-- >     |> uploadLogo #logoUrl
-- >     >>= ifValid \case
-- >         Left company -> render EditView { .. }
-- >         Right company -> do
-- >             company <- company |> updateRecord
-- >             redirectTo EditCompanyAction { .. }
--
--
-- __Example:__ Transform an uploaded image to a JPEG file and strip meta data
--
-- > let uploadLogo = uploadToStorageWithOptions $ def
-- >         { preprocess = applyImageMagick "jpg" ["-strip"] }
-- >
-- > company <- fetch companyId
-- > company
-- >     |> fill @'["name"]
-- >     |> uploadLogo #logoUrl
-- >     >>= ifValid \case
-- >         Left company -> render EditView { .. }
-- >         Right company -> do
-- >             company <- company |> updateRecord
-- >             redirectTo EditCompanyAction { .. }
--
applyImageMagick :: Text -> [String] -> Wai.FileInfo LByteString -> IO (Wai.FileInfo LByteString)
applyImageMagick :: Text
-> [FilePath] -> FileInfo LByteString -> IO (FileInfo LByteString)
applyImageMagick Text
convertTo [FilePath]
otherParams FileInfo LByteString
fileInfo = do
    FilePath
-> FilePath
-> (FilePath -> IO (FileInfo LByteString))
-> IO (FileInfo LByteString)
forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
FilePath -> FilePath -> (FilePath -> m a) -> m a
Temp.withTempDirectory FilePath
"/tmp" FilePath
"ihp-upload" ((FilePath -> IO (FileInfo LByteString))
 -> IO (FileInfo LByteString))
-> (FilePath -> IO (FileInfo LByteString))
-> IO (FileInfo LByteString)
forall a b. (a -> b) -> a -> b
$ \FilePath
tempPath -> do
        let tempFilePath :: FilePath
tempFilePath = FilePath
tempPath FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"/image"
        let convertedFilePath :: FilePath
convertedFilePath = FilePath
tempPath FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"/converted." FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
forall a b. ConvertibleStrings a b => a -> b
cs Text
convertTo

        FileInfo LByteString
fileInfo
            FileInfo LByteString
-> (FileInfo LByteString -> LByteString) -> LByteString
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (.fileContent)
            LByteString -> (LByteString -> IO ()) -> IO ()
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> FilePath -> LByteString -> IO ()
LBS.writeFile FilePath
tempFilePath

        let [FilePath]
params :: [String] = [FilePath
tempFilePath] [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> [FilePath]
otherParams [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> [FilePath
convertedFilePath]
        FilePath -> [FilePath] -> IO ()
Process.callProcess FilePath
"convert" [FilePath]
params

        LByteString
newContent <- FilePath -> IO LByteString
LBS.readFile FilePath
convertedFilePath
        FileInfo LByteString -> IO (FileInfo LByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileInfo LByteString
fileInfo { Wai.fileContent = newContent }