{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} -- | -- Module : Data.Massiv.Array.IO -- Copyright : (c) Alexey Kuleshevich 2018 -- License : BSD3 -- Maintainer : Alexey Kuleshevich -- Stability : experimental -- Portability : non-portable -- module Data.Massiv.Array.IO ( -- * Reading readArray, readImage, readImageAuto, -- * Writing writeArray ,writeImage, writeImageAuto, -- * Displaying ExternalViewer(..), displayImage, displayImageUsing, displayImageFile, -- ** Common viewers defaultViewer, eogViewer, gpicviewViewer, fehViewer, gimpViewer, -- * Supported Image Formats module Data.Massiv.Array.IO.Base, module Data.Massiv.Array.IO.Image -- $supported ) where import Control.Concurrent (forkIO) import Control.Exception (bracket) import Control.Monad (void) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import Data.Massiv.Array as A import Data.Massiv.Array.IO.Base hiding (convertEither, fromEitherDecode, fromMaybeEncode, toProxy) import Data.Massiv.Array.IO.Image import Graphics.ColorSpace import Prelude as P hiding (readFile, writeFile) import System.Directory (createDirectoryIfMissing, getTemporaryDirectory) import System.FilePath import System.IO (hClose, openBinaryTempFile) import System.Process (readProcess) -- | External viewing application to use for displaying images. data ExternalViewer = ExternalViewer FilePath [String] Int -- ^ Any custom viewer, which can be specified: -- -- * @FilePath@ - to the actual viewer executable. -- * @[String]@ - command line arguments that will be passed to the executable. -- * @Int@ - position index in the above list where `FilePath` to an image should be -- injected deriving Show -- | Read an array from one of the supported file formats. readArray :: Readable f arr => f -- ^ File format that should be used while decoding the file -> ReadOptions f -- ^ Any file format related decoding options. Use `def` for default. -> FilePath -- ^ Path to the file -> IO arr readArray format opts path = decode format opts <$> B.readFile path {-# INLINE readArray #-} writeArray :: Writable f arr => f -- ^ Format to use while encoding the array -> WriteOptions f -- ^ Any file format related encoding options. Use `def` for default. -> FilePath -> arr -> IO () writeArray format opts path arr = BL.writeFile path (encode format opts arr) {-# INLINE writeArray #-} -- | Try to guess an image format from file's extension, then attempt to decode it as such. In order -- to supply the format manually and thus avoid this guessing technique, use `readArray` -- instead. Color space and precision of the result array must match exactly that of the actual -- image, in order to apply auto conversion use `readImageAuto` instead. -- -- Might throw `ConvertError`, `DecodeError` and other standard errors related to file IO. -- -- Result image will be read as specified by the type signature: -- -- >>> frog <- readImage "files/frog.jpg" :: IO (Image S YCbCr Word8) -- >>> displayImage frog -- -- In case when the result image type does not match the color space or precision of the actual -- image file, `ConvertError` will be thrown. -- -- >>> frog <- readImage "files/frog.jpg" :: IO (Image S CMYK Word8) -- >>> displayImage frog -- *** Exception: ConvertError "Cannot decode JPG image as " -- -- Whenever image is not in the color space or precision that we need, either use `readImageAuto` or -- manually convert to the desired one by using the appropriate conversion functions: -- -- >>> frogCMYK <- readImageAuto "files/frog.jpg" :: IO (Image S CMYK Double) -- >>> displayImage frogCMYK -- readImage :: (Source S Ix2 (Pixel cs e), ColorSpace cs e) => FilePath -- ^ File path for an image -> IO (Image S cs e) readImage path = decodeImage imageReadFormats path <$> B.readFile path {-# INLINE readImage #-} -- | Same as `readImage`, but will perform any possible color space and -- precision conversions in order to match the result image type. Very useful -- whenever image format isn't known at compile time. readImageAuto :: (Mutable r Ix2 (Pixel cs e), ColorSpace cs e) => FilePath -- ^ File path for an image -> IO (Image r cs e) readImageAuto path = decodeImage imageReadAutoFormats path <$> B.readFile path {-# INLINE readImageAuto #-} -- | Inverse of the 'readImage', but similarly to it, will guess an output file format from the file -- extension and will write to file any image with the colorspace that is supported by that -- format. Precision of the image might be adjusted using `Elevator` if precision of the source -- array is not supported by the image file format. For instance, <'Image' @r@ 'RGBA' 'Double'> -- being saved as 'PNG' file would be written as <'Image' @r@ 'RGBA' 'Word16'>, thus using highest -- supported precision 'Word16' for that format. If automatic colors space is also desired, -- `writeImageAuto` can be used instead. -- -- Can throw `ConvertError`, `EncodeError` and other usual IO errors. -- writeImage :: (Source r Ix2 (Pixel cs e), ColorSpace cs e) => FilePath -> Image r cs e -> IO () writeImage path = BL.writeFile path . encodeImage imageWriteFormats path writeImageAuto :: ( Source r Ix2 (Pixel cs e) , ColorSpace cs e , ToYA cs e , ToRGBA cs e , ToYCbCr cs e , ToCMYK cs e ) => FilePath -> Image r cs e -> IO () writeImageAuto path = BL.writeFile path . encodeImage imageWriteAutoFormats path -- | An image is written as a @.tiff@ file into an operating system's temporary -- directory and passed as an argument to the external viewer program. -- displayImageUsing :: Writable (Auto TIF) (Image r cs e) => -- ExternalViewer -- ^ Image viewer program -- -> Bool -- ^ Should a call block the cuurrent thread untul viewer is closed. -- -> Image r cs e -> IO () displayImageUsing :: Writable (Auto TIF) (Image r cs e) => ExternalViewer -- ^ Image viewer program -> Bool -- ^ Should a call block the cuurrent thread untul viewer is closed. -> Image r cs e -> IO () displayImageUsing viewer block img = if block then display else img `seq` void (forkIO display) where display = do tmpDir <- fmap ( "hip") getTemporaryDirectory createDirectoryIfMissing True tmpDir bracket (openBinaryTempFile tmpDir "tmp-img.tiff") (hClose . snd) (\(imgPath, imgHandle) -> do BL.hPut imgHandle (encode (Auto TIF) () img) hClose imgHandle displayImageFile viewer imgPath) -- | Displays an image file by calling an external image viewer. displayImageFile :: ExternalViewer -> FilePath -> IO () displayImageFile (ExternalViewer exe args ix) imgPath = void $ readProcess exe (argsBefore ++ [imgPath] ++ argsAfter) "" where (argsBefore, argsAfter) = P.splitAt ix args -- | Makes a call to an external viewer that is set as a default image viewer by -- the OS. This is a non-blocking function call, so it might take some time -- before an image will appear. displayImage :: Writable (Auto TIF) (Image r cs e) => Image r cs e -> IO () displayImage = displayImageUsing defaultViewer False -- | Default viewer is inferred from the operating system. defaultViewer :: ExternalViewer defaultViewer = #if defined(OS_Win32) ExternalViewer "explorer.exe" [] 0 #elif defined(OS_Linux) ExternalViewer "xdg-open" [] 0 #elif defined(OS_Mac) ExternalViewer "open" [] 0 #else error "Graphics.Image.IO.defaultViewer: Could not determine default viewer." #endif -- | @eog \/tmp\/hip\/img.tiff@ -- -- eogViewer :: ExternalViewer eogViewer = ExternalViewer "eog" [] 0 -- | @feh --fullscreen --auto-zoom \/tmp\/hip\/img.tiff@ -- -- fehViewer :: ExternalViewer fehViewer = ExternalViewer "feh" ["--fullscreen", "--auto-zoom"] 2 -- | @gpicview \/tmp\/hip\/img.tiff@ -- -- gpicviewViewer :: ExternalViewer gpicviewViewer = ExternalViewer "gpicview" [] 0 -- | @gimp \/tmp\/hip\/img.tiff@ -- -- gimpViewer :: ExternalViewer gimpViewer = ExternalViewer "gimp" [] 0 {- $supported Encoding and decoding of images is done using and packages. List of image formats that are currently supported, and their exact 'ColorSpace's and precision for reading and writing without an implicit conversion: * 'BMP': * __read__: ('Y' 'Word8'), ('RGB' 'Word8'), ('RGBA' 'Word8') * __write__: ('Y' 'Word8'), ('RGB' 'Word8'), ('RGBA' 'Word8') * 'GIF': * __read__: ('RGB' 'Word8'), ('RGBA' 'Word8') * __write__: ('RGB' 'Word8') * Also supports reading and writing animated images, when used as @'GIFA'@ * 'HDR': * __read__: ('RGB' 'Float') * __write__: ('RGB' 'Float') * 'JPG': * __read__: ('Y' 'Word8'), ('YA' 'Word8'), ('RGB' 'Word8'), ('CMYK' 'Word8'), ('YCbCr', 'Word8') * __write__: ('Y' 'Word8'), ('YA', 'Word8'), ('RGB' 'Word8'), ('CMYK' 'Word8'), ('YCbCr', 'Word8') * 'PNG': * __read__: ('Y' 'Word8'), ('Y' 'Word16'), ('YA' 'Word8'), ('YA' 'Word16'), ('RGB' 'Word8'), ('RGB' 'Word16'), ('RGBA' 'Word8'), ('RGBA' 'Word16') * __write__: ('Y' 'Word8'), ('Y' 'Word16'), ('YA' 'Word8'), ('YA' 'Word16'), ('RGB' 'Word8'), ('RGB' 'Word16'), ('RGBA' 'Word8'), ('RGBA' 'Word16') * 'TGA': * __read__: ('Y' 'Word8'), ('RGB' 'Word8'), ('RGBA' 'Word8') * __write__: ('Y' 'Word8'), ('RGB' 'Word8'), ('RGBA' 'Word8') * 'TIF': * __read__: ('Y' 'Word8'), ('Y' 'Word16'), ('YA' 'Word8'), ('YA' 'Word16'), ('RGB' 'Word8'), ('RGB' 'Word16'), ('RGBA' 'Word8'), ('RGBA' 'Word16'), ('CMYK' 'Word8'), ('CMYK' 'Word16') * __write__: ('Y' 'Word8'), ('Y' 'Word16'), ('YA' 'Word8'), ('YA' 'Word16'), ('RGB' 'Word8'), ('RGB' 'Word16'), ('RGBA' 'Word8'), ('RGBA' 'Word16') ('CMYK' 'Word8'), ('CMYK' 'Word16'), ('YCbCr' 'Word8') * 'PBM': * __read__: ('Binary' 'Bit') * Also supports sequence of images in one file, when read as @['PBM']@ * 'PGM': * __read__: ('Y' 'Word8'), ('Y' 'Word16') * Also supports sequence of images in one file, when read as @['PGM']@ * 'PPM': * __read__: ('RGB' 'Word8'), ('RGB' 'Word16') * Also supports sequence of images in one file, when read as @['PPM']@ -}