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 scaleImage :: Int -> FilePath -> FilePath -> IO Bool scaleImage maxsz src dst = 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