diff --git a/massiv-io.cabal b/massiv-io.cabal --- a/massiv-io.cabal +++ b/massiv-io.cabal @@ -1,5 +1,5 @@ name: massiv-io -version: 0.1.2.0 +version: 0.1.3.0 synopsis: Import/export of Image files into massiv Arrays description: This package contains functionality for import/export of arrays into the real world. For now it only has the ability to read/write diff --git a/src/Data/Massiv/Array/IO.hs b/src/Data/Massiv/Array/IO.hs --- a/src/Data/Massiv/Array/IO.hs +++ b/src/Data/Massiv/Array/IO.hs @@ -14,26 +14,29 @@ -- Stability : experimental -- Portability : non-portable -- -module Data.Massiv.Array.IO ( - -- * Reading - readArray, readImage, readImageAuto, +module Data.Massiv.Array.IO + ( -- * Reading + readArray + , readImage + , readImageAuto -- * Writing - writeArray ,writeImage, writeImageAuto, + , writeArray + , writeImage + , writeImageAuto -- * Displaying - ExternalViewer(..), - displayImage, - displayImageUsing, - displayImageFile, + , ExternalViewer(..) + , displayImage + , displayImageUsing + , displayImageFile -- ** Common viewers - defaultViewer, - eogViewer, - gpicviewViewer, - fehViewer, - gimpViewer, + , defaultViewer + , eogViewer + , gpicviewViewer + , fehViewer + , gimpViewer -- * Supported Image Formats - module Data.Massiv.Array.IO.Base, - module Data.Massiv.Array.IO.Image - + , module Data.Massiv.Array.IO.Base + , module Data.Massiv.Array.IO.Image -- $supported ) where @@ -55,6 +58,9 @@ import System.IO (hClose, openBinaryTempFile) import System.Process (readProcess) + + + -- | External viewing application to use for displaying images. data ExternalViewer = ExternalViewer FilePath [String] Int @@ -130,13 +136,12 @@ --- | 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. +-- | This function 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 an @(`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. -- @@ -145,7 +150,7 @@ writeImage path = BL.writeFile path . encodeImage imageWriteFormats path - +-- | Write an image to file while performing all necessary precisiona and color space conversions. writeImageAuto :: ( Source r Ix2 (Pixel cs e) , ColorSpace cs e @@ -161,10 +166,6 @@ -- | 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. diff --git a/src/Data/Massiv/Array/IO/Base.hs b/src/Data/Massiv/Array/IO/Base.hs --- a/src/Data/Massiv/Array/IO/Base.hs +++ b/src/Data/Massiv/Array/IO/Base.hs @@ -1,8 +1,10 @@ {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} -- | -- Module : Data.Massiv.Array.IO.Base -- Copyright : (c) Alexey Kuleshevich 2018 @@ -29,11 +31,11 @@ , convertEither ) where -import Control.Exception (throw, Exception) -import Data.Massiv.Array (Array, Ix2) +import Control.Exception (Exception, throw) import qualified Data.ByteString as B (ByteString) import qualified Data.ByteString.Lazy as BL (ByteString) import Data.Default (Default (..)) +import Data.Massiv.Array import Data.Maybe (fromMaybe) import Data.Typeable import Graphics.ColorSpace (ColorSpace, Pixel) @@ -105,7 +107,9 @@ type WriteOptions (Auto f) = WriteOptions f ext (Auto f) = ext f + exts (Auto f) = exts f + -- | File formats that can be read into an Array. class Readable f arr where @@ -182,3 +186,4 @@ showsTypeRep (typeRep (Proxy :: Proxy e)) ">")) Right (conv eImg) + diff --git a/src/Data/Massiv/Array/IO/Image.hs b/src/Data/Massiv/Array/IO/Image.hs --- a/src/Data/Massiv/Array/IO/Image.hs +++ b/src/Data/Massiv/Array/IO/Image.hs @@ -52,12 +52,14 @@ instance Writable (Encode (Image r cs e)) (Image r cs e) where encode (EncodeAs f) _ = encode f (defaultWriteOptions f) - +-- | Encode an image into a lazy `BL.ByteString`, while selecting the appropriate format from the +-- file extension. encodeImage :: (Source r Ix2 (Pixel cs e), ColorSpace cs e) - => [Encode (Image r cs e)] - -> FilePath - -> Image r cs e + => [Encode (Image r cs e)] -- ^ List of image formats to choose from (useful lists are + -- `imageWriteFormats` and `imageWriteAutoFormats` + -> FilePath -- ^ File name with extension, so the format can be inferred + -> Image r cs e -- ^ Image to encode -> BL.ByteString encodeImage formats path img = do let ext' = P.map toLower . takeExtension $ path @@ -65,7 +67,7 @@ [] -> throw $ EncodeError $ "File format is not supported: " ++ ext' (f:_) -> encode f () img - +-- | List of image formats that can be encoded without any color space conversion. imageWriteFormats :: (Source r Ix2 (Pixel cs e), ColorSpace cs e) => [Encode (Image r cs e)] imageWriteFormats = [ EncodeAs BMP @@ -77,6 +79,7 @@ , EncodeAs TIF ] +-- | List of image formats that can be encoded with any necessary color space conversions. imageWriteAutoFormats :: ( Source r Ix2 (Pixel cs e) , ColorSpace cs e @@ -112,12 +115,13 @@ instance Readable (Decode (Image r cs e)) (Image r cs e) where decode (DecodeAs f) _ = decode f (defaultReadOptions f) - +-- | Decode an image from the strict `ByteString` while inferring format the image is encoded in +-- from the file extension decodeImage :: (Source r Ix2 (Pixel cs e), ColorSpace cs e) - => [Decode (Image r cs e)] - -> FilePath - -> B.ByteString + => [Decode (Image r cs e)] -- ^ List of available formats to choose from + -> FilePath -- ^ File name with extension, so format can be inferred + -> B.ByteString -- ^ Encoded image -> Image r cs e decodeImage formats path bs = do let ext' = P.map toLower . takeExtension $ path @@ -125,7 +129,7 @@ [] -> throw $ DecodeError $ "File format is not supported: " ++ ext' (f:_) -> decode f () bs - +-- | List of image formats decodable with no colorspace conversion imageReadFormats :: (Source S Ix2 (Pixel cs e), ColorSpace cs e) => [Decode (Image S cs e)] @@ -142,6 +146,7 @@ , DecodeAs PPM ] +-- | List of image formats decodable with no colorspace conversion imageReadAutoFormats :: (Mutable r Ix2 (Pixel cs e), ColorSpace cs e) => [Decode (Image r cs e)] diff --git a/src/Data/Massiv/Array/IO/Image/JuicyPixels.hs b/src/Data/Massiv/Array/IO/Image/JuicyPixels.hs --- a/src/Data/Massiv/Array/IO/Image/JuicyPixels.hs +++ b/src/Data/Massiv/Array/IO/Image/JuicyPixels.hs @@ -76,7 +76,7 @@ import Control.Exception import Control.Monad (guard, msum) import Data.Bifunctor -import qualified Data.ByteString as B (ByteString) +import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL (ByteString) import Data.Default (Default (..)) import Data.Massiv.Array as M @@ -84,6 +84,7 @@ import Data.Massiv.Array.Manifest.Vector import Data.Typeable import qualified Data.Vector.Storable as V +import Foreign.Storable (Storable (sizeOf)) import Graphics.ColorSpace -------------------------------------------------------------------------------- -- BMP Format ------------------------------------------------------------------ @@ -962,11 +963,10 @@ -- General decoding and helper functions --- | TODO: Validate size -fromJPImageUnsafe :: (Storable (Pixel cs e), JP.Pixel jpx) => +fromJPImageUnsafe :: forall jpx cs e . (Storable (Pixel cs e), JP.Pixel jpx) => JP.Image jpx -> Maybe (Image S cs e) fromJPImageUnsafe (JP.Image n m !v) = do - guard (n * m /= V.length v) + guard (n * m * sizeOf (undefined :: Pixel cs e) == V.length v) return $ fromVector Seq (m :. n) $ V.unsafeCast v {-# INLINE fromJPImageUnsafe #-} diff --git a/src/Data/Massiv/Array/IO/Image/Netpbm.hs b/src/Data/Massiv/Array/IO/Image/Netpbm.hs --- a/src/Data/Massiv/Array/IO/Image/Netpbm.hs +++ b/src/Data/Massiv/Array/IO/Image/Netpbm.hs @@ -109,6 +109,7 @@ instance FileFormat PPM where ext _ = ".ppm" + exts _ = [".ppm", ".pnm"] instance FileFormat (Sequence PPM) where type WriteOptions (Sequence PPM) = WriteOptions PPM @@ -160,12 +161,11 @@ {-# INLINE decodePPM #-} --- | TODO: validate sizes fromNetpbmImageUnsafe :: (Storable a, Storable (Pixel cs e)) - => (Int, Int) -> V.Vector a -> Maybe (Image S cs e) -fromNetpbmImageUnsafe (m, n) v = do - guard (n * m /= V.length v) + => Int -> Int -> V.Vector a -> Maybe (Image S cs e) +fromNetpbmImageUnsafe m n v = do + guard (n * m == V.length v) return $ fromVector Seq (m :. n) $ V.unsafeCast v @@ -184,34 +184,36 @@ :: forall cs e . (ColorSpace cs e, V.Storable (Pixel cs e)) => Netpbm.PPM -> Maybe (Image S cs e) fromNetpbmImage Netpbm.PPM {..} = do - let sz = (ppmHeight ppmHeader, ppmWidth ppmHeader) + let m = ppmHeight ppmHeader + n = ppmWidth ppmHeader case ppmData of PbmPixelData v -> do Refl <- eqT :: Maybe (Pixel cs e :~: Pixel X Bit) - fromNetpbmImageUnsafe sz v + fromNetpbmImageUnsafe m n v PgmPixelData8 v -> do Refl <- eqT :: Maybe (Pixel cs e :~: Pixel Y Word8) - fromNetpbmImageUnsafe sz v + fromNetpbmImageUnsafe m n v PgmPixelData16 v -> do Refl <- eqT :: Maybe (Pixel cs e :~: Pixel Y Word16) - fromNetpbmImageUnsafe sz v + fromNetpbmImageUnsafe m n v PpmPixelDataRGB8 v -> do Refl <- eqT :: Maybe (Pixel cs e :~: Pixel RGB Word8) - fromNetpbmImageUnsafe sz v + fromNetpbmImageUnsafe m n v PpmPixelDataRGB16 v -> do Refl <- eqT :: Maybe (Pixel cs e :~: Pixel RGB Word16) - fromNetpbmImageUnsafe sz v + fromNetpbmImageUnsafe m n v fromNetpbmImageAuto :: forall cs e r . (Mutable r Ix2 (Pixel cs e), ColorSpace cs e, V.Storable (Pixel cs e)) => Netpbm.PPM -> Maybe (Image r cs e) fromNetpbmImageAuto Netpbm.PPM {..} = do - let sz = (ppmHeight ppmHeader, ppmWidth ppmHeader) + let m = ppmHeight ppmHeader + n = ppmWidth ppmHeader case ppmData of PbmPixelData v -> - (fromNetpbmImageUnsafe sz v :: Maybe (Image S X Bit)) >>= (toAnyCS . M.map fromPixelBinary) + (fromNetpbmImageUnsafe m n v :: Maybe (Image S X Bit)) >>= (toAnyCS . M.map fromPixelBinary) PgmPixelData8 v -> - (fromNetpbmImageUnsafe sz v :: Maybe (Image S Y Word8)) >>= toAnyCS + (fromNetpbmImageUnsafe m n v :: Maybe (Image S Y Word8)) >>= toAnyCS PgmPixelData16 v -> - (fromNetpbmImageUnsafe sz v :: Maybe (Image S Y Word16)) >>= toAnyCS + (fromNetpbmImageUnsafe m n v :: Maybe (Image S Y Word16)) >>= toAnyCS PpmPixelDataRGB8 v -> - (fromNetpbmImageUnsafe sz v :: Maybe (Image S RGB Word8)) >>= toAnyCS + (fromNetpbmImageUnsafe m n v :: Maybe (Image S RGB Word8)) >>= toAnyCS PpmPixelDataRGB16 v -> - (fromNetpbmImageUnsafe sz v :: Maybe (Image S RGB Word16)) >>= toAnyCS + (fromNetpbmImageUnsafe m n v :: Maybe (Image S RGB Word16)) >>= toAnyCS