Image.hs

{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -Wall #-}

{- | Commands that operate on images, with ImageMagick (@identify@ and
@convert@).
-}
module Document.Build.Image (
  -- * Information
  readImageInfo,
  parseImageInfo,

  -- * Conversion
  imageConvert,
  imageConvertWith,
  imageConvertFirstFrame,
  imageResize,
  imageAppend,
) where

import Control.Lens (cloneLens, view)
import Control.Monad.Trans.Class (lift)
import Document.Build.Build (Command, createParentDirectory, expectOutput, failBuild, process, requireDirectory, requireInput)
import Document.Build.CommandLine (CommandLine (..))
import Document.Build.Error (BuildError (..), ReviewBuildError)
import Document.Build.Error.ProcessOutputUnrecognised (ProcessOutputUnrecognised (..))
import Document.Build.ImageInfo (ImageInfo (..))
import System.FilePath ((</>))
import System.FilePather.Name.PathFunction (PathFunctionLike (..))
import Text.Read (readMaybe)

{- $setup
>>> import Control.Lens (cloneLens, view)
>>> import Document.Build.Name.ImageWidth (imageWidth)
-}

-- | The @identify@ format that 'parseImageInfo' reads.
identifyFormat :: String
identifyFormat =
  "%m\\n%w\\n%h\\n%x\\n%y\\n%U\\n%[colorspace]\\n%z\\n%n\\n"

{- | Information about the image being operated on, from its first frame,
using @identify@.

@since 0.1.0.0
-}
readImageInfo :: (ReviewBuildError e) => Command e ImageInfo
readImageInfo =
  do
    i <- requireInput
    let c = CommandLine "identify" ["-format", identifyFormat, i <> "[0]"]
    o <- lift (process c)
    maybe
      (lift (failBuild (BuildErrorProcessOutputUnrecognised (ProcessOutputUnrecognised c "image format, width, height, resolution, units, colourspace, depth and frames"))))
      pure
      (parseImageInfo o)

{- | Parse the output of @identify@ with the format
@%m\\n%w\\n%h\\n%x\\n%y\\n%U\\n%[colorspace]\\n%z\\n%n\\n@. A resolution may
be followed by its units, which are ignored.

>>> fmap (view (cloneLens imageWidth)) (parseImageInfo "PNG\n3384\n262\n72\n72\nUndefined\nsRGB\n8\n1\n")
Just 3384

>>> parseImageInfo "PNG\n3384\n262\n72 PixelsPerInch\n72 PixelsPerInch\nPixelsPerInch\nsRGB\n8\n1\n"
Just (ImageInfo "PNG" 3384 262 72.0 72.0 "PixelsPerInch" "sRGB" 8 1)

>>> parseImageInfo "PNG\n"
Nothing

@since 0.1.0.0
-}
parseImageInfo :: String -> Maybe ImageInfo
parseImageInfo s =
  let number :: (Read a) => String -> Maybe a
      number x =
        case words x of
          (n : _) -> readMaybe n
          [] -> Nothing
   in case lines s of
        (m : w : h : x : y : u : c : z : n : _) ->
          ImageInfo m <$> number w <*> number h <*> number x <*> number y <*> pure u <*> pure c <*> number z <*> number n
        _ -> Nothing

{- | Convert the image being operated on to a file path, with the format given
by its extension, and return the file path.

@since 0.1.0.0
-}
imageConvert :: (ReviewBuildError e) => FilePath -> Command e FilePath
imageConvert =
  imageConvertWith []
{-# INLINE imageConvert #-}

{- | Convert the image being operated on with @convert@ and options that
follow the input file, writing to a file path, and return the file path.

@since 0.1.0.0
-}
imageConvertWith :: (ReviewBuildError e) => [String] -> FilePath -> Command e FilePath
imageConvertWith opts o =
  do
    i <- requireInput
    let c = CommandLine "convert" ([i] <> opts <> [o])
    lift (createParentDirectory o *> process c *> expectOutput c o)

{- | Convert the first frame of the image being operated on with @convert@
and options that follow the input file, writing to a file path, and return
the file path. Unlike 'imageConvertWith', an image with more than one frame,
such as an animated GIF, produces one file.

@since 0.1.0.0
-}
imageConvertFirstFrame :: (ReviewBuildError e) => [String] -> FilePath -> Command e FilePath
imageConvertFirstFrame opts o =
  do
    i <- requireInput
    let c = CommandLine "convert" ([i <> "[0]"] <> opts <> [o])
    lift (createParentDirectory o *> process c *> expectOutput c o)

{- | Resize the image being operated on to fit within a square of a number of
pixels, keeping its aspect ratio, writing to a file path, and return the file
path.

@since 0.1.0.0
-}
imageResize :: (ReviewBuildError e) => Int -> FilePath -> Command e FilePath
imageResize n =
  imageConvertWith ["-resize", show n <> "x" <> show n]
{-# INLINE imageResize #-}

{- | Join images in the directory being operated on, given by their paths
relative to it, side by side, from left to right, into a file path, and
return the file path.

@since 0.1.0.0
-}
imageAppend :: (ReviewBuildError e) => [FilePath] -> FilePath -> Command e FilePath
imageAppend fs o =
  do
    d <- requireDirectory
    let is = fmap (d </>) fs
        c = CommandLine "convert" (is <> ["+append", o])
    _ <- lift (traverse (view (cloneLens pathFunction) requireInput) is)
    lift (createParentDirectory o *> process c *> expectOutput c o)