{-|
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
-> [String] -> FileInfo LByteString -> IO (FileInfo LByteString)
applyImageMagick Text
convertTo [String]
otherParams FileInfo LByteString
fileInfo = do
    String
-> String
-> (String -> IO (FileInfo LByteString))
-> IO (FileInfo LByteString)
forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
String -> String -> (String -> m a) -> m a
Temp.withTempDirectory String
"/tmp" String
"ihp-upload" ((String -> IO (FileInfo LByteString))
 -> IO (FileInfo LByteString))
-> (String -> IO (FileInfo LByteString))
-> IO (FileInfo LByteString)
forall a b. (a -> b) -> a -> b
$ \String
tempPath -> do
        let tempFilePath :: String
tempFilePath = String
tempPath String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/image"
        let convertedFilePath :: String
convertedFilePath = String
tempPath String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/converted." String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
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
|> Proxy "fileContent" -> FileInfo LByteString -> LByteString
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "fileContent" (Proxy "fileContent")
Proxy "fileContent"
#fileContent
            LByteString -> (LByteString -> IO ()) -> IO ()
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> String -> LByteString -> IO ()
LBS.writeFile String
tempFilePath

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

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