quarantimer-1.20200326: Image.hs

module Image where

import System.Process
import System.Exit
import Control.Concurrent.STM

newtype ImageQueue = ImageQueue (TQueue (IO Bool, TMVar Bool))

mkImageQueue :: IO ImageQueue
mkImageQueue = ImageQueue <$> newTQueueIO

queueAction :: ImageQueue -> IO Bool -> IO Bool
queueAction (ImageQueue q) a = do
	v <- newEmptyTMVarIO
	atomically $ writeTQueue q (a, v)
	atomically $ takeTMVar v

queueRunnerThread :: ImageQueue -> IO ()
queueRunnerThread q@(ImageQueue qv) = do
	(a, v) <- atomically $ readTQueue qv
	r <- a
	_ <- atomically $ tryPutTMVar v r
	queueRunnerThread q

allowedImageTypes :: [String]
allowedImageTypes = ["PNG", "GIF", "JPEG"]

scaleImage :: Int -> FilePath -> FilePath -> IO Bool
scaleImage maxsz src dst = do
	(_,t,_) <- readCreateProcessWithExitCode
		(proc "identify" ["-format", "%m", src]) ""
	if t `elem` allowedImageTypes
		then do
			p <- spawnProcess "convert"
				[ src
				, "-resize"
				-- The ">" makes it only shrink large images,
				-- not scale up small.
				, show maxsz ++ "x" ++ show maxsz ++ ">"
				, dst
				]
			(== ExitSuccess) <$> waitForProcess p
		else return False