Display an image in the terminal using w3mimagedisplay

cat-image.hs

import           Control.Monad      (unless)
import qualified System.Directory   as Directory
import           System.Environment (getArgs)
import qualified System.Process     as Process
import           Text.Read          (readMaybe)

newtype W3mImageDisplay = W3mImageDisplay FilePath deriving (Show)

findW3mImageDisplay :: IO W3mImageDisplay
findW3mImageDisplay = do
    exists <- Directory.doesFileExist path
    unless exists $ fail $ path ++ " not found"
    perms <- Directory.getPermissions path
    unless (Directory.executable perms) $ fail $ path ++ " not executable"
    return $ W3mImageDisplay path
  where
    path = "/usr/lib/w3m/w3mimgdisplay"

-- | Parses something of the form "<width> <height>\n".
parseWidthHeight :: String -> Maybe (Int, Int)
parseWidthHeight output = case words output of
    [ws, hs] | Just w <- readMaybe ws, Just h <- readMaybe hs ->
        return (w, h)
    _  -> Nothing

getTerminalSize :: W3mImageDisplay -> IO (Int, Int)
getTerminalSize (W3mImageDisplay w3mImageDisplay) = do
    output <- Process.readProcess w3mImageDisplay ["-test"] ""
    case parseWidthHeight output of
        Just wh -> return wh
        _       -> fail "Could not parse `w3mimgdisplay -test` output"

getImageSize :: W3mImageDisplay -> FilePath -> IO (Int, Int)
getImageSize (W3mImageDisplay w3mImageDisplay) path = do
    output <- Process.readProcess w3mImageDisplay [] ("5;" ++ path ++ "\n")
    case parseWidthHeight output of
        Just wh -> return wh
        _       -> fail "Could not parse image size"

drawImage :: W3mImageDisplay -> FilePath -> IO ()
drawImage w3m@(W3mImageDisplay w3mImageDisplay) path = do
    tsize <- getTerminalSize w3m
    isize <- getImageSize w3m path
    let (x, y, w, h) = fit tsize isize
        command =
            "0;1;" ++
            show x ++ ";" ++ show y ++ ";" ++ show w ++ ";" ++ show h ++
            ";;;;;" ++ path ++ "\n4;\n3;\n"

    _ <- Process.readProcess w3mImageDisplay [] command
    return ()
  where
    fit :: (Int, Int) -> (Int, Int) -> (Int, Int, Int, Int)
    fit (tw, th) (iw0, ih0) =
        -- Scale down to width
        let iw1 = if iw0 > tw then tw else iw0
            ih1 = if iw0 > tw then ((ih0 * tw) `div` iw0) else ih0

        -- Scale down to height
            iw2 = if ih1 > th then ((iw1 * th) `div` ih1) else iw1
            ih2 = if ih1 > th then th else ih1

        -- Find position
            x = (tw - iw2) `div` 2
            y = (th - ih2) `div` 2 in

         (x, y, iw2, ih2)

main :: IO ()
main = do
    [path] <- getArgs
    w3m    <- findW3mImageDisplay
    drawImage w3m path