module Mensam.Server.Jpeg where

import Codec.Picture
import Codec.Picture.Extra
import Codec.Picture.Types
import Control.Monad.Trans.State
import Data.ByteString.Lazy qualified as BL
import Data.Kind
import GHC.Generics
import Servant.API.ImageJpeg

type ByteStringJpeg :: Type
newtype ByteStringJpeg = MkByteStringJpegUnsafe {ByteStringJpeg -> ByteString
unByteStringJpeg :: BL.ByteString}
  deriving stock (ByteStringJpeg -> ByteStringJpeg -> Bool
(ByteStringJpeg -> ByteStringJpeg -> Bool)
-> (ByteStringJpeg -> ByteStringJpeg -> Bool) -> Eq ByteStringJpeg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ByteStringJpeg -> ByteStringJpeg -> Bool
== :: ByteStringJpeg -> ByteStringJpeg -> Bool
$c/= :: ByteStringJpeg -> ByteStringJpeg -> Bool
/= :: ByteStringJpeg -> ByteStringJpeg -> Bool
Eq, (forall x. ByteStringJpeg -> Rep ByteStringJpeg x)
-> (forall x. Rep ByteStringJpeg x -> ByteStringJpeg)
-> Generic ByteStringJpeg
forall x. Rep ByteStringJpeg x -> ByteStringJpeg
forall x. ByteStringJpeg -> Rep ByteStringJpeg x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ByteStringJpeg -> Rep ByteStringJpeg x
from :: forall x. ByteStringJpeg -> Rep ByteStringJpeg x
$cto :: forall x. Rep ByteStringJpeg x -> ByteStringJpeg
to :: forall x. Rep ByteStringJpeg x -> ByteStringJpeg
Generic, Eq ByteStringJpeg
Eq ByteStringJpeg =>
(ByteStringJpeg -> ByteStringJpeg -> Ordering)
-> (ByteStringJpeg -> ByteStringJpeg -> Bool)
-> (ByteStringJpeg -> ByteStringJpeg -> Bool)
-> (ByteStringJpeg -> ByteStringJpeg -> Bool)
-> (ByteStringJpeg -> ByteStringJpeg -> Bool)
-> (ByteStringJpeg -> ByteStringJpeg -> ByteStringJpeg)
-> (ByteStringJpeg -> ByteStringJpeg -> ByteStringJpeg)
-> Ord ByteStringJpeg
ByteStringJpeg -> ByteStringJpeg -> Bool
ByteStringJpeg -> ByteStringJpeg -> Ordering
ByteStringJpeg -> ByteStringJpeg -> ByteStringJpeg
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ByteStringJpeg -> ByteStringJpeg -> Ordering
compare :: ByteStringJpeg -> ByteStringJpeg -> Ordering
$c< :: ByteStringJpeg -> ByteStringJpeg -> Bool
< :: ByteStringJpeg -> ByteStringJpeg -> Bool
$c<= :: ByteStringJpeg -> ByteStringJpeg -> Bool
<= :: ByteStringJpeg -> ByteStringJpeg -> Bool
$c> :: ByteStringJpeg -> ByteStringJpeg -> Bool
> :: ByteStringJpeg -> ByteStringJpeg -> Bool
$c>= :: ByteStringJpeg -> ByteStringJpeg -> Bool
>= :: ByteStringJpeg -> ByteStringJpeg -> Bool
$cmax :: ByteStringJpeg -> ByteStringJpeg -> ByteStringJpeg
max :: ByteStringJpeg -> ByteStringJpeg -> ByteStringJpeg
$cmin :: ByteStringJpeg -> ByteStringJpeg -> ByteStringJpeg
min :: ByteStringJpeg -> ByteStringJpeg -> ByteStringJpeg
Ord, ReadPrec [ByteStringJpeg]
ReadPrec ByteStringJpeg
Int -> ReadS ByteStringJpeg
ReadS [ByteStringJpeg]
(Int -> ReadS ByteStringJpeg)
-> ReadS [ByteStringJpeg]
-> ReadPrec ByteStringJpeg
-> ReadPrec [ByteStringJpeg]
-> Read ByteStringJpeg
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ByteStringJpeg
readsPrec :: Int -> ReadS ByteStringJpeg
$creadList :: ReadS [ByteStringJpeg]
readList :: ReadS [ByteStringJpeg]
$creadPrec :: ReadPrec ByteStringJpeg
readPrec :: ReadPrec ByteStringJpeg
$creadListPrec :: ReadPrec [ByteStringJpeg]
readListPrec :: ReadPrec [ByteStringJpeg]
Read, Int -> ByteStringJpeg -> ShowS
[ByteStringJpeg] -> ShowS
ByteStringJpeg -> String
(Int -> ByteStringJpeg -> ShowS)
-> (ByteStringJpeg -> String)
-> ([ByteStringJpeg] -> ShowS)
-> Show ByteStringJpeg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ByteStringJpeg -> ShowS
showsPrec :: Int -> ByteStringJpeg -> ShowS
$cshow :: ByteStringJpeg -> String
show :: ByteStringJpeg -> String
$cshowList :: [ByteStringJpeg] -> ShowS
showList :: [ByteStringJpeg] -> ShowS
Show)

jpegConvertProfilePicture :: ImageJpegBytes -> Either String ByteStringJpeg
jpegConvertProfilePicture :: ImageJpegBytes -> Either String ByteStringJpeg
jpegConvertProfilePicture ImageJpegBytes
bytesIn = do
  DynamicImage
dynamicImage <- ByteString -> Either String DynamicImage
decodeJpeg (ByteString -> Either String DynamicImage)
-> ByteString -> Either String DynamicImage
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ImageJpegBytes -> ByteString
unImageJpegBytes ImageJpegBytes
bytesIn
  let imageIn :: Image PixelRGB8
imageIn = DynamicImage -> Image PixelRGB8
convertRGB8 DynamicImage
dynamicImage
  Image PixelRGB8
imageOut <- StateT (Image PixelRGB8) (Either String) ()
-> Image PixelRGB8 -> Either String (Image PixelRGB8)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT StateT (Image PixelRGB8) (Either String) ()
resizeProfilePicture Image PixelRGB8
imageIn
  let bytesOut :: ByteString
bytesOut = Image PixelYCbCr8 -> ByteString
encodeJpeg (Image PixelYCbCr8 -> ByteString)
-> Image PixelYCbCr8 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image PixelRGB8 -> Image PixelYCbCr8
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage Image PixelRGB8
imageOut
  ByteStringJpeg -> Either String ByteStringJpeg
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteStringJpeg -> Either String ByteStringJpeg)
-> ByteStringJpeg -> Either String ByteStringJpeg
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteStringJpeg
MkByteStringJpegUnsafe ByteString
bytesOut
 where
  resizeProfilePicture :: StateT (Image PixelRGB8) (Either String) ()
  resizeProfilePicture :: StateT (Image PixelRGB8) (Either String) ()
resizeProfilePicture = do
    let Int
targetSize :: Int = Int
640
    Int
originalWidth <- (Image PixelRGB8 -> Int)
-> StateT (Image PixelRGB8) (Either String) Int
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets Image PixelRGB8 -> Int
forall a. Image a -> Int
imageWidth
    Int
originalHeight <- (Image PixelRGB8 -> Int)
-> StateT (Image PixelRGB8) (Either String) Int
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets Image PixelRGB8 -> Int
forall a. Image a -> Int
imageHeight
    case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
originalWidth Int
originalHeight of
      Ordering
EQ -> () -> StateT (Image PixelRGB8) (Either String) ()
forall a. a -> StateT (Image PixelRGB8) (Either String) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Ordering
LT -> do
        let croppedHeight :: Int
croppedHeight = Int
originalWidth
        let croppedHeightCutOff :: Int
croppedHeightCutOff = (Int
originalHeight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
croppedHeight) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
        (Image PixelRGB8 -> Image PixelRGB8)
-> StateT (Image PixelRGB8) (Either String) ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify ((Image PixelRGB8 -> Image PixelRGB8)
 -> StateT (Image PixelRGB8) (Either String) ())
-> (Image PixelRGB8 -> Image PixelRGB8)
-> StateT (Image PixelRGB8) (Either String) ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Int -> Image PixelRGB8 -> Image PixelRGB8
forall a. Pixel a => Int -> Int -> Int -> Int -> Image a -> Image a
crop Int
0 Int
croppedHeightCutOff Int
originalWidth Int
croppedHeight
      Ordering
GT -> do
        let croppedWidth :: Int
croppedWidth = Int
originalHeight
        let croppedWidthCutOff :: Int
croppedWidthCutOff = (Int
originalWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
croppedWidth) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
        (Image PixelRGB8 -> Image PixelRGB8)
-> StateT (Image PixelRGB8) (Either String) ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify ((Image PixelRGB8 -> Image PixelRGB8)
 -> StateT (Image PixelRGB8) (Either String) ())
-> (Image PixelRGB8 -> Image PixelRGB8)
-> StateT (Image PixelRGB8) (Either String) ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Int -> Image PixelRGB8 -> Image PixelRGB8
forall a. Pixel a => Int -> Int -> Int -> Int -> Image a -> Image a
crop Int
croppedWidthCutOff Int
0 Int
croppedWidth Int
originalHeight
    (Image PixelRGB8 -> Image PixelRGB8)
-> StateT (Image PixelRGB8) (Either String) ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify ((Image PixelRGB8 -> Image PixelRGB8)
 -> StateT (Image PixelRGB8) (Either String) ())
-> (Image PixelRGB8 -> Image PixelRGB8)
-> StateT (Image PixelRGB8) (Either String) ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Image PixelRGB8 -> Image PixelRGB8
forall a.
(Pixel a, Bounded (PixelBaseComponent a),
 Integral (PixelBaseComponent a)) =>
Int -> Int -> Image a -> Image a
scaleBilinear Int
targetSize Int
targetSize

jpegConvertSpacePicture :: ImageJpegBytes -> Either String ByteStringJpeg
jpegConvertSpacePicture :: ImageJpegBytes -> Either String ByteStringJpeg
jpegConvertSpacePicture = ImageJpegBytes -> Either String ByteStringJpeg
jpegConvertProfilePicture