{-# LANGUAGE OverloadedStrings, NamedFieldPuns #-}
{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies, MultiParamTypeClasses, TemplateHaskell #-}
module Graphics.Netpbm (
PPMType (..)
, PPM (..)
, PpmPixelRGB8 (..)
, PpmPixelRGB16 (..)
, PbmPixel (..)
, PgmPixel8 (..)
, PgmPixel16 (..)
, PPMHeader (..)
, PpmPixelData (..)
, pixelVectorToList
, pixelDataToIntList
, parsePPM
, PpmParseResult
) where
import Control.Monad
import Control.Applicative
import Data.Attoparsec.ByteString as A
import Data.Attoparsec.ByteString.Char8 as A8
import Data.Attoparsec.Binary (anyWord16be)
import Data.Bits (testBit)
import Data.ByteString (ByteString)
import Data.Char (chr, ord)
import Data.List (foldl')
import Data.Word (Word8, Word16)
import Foreign.Storable.Record as Store
import Foreign.Storable (Storable (..))
import qualified Data.Vector.Storable as S
import Data.Vector.Storable ((!))
import qualified Data.Vector.Storable.Mutable as SM
import Data.Vector.Unboxed.Deriving
data PPMType = P1
| P2
| P3
| P4
| P5
| P6
deriving (PPMType -> PPMType -> Bool
(PPMType -> PPMType -> Bool)
-> (PPMType -> PPMType -> Bool) -> Eq PPMType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PPMType -> PPMType -> Bool
$c/= :: PPMType -> PPMType -> Bool
== :: PPMType -> PPMType -> Bool
$c== :: PPMType -> PPMType -> Bool
Eq, Int -> PPMType -> ShowS
[PPMType] -> ShowS
PPMType -> String
(Int -> PPMType -> ShowS)
-> (PPMType -> String) -> ([PPMType] -> ShowS) -> Show PPMType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PPMType] -> ShowS
$cshowList :: [PPMType] -> ShowS
show :: PPMType -> String
$cshow :: PPMType -> String
showsPrec :: Int -> PPMType -> ShowS
$cshowsPrec :: Int -> PPMType -> ShowS
Show, Int -> PPMType
PPMType -> Int
PPMType -> [PPMType]
PPMType -> PPMType
PPMType -> PPMType -> [PPMType]
PPMType -> PPMType -> PPMType -> [PPMType]
(PPMType -> PPMType)
-> (PPMType -> PPMType)
-> (Int -> PPMType)
-> (PPMType -> Int)
-> (PPMType -> [PPMType])
-> (PPMType -> PPMType -> [PPMType])
-> (PPMType -> PPMType -> [PPMType])
-> (PPMType -> PPMType -> PPMType -> [PPMType])
-> Enum PPMType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: PPMType -> PPMType -> PPMType -> [PPMType]
$cenumFromThenTo :: PPMType -> PPMType -> PPMType -> [PPMType]
enumFromTo :: PPMType -> PPMType -> [PPMType]
$cenumFromTo :: PPMType -> PPMType -> [PPMType]
enumFromThen :: PPMType -> PPMType -> [PPMType]
$cenumFromThen :: PPMType -> PPMType -> [PPMType]
enumFrom :: PPMType -> [PPMType]
$cenumFrom :: PPMType -> [PPMType]
fromEnum :: PPMType -> Int
$cfromEnum :: PPMType -> Int
toEnum :: Int -> PPMType
$ctoEnum :: Int -> PPMType
pred :: PPMType -> PPMType
$cpred :: PPMType -> PPMType
succ :: PPMType -> PPMType
$csucc :: PPMType -> PPMType
Enum, Eq PPMType
Eq PPMType
-> (PPMType -> PPMType -> Ordering)
-> (PPMType -> PPMType -> Bool)
-> (PPMType -> PPMType -> Bool)
-> (PPMType -> PPMType -> Bool)
-> (PPMType -> PPMType -> Bool)
-> (PPMType -> PPMType -> PPMType)
-> (PPMType -> PPMType -> PPMType)
-> Ord PPMType
PPMType -> PPMType -> Bool
PPMType -> PPMType -> Ordering
PPMType -> PPMType -> PPMType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PPMType -> PPMType -> PPMType
$cmin :: PPMType -> PPMType -> PPMType
max :: PPMType -> PPMType -> PPMType
$cmax :: PPMType -> PPMType -> PPMType
>= :: PPMType -> PPMType -> Bool
$c>= :: PPMType -> PPMType -> Bool
> :: PPMType -> PPMType -> Bool
$c> :: PPMType -> PPMType -> Bool
<= :: PPMType -> PPMType -> Bool
$c<= :: PPMType -> PPMType -> Bool
< :: PPMType -> PPMType -> Bool
$c< :: PPMType -> PPMType -> Bool
compare :: PPMType -> PPMType -> Ordering
$ccompare :: PPMType -> PPMType -> Ordering
$cp1Ord :: Eq PPMType
Ord)
data PPM = PPM {
:: PPMHeader
, PPM -> PpmPixelData
ppmData :: PpmPixelData
}
data = {
PPMHeader -> PPMType
ppmType :: !PPMType
, PPMHeader -> Int
ppmWidth :: !Int
, PPMHeader -> Int
ppmHeight :: !Int
} deriving (PPMHeader -> PPMHeader -> Bool
(PPMHeader -> PPMHeader -> Bool)
-> (PPMHeader -> PPMHeader -> Bool) -> Eq PPMHeader
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PPMHeader -> PPMHeader -> Bool
$c/= :: PPMHeader -> PPMHeader -> Bool
== :: PPMHeader -> PPMHeader -> Bool
$c== :: PPMHeader -> PPMHeader -> Bool
Eq, Int -> PPMHeader -> ShowS
[PPMHeader] -> ShowS
PPMHeader -> String
(Int -> PPMHeader -> ShowS)
-> (PPMHeader -> String)
-> ([PPMHeader] -> ShowS)
-> Show PPMHeader
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PPMHeader] -> ShowS
$cshowList :: [PPMHeader] -> ShowS
show :: PPMHeader -> String
$cshow :: PPMHeader -> String
showsPrec :: Int -> PPMHeader -> ShowS
$cshowsPrec :: Int -> PPMHeader -> ShowS
Show)
instance Show PPM where
show :: PPM -> String
show PPM { ppmHeader :: PPM -> PPMHeader
ppmHeader = PPMHeader { PPMType
ppmType :: PPMType
ppmType :: PPMHeader -> PPMType
ppmType, Int
ppmWidth :: Int
ppmWidth :: PPMHeader -> Int
ppmWidth, Int
ppmHeight :: Int
ppmHeight :: PPMHeader -> Int
ppmHeight } } = String
"PPM " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PPMType -> String
forall a. Show a => a -> String
show PPMType
ppmType String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" image " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
dim
where
dim :: String
dim = (Int, Int) -> String
forall a. Show a => a -> String
show (Int
ppmWidth, Int
ppmHeight)
data PpmPixelRGB8 = PpmPixelRGB8 {-# UNPACK #-} !Word8
{-# UNPACK #-} !Word8
{-# UNPACK #-} !Word8
deriving (PpmPixelRGB8 -> PpmPixelRGB8 -> Bool
(PpmPixelRGB8 -> PpmPixelRGB8 -> Bool)
-> (PpmPixelRGB8 -> PpmPixelRGB8 -> Bool) -> Eq PpmPixelRGB8
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PpmPixelRGB8 -> PpmPixelRGB8 -> Bool
$c/= :: PpmPixelRGB8 -> PpmPixelRGB8 -> Bool
== :: PpmPixelRGB8 -> PpmPixelRGB8 -> Bool
$c== :: PpmPixelRGB8 -> PpmPixelRGB8 -> Bool
Eq, Int -> PpmPixelRGB8 -> ShowS
[PpmPixelRGB8] -> ShowS
PpmPixelRGB8 -> String
(Int -> PpmPixelRGB8 -> ShowS)
-> (PpmPixelRGB8 -> String)
-> ([PpmPixelRGB8] -> ShowS)
-> Show PpmPixelRGB8
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PpmPixelRGB8] -> ShowS
$cshowList :: [PpmPixelRGB8] -> ShowS
show :: PpmPixelRGB8 -> String
$cshow :: PpmPixelRGB8 -> String
showsPrec :: Int -> PpmPixelRGB8 -> ShowS
$cshowsPrec :: Int -> PpmPixelRGB8 -> ShowS
Show)
data PpmPixelRGB16 = PpmPixelRGB16 {-# UNPACK #-} !Word16
{-# UNPACK #-} !Word16
{-# UNPACK #-} !Word16
deriving (PpmPixelRGB16 -> PpmPixelRGB16 -> Bool
(PpmPixelRGB16 -> PpmPixelRGB16 -> Bool)
-> (PpmPixelRGB16 -> PpmPixelRGB16 -> Bool) -> Eq PpmPixelRGB16
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PpmPixelRGB16 -> PpmPixelRGB16 -> Bool
$c/= :: PpmPixelRGB16 -> PpmPixelRGB16 -> Bool
== :: PpmPixelRGB16 -> PpmPixelRGB16 -> Bool
$c== :: PpmPixelRGB16 -> PpmPixelRGB16 -> Bool
Eq, Int -> PpmPixelRGB16 -> ShowS
[PpmPixelRGB16] -> ShowS
PpmPixelRGB16 -> String
(Int -> PpmPixelRGB16 -> ShowS)
-> (PpmPixelRGB16 -> String)
-> ([PpmPixelRGB16] -> ShowS)
-> Show PpmPixelRGB16
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PpmPixelRGB16] -> ShowS
$cshowList :: [PpmPixelRGB16] -> ShowS
show :: PpmPixelRGB16 -> String
$cshow :: PpmPixelRGB16 -> String
showsPrec :: Int -> PpmPixelRGB16 -> ShowS
$cshowsPrec :: Int -> PpmPixelRGB16 -> ShowS
Show)
newtype PbmPixel = PbmPixel Bool
deriving (PbmPixel -> PbmPixel -> Bool
(PbmPixel -> PbmPixel -> Bool)
-> (PbmPixel -> PbmPixel -> Bool) -> Eq PbmPixel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PbmPixel -> PbmPixel -> Bool
$c/= :: PbmPixel -> PbmPixel -> Bool
== :: PbmPixel -> PbmPixel -> Bool
$c== :: PbmPixel -> PbmPixel -> Bool
Eq, Int -> PbmPixel -> ShowS
[PbmPixel] -> ShowS
PbmPixel -> String
(Int -> PbmPixel -> ShowS)
-> (PbmPixel -> String) -> ([PbmPixel] -> ShowS) -> Show PbmPixel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PbmPixel] -> ShowS
$cshowList :: [PbmPixel] -> ShowS
show :: PbmPixel -> String
$cshow :: PbmPixel -> String
showsPrec :: Int -> PbmPixel -> ShowS
$cshowsPrec :: Int -> PbmPixel -> ShowS
Show)
data PgmPixel8 = PgmPixel8 {-# UNPACK #-} !Word8
deriving (PgmPixel8 -> PgmPixel8 -> Bool
(PgmPixel8 -> PgmPixel8 -> Bool)
-> (PgmPixel8 -> PgmPixel8 -> Bool) -> Eq PgmPixel8
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PgmPixel8 -> PgmPixel8 -> Bool
$c/= :: PgmPixel8 -> PgmPixel8 -> Bool
== :: PgmPixel8 -> PgmPixel8 -> Bool
$c== :: PgmPixel8 -> PgmPixel8 -> Bool
Eq, Int -> PgmPixel8 -> ShowS
[PgmPixel8] -> ShowS
PgmPixel8 -> String
(Int -> PgmPixel8 -> ShowS)
-> (PgmPixel8 -> String)
-> ([PgmPixel8] -> ShowS)
-> Show PgmPixel8
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PgmPixel8] -> ShowS
$cshowList :: [PgmPixel8] -> ShowS
show :: PgmPixel8 -> String
$cshow :: PgmPixel8 -> String
showsPrec :: Int -> PgmPixel8 -> ShowS
$cshowsPrec :: Int -> PgmPixel8 -> ShowS
Show)
data PgmPixel16 = PgmPixel16 {-# UNPACK #-} !Word16
deriving (PgmPixel16 -> PgmPixel16 -> Bool
(PgmPixel16 -> PgmPixel16 -> Bool)
-> (PgmPixel16 -> PgmPixel16 -> Bool) -> Eq PgmPixel16
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PgmPixel16 -> PgmPixel16 -> Bool
$c/= :: PgmPixel16 -> PgmPixel16 -> Bool
== :: PgmPixel16 -> PgmPixel16 -> Bool
$c== :: PgmPixel16 -> PgmPixel16 -> Bool
Eq, Int -> PgmPixel16 -> ShowS
[PgmPixel16] -> ShowS
PgmPixel16 -> String
(Int -> PgmPixel16 -> ShowS)
-> (PgmPixel16 -> String)
-> ([PgmPixel16] -> ShowS)
-> Show PgmPixel16
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PgmPixel16] -> ShowS
$cshowList :: [PgmPixel16] -> ShowS
show :: PgmPixel16 -> String
$cshow :: PgmPixel16 -> String
showsPrec :: Int -> PgmPixel16 -> ShowS
$cshowsPrec :: Int -> PgmPixel16 -> ShowS
Show)
data PpmPixelData = PpmPixelDataRGB8 (S.Vector PpmPixelRGB8)
| PpmPixelDataRGB16 (S.Vector PpmPixelRGB16)
| PbmPixelData (S.Vector PbmPixel)
| PgmPixelData8 (S.Vector PgmPixel8)
| PgmPixelData16 (S.Vector PgmPixel16)
pixelVectorToList :: (Storable a) => S.Vector a -> [a]
pixelVectorToList :: Vector a -> [a]
pixelVectorToList = Vector a -> [a]
forall a. Storable a => Vector a -> [a]
S.toList
pixelDataToIntList :: PpmPixelData -> [Int]
pixelDataToIntList :: PpmPixelData -> [Int]
pixelDataToIntList PpmPixelData
d = case PpmPixelData
d of
PpmPixelDataRGB8 Vector PpmPixelRGB8
v -> [[Int]] -> [Int]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ (Word8 -> Int) -> [Word8] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Word8
r, Word8
g, Word8
b] | PpmPixelRGB8 Word8
r Word8
g Word8
b <- Vector PpmPixelRGB8 -> [PpmPixelRGB8]
forall a. Storable a => Vector a -> [a]
S.toList Vector PpmPixelRGB8
v ]
PpmPixelDataRGB16 Vector PpmPixelRGB16
v -> [[Int]] -> [Int]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ (Word16 -> Int) -> [Word16] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Word16
r, Word16
g, Word16
b] | PpmPixelRGB16 Word16
r Word16
g Word16
b <- Vector PpmPixelRGB16 -> [PpmPixelRGB16]
forall a. Storable a => Vector a -> [a]
S.toList Vector PpmPixelRGB16
v ]
PbmPixelData Vector PbmPixel
v -> [ if Bool
b then Int
1 else Int
0 | PbmPixel Bool
b <- Vector PbmPixel -> [PbmPixel]
forall a. Storable a => Vector a -> [a]
S.toList Vector PbmPixel
v ]
PgmPixelData8 Vector PgmPixel8
v -> [ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x | PgmPixel8 Word8
x <- Vector PgmPixel8 -> [PgmPixel8]
forall a. Storable a => Vector a -> [a]
S.toList Vector PgmPixel8
v ]
PgmPixelData16 Vector PgmPixel16
v -> [ Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
x | PgmPixel16 Word16
x <- Vector PgmPixel16 -> [PgmPixel16]
forall a. Storable a => Vector a -> [a]
S.toList Vector PgmPixel16
v ]
storePpmPixel8 :: Store.Dictionary PpmPixelRGB8
storePpmPixel8 :: Dictionary PpmPixelRGB8
storePpmPixel8 =
Access PpmPixelRGB8 PpmPixelRGB8 -> Dictionary PpmPixelRGB8
forall r. Access r r -> Dictionary r
Store.run (Access PpmPixelRGB8 PpmPixelRGB8 -> Dictionary PpmPixelRGB8)
-> Access PpmPixelRGB8 PpmPixelRGB8 -> Dictionary PpmPixelRGB8
forall a b. (a -> b) -> a -> b
$ (Word8 -> Word8 -> Word8 -> PpmPixelRGB8)
-> Access PpmPixelRGB8 Word8
-> Access PpmPixelRGB8 Word8
-> Access PpmPixelRGB8 Word8
-> Access PpmPixelRGB8 PpmPixelRGB8
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 Word8 -> Word8 -> Word8 -> PpmPixelRGB8
PpmPixelRGB8
((PpmPixelRGB8 -> Word8) -> Access PpmPixelRGB8 Word8
forall a r. Storable a => (r -> a) -> Access r a
Store.element (\(PpmPixelRGB8 Word8
x Word8
_ Word8
_) -> Word8
x))
((PpmPixelRGB8 -> Word8) -> Access PpmPixelRGB8 Word8
forall a r. Storable a => (r -> a) -> Access r a
Store.element (\(PpmPixelRGB8 Word8
_ Word8
y Word8
_) -> Word8
y))
((PpmPixelRGB8 -> Word8) -> Access PpmPixelRGB8 Word8
forall a r. Storable a => (r -> a) -> Access r a
Store.element (\(PpmPixelRGB8 Word8
_ Word8
_ Word8
z) -> Word8
z))
storePpmPixel16 :: Store.Dictionary PpmPixelRGB16
storePpmPixel16 :: Dictionary PpmPixelRGB16
storePpmPixel16 =
Access PpmPixelRGB16 PpmPixelRGB16 -> Dictionary PpmPixelRGB16
forall r. Access r r -> Dictionary r
Store.run (Access PpmPixelRGB16 PpmPixelRGB16 -> Dictionary PpmPixelRGB16)
-> Access PpmPixelRGB16 PpmPixelRGB16 -> Dictionary PpmPixelRGB16
forall a b. (a -> b) -> a -> b
$ (Word16 -> Word16 -> Word16 -> PpmPixelRGB16)
-> Access PpmPixelRGB16 Word16
-> Access PpmPixelRGB16 Word16
-> Access PpmPixelRGB16 Word16
-> Access PpmPixelRGB16 PpmPixelRGB16
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 Word16 -> Word16 -> Word16 -> PpmPixelRGB16
PpmPixelRGB16
((PpmPixelRGB16 -> Word16) -> Access PpmPixelRGB16 Word16
forall a r. Storable a => (r -> a) -> Access r a
Store.element (\(PpmPixelRGB16 Word16
x Word16
_ Word16
_) -> Word16
x))
((PpmPixelRGB16 -> Word16) -> Access PpmPixelRGB16 Word16
forall a r. Storable a => (r -> a) -> Access r a
Store.element (\(PpmPixelRGB16 Word16
_ Word16
y Word16
_) -> Word16
y))
((PpmPixelRGB16 -> Word16) -> Access PpmPixelRGB16 Word16
forall a r. Storable a => (r -> a) -> Access r a
Store.element (\(PpmPixelRGB16 Word16
_ Word16
_ Word16
z) -> Word16
z))
storePbmPixel :: Store.Dictionary PbmPixel
storePbmPixel :: Dictionary PbmPixel
storePbmPixel =
Access PbmPixel PbmPixel -> Dictionary PbmPixel
forall r. Access r r -> Dictionary r
Store.run (Access PbmPixel PbmPixel -> Dictionary PbmPixel)
-> Access PbmPixel PbmPixel -> Dictionary PbmPixel
forall a b. (a -> b) -> a -> b
$ (Bool -> PbmPixel)
-> Access PbmPixel Bool -> Access PbmPixel PbmPixel
forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA Bool -> PbmPixel
PbmPixel
((PbmPixel -> Bool) -> Access PbmPixel Bool
forall a r. Storable a => (r -> a) -> Access r a
Store.element (\(PbmPixel Bool
x) -> Bool
x))
storePgmPixel8 :: Store.Dictionary PgmPixel8
storePgmPixel8 :: Dictionary PgmPixel8
storePgmPixel8 =
Access PgmPixel8 PgmPixel8 -> Dictionary PgmPixel8
forall r. Access r r -> Dictionary r
Store.run (Access PgmPixel8 PgmPixel8 -> Dictionary PgmPixel8)
-> Access PgmPixel8 PgmPixel8 -> Dictionary PgmPixel8
forall a b. (a -> b) -> a -> b
$ (Word8 -> PgmPixel8)
-> Access PgmPixel8 Word8 -> Access PgmPixel8 PgmPixel8
forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA Word8 -> PgmPixel8
PgmPixel8
((PgmPixel8 -> Word8) -> Access PgmPixel8 Word8
forall a r. Storable a => (r -> a) -> Access r a
Store.element (\(PgmPixel8 Word8
x) -> Word8
x))
storePgmPixel16 :: Store.Dictionary PgmPixel16
storePgmPixel16 :: Dictionary PgmPixel16
storePgmPixel16 =
Access PgmPixel16 PgmPixel16 -> Dictionary PgmPixel16
forall r. Access r r -> Dictionary r
Store.run (Access PgmPixel16 PgmPixel16 -> Dictionary PgmPixel16)
-> Access PgmPixel16 PgmPixel16 -> Dictionary PgmPixel16
forall a b. (a -> b) -> a -> b
$ (Word16 -> PgmPixel16)
-> Access PgmPixel16 Word16 -> Access PgmPixel16 PgmPixel16
forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA Word16 -> PgmPixel16
PgmPixel16
((PgmPixel16 -> Word16) -> Access PgmPixel16 Word16
forall a r. Storable a => (r -> a) -> Access r a
Store.element (\(PgmPixel16 Word16
x) -> Word16
x))
instance Storable PpmPixelRGB8 where
sizeOf :: PpmPixelRGB8 -> Int
sizeOf = Dictionary PpmPixelRGB8 -> PpmPixelRGB8 -> Int
forall r. Dictionary r -> r -> Int
Store.sizeOf Dictionary PpmPixelRGB8
storePpmPixel8
alignment :: PpmPixelRGB8 -> Int
alignment = Dictionary PpmPixelRGB8 -> PpmPixelRGB8 -> Int
forall r. Dictionary r -> r -> Int
Store.alignment Dictionary PpmPixelRGB8
storePpmPixel8
peek :: Ptr PpmPixelRGB8 -> IO PpmPixelRGB8
peek = Dictionary PpmPixelRGB8 -> Ptr PpmPixelRGB8 -> IO PpmPixelRGB8
forall r. Dictionary r -> Ptr r -> IO r
Store.peek Dictionary PpmPixelRGB8
storePpmPixel8
poke :: Ptr PpmPixelRGB8 -> PpmPixelRGB8 -> IO ()
poke = Dictionary PpmPixelRGB8
-> Ptr PpmPixelRGB8 -> PpmPixelRGB8 -> IO ()
forall r. Dictionary r -> Ptr r -> r -> IO ()
Store.poke Dictionary PpmPixelRGB8
storePpmPixel8
instance Storable PpmPixelRGB16 where
sizeOf :: PpmPixelRGB16 -> Int
sizeOf = Dictionary PpmPixelRGB16 -> PpmPixelRGB16 -> Int
forall r. Dictionary r -> r -> Int
Store.sizeOf Dictionary PpmPixelRGB16
storePpmPixel16
alignment :: PpmPixelRGB16 -> Int
alignment = Dictionary PpmPixelRGB16 -> PpmPixelRGB16 -> Int
forall r. Dictionary r -> r -> Int
Store.alignment Dictionary PpmPixelRGB16
storePpmPixel16
peek :: Ptr PpmPixelRGB16 -> IO PpmPixelRGB16
peek = Dictionary PpmPixelRGB16 -> Ptr PpmPixelRGB16 -> IO PpmPixelRGB16
forall r. Dictionary r -> Ptr r -> IO r
Store.peek Dictionary PpmPixelRGB16
storePpmPixel16
poke :: Ptr PpmPixelRGB16 -> PpmPixelRGB16 -> IO ()
poke = Dictionary PpmPixelRGB16
-> Ptr PpmPixelRGB16 -> PpmPixelRGB16 -> IO ()
forall r. Dictionary r -> Ptr r -> r -> IO ()
Store.poke Dictionary PpmPixelRGB16
storePpmPixel16
instance Storable PbmPixel where
sizeOf :: PbmPixel -> Int
sizeOf = Dictionary PbmPixel -> PbmPixel -> Int
forall r. Dictionary r -> r -> Int
Store.sizeOf Dictionary PbmPixel
storePbmPixel
alignment :: PbmPixel -> Int
alignment = Dictionary PbmPixel -> PbmPixel -> Int
forall r. Dictionary r -> r -> Int
Store.alignment Dictionary PbmPixel
storePbmPixel
peek :: Ptr PbmPixel -> IO PbmPixel
peek = Dictionary PbmPixel -> Ptr PbmPixel -> IO PbmPixel
forall r. Dictionary r -> Ptr r -> IO r
Store.peek Dictionary PbmPixel
storePbmPixel
poke :: Ptr PbmPixel -> PbmPixel -> IO ()
poke = Dictionary PbmPixel -> Ptr PbmPixel -> PbmPixel -> IO ()
forall r. Dictionary r -> Ptr r -> r -> IO ()
Store.poke Dictionary PbmPixel
storePbmPixel
instance Storable PgmPixel8 where
sizeOf :: PgmPixel8 -> Int
sizeOf = Dictionary PgmPixel8 -> PgmPixel8 -> Int
forall r. Dictionary r -> r -> Int
Store.sizeOf Dictionary PgmPixel8
storePgmPixel8
alignment :: PgmPixel8 -> Int
alignment = Dictionary PgmPixel8 -> PgmPixel8 -> Int
forall r. Dictionary r -> r -> Int
Store.alignment Dictionary PgmPixel8
storePgmPixel8
peek :: Ptr PgmPixel8 -> IO PgmPixel8
peek = Dictionary PgmPixel8 -> Ptr PgmPixel8 -> IO PgmPixel8
forall r. Dictionary r -> Ptr r -> IO r
Store.peek Dictionary PgmPixel8
storePgmPixel8
poke :: Ptr PgmPixel8 -> PgmPixel8 -> IO ()
poke = Dictionary PgmPixel8 -> Ptr PgmPixel8 -> PgmPixel8 -> IO ()
forall r. Dictionary r -> Ptr r -> r -> IO ()
Store.poke Dictionary PgmPixel8
storePgmPixel8
instance Storable PgmPixel16 where
sizeOf :: PgmPixel16 -> Int
sizeOf = Dictionary PgmPixel16 -> PgmPixel16 -> Int
forall r. Dictionary r -> r -> Int
Store.sizeOf Dictionary PgmPixel16
storePgmPixel16
alignment :: PgmPixel16 -> Int
alignment = Dictionary PgmPixel16 -> PgmPixel16 -> Int
forall r. Dictionary r -> r -> Int
Store.alignment Dictionary PgmPixel16
storePgmPixel16
peek :: Ptr PgmPixel16 -> IO PgmPixel16
peek = Dictionary PgmPixel16 -> Ptr PgmPixel16 -> IO PgmPixel16
forall r. Dictionary r -> Ptr r -> IO r
Store.peek Dictionary PgmPixel16
storePgmPixel16
poke :: Ptr PgmPixel16 -> PgmPixel16 -> IO ()
poke = Dictionary PgmPixel16 -> Ptr PgmPixel16 -> PgmPixel16 -> IO ()
forall r. Dictionary r -> Ptr r -> r -> IO ()
Store.poke Dictionary PgmPixel16
storePgmPixel16
magicNumberParser :: Parser PPMType
magicNumberParser :: Parser PPMType
magicNumberParser = do
ByteString
magic <- [Parser ByteString ByteString] -> Parser ByteString ByteString
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [Parser ByteString ByteString
"P1", Parser ByteString ByteString
"P2", Parser ByteString ByteString
"P3", Parser ByteString ByteString
"P4", Parser ByteString ByteString
"P5", Parser ByteString ByteString
"P6"]
case ByteString
magic of
ByteString
"P1" -> PPMType -> Parser PPMType
forall (m :: * -> *) a. Monad m => a -> m a
return PPMType
P1
ByteString
"P2" -> PPMType -> Parser PPMType
forall (m :: * -> *) a. Monad m => a -> m a
return PPMType
P2
ByteString
"P3" -> PPMType -> Parser PPMType
forall (m :: * -> *) a. Monad m => a -> m a
return PPMType
P3
ByteString
"P4" -> PPMType -> Parser PPMType
forall (m :: * -> *) a. Monad m => a -> m a
return PPMType
P4
ByteString
"P5" -> PPMType -> Parser PPMType
forall (m :: * -> *) a. Monad m => a -> m a
return PPMType
P5
ByteString
"P6" -> PPMType -> Parser PPMType
forall (m :: * -> *) a. Monad m => a -> m a
return PPMType
P6
ByteString
_ -> String -> Parser PPMType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser PPMType) -> String -> Parser PPMType
forall a b. (a -> b) -> a -> b
$ String
"PPM: uknown PPM format " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
magic
{-# INLINE comment #-}
comment :: Parser ByteString
= Parser ByteString ByteString
"#" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Word8 -> Bool) -> Parser ByteString ByteString
A.takeWhile Word8 -> Bool
forall a. (Eq a, Num a) => a -> Bool
isNotNewline Parser ByteString ByteString
-> Parser ByteString () -> Parser ByteString ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
endOfLine
where
isNotNewline :: a -> Bool
isNotNewline a
w = a
w a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
10 Bool -> Bool -> Bool
&& a
w a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
13
{-# INLINE sep #-}
sep :: Parser ()
sep :: Parser ByteString ()
sep = do Parser ByteString ByteString -> Parser ByteString ()
forall (f :: * -> *) a. Alternative f => f a -> f ()
skipMany Parser ByteString ByteString
comment
Parser ByteString ()
singleWhitespace
Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *) a. Alternative f => f a -> f ()
skipMany (Parser ByteString ()
singleWhitespace Parser ByteString ()
-> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString -> Parser ByteString ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser ByteString ByteString
comment)
{-# INLINE decimalC #-}
decimalC :: Parser Int
decimalC :: Parser Int
decimalC = (Int -> Char -> Int) -> Int -> String -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Int -> Char -> Int
shiftDecimalChar Int
0 (String -> Int) -> Parser ByteString String -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Char
digit Parser Char -> Parser ByteString () -> Parser ByteString String
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy1` Parser ByteString ByteString -> Parser ByteString ()
forall (f :: * -> *) a. Alternative f => f a -> f ()
skipMany Parser ByteString ByteString
comment)
where
shiftDecimalChar :: Int -> Char -> Int
shiftDecimalChar Int
a Char
d = Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
48 :: Int)
headerParser :: Parser PPMHeader
= do
PPMType
ppmType <- Parser PPMType
magicNumberParser
Parser ByteString ()
sep
Int
width <- Parser Int
decimalC
Parser ByteString ()
sep
Int
height <- Parser Int
decimalC
Parser ByteString ByteString -> Parser ByteString ()
forall (f :: * -> *) a. Alternative f => f a -> f ()
skipMany Parser ByteString ByteString
comment
PPMHeader -> Parser PPMHeader
forall (m :: * -> *) a. Monad m => a -> m a
return (PPMHeader -> Parser PPMHeader) -> PPMHeader -> Parser PPMHeader
forall a b. (a -> b) -> a -> b
$ PPMType -> Int -> Int -> PPMHeader
PPMHeader PPMType
ppmType Int
width Int
height
{-# INLINE word8max #-}
word8max :: Word8 -> Parser Word8
word8max :: Word8 -> Parser Word8
word8max Word8
m = (Word8 -> Bool) -> Parser Word8
A.satisfy (Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
m) Parser Word8 -> String -> Parser Word8
forall i a. Parser i a -> String -> Parser i a
<?> String
"pixel data must be smaller than maxval"
{-# INLINE word16max #-}
word16max :: Word16 -> Parser Word16
word16max :: Word16 -> Parser Word16
word16max Word16
m = do Word16
w16 <- Parser Word16
anyWord16be
Bool -> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Word16
w16 Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word16
m) (Parser ByteString () -> Parser ByteString ())
-> Parser ByteString () -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ String -> Parser ByteString ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"pixel data must be smaller than maxval"
Word16 -> Parser Word16
forall (m :: * -> *) a. Monad m => a -> m a
return Word16
w16
{-# INLINE isValidMaxval #-}
isValidMaxval :: Int -> Bool
isValidMaxval :: Int -> Bool
isValidMaxval Int
v = Int
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
65536
{-# INLINE singleWhitespace #-}
singleWhitespace :: Parser ()
singleWhitespace :: Parser ByteString ()
singleWhitespace = Parser Word8 -> Parser ByteString ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Word8 -> Parser ByteString ())
-> Parser Word8 -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> Parser Word8
A.satisfy Word8 -> Bool
isSpace_w8
ppmBodyParser :: PPMHeader -> Parser PPM
ppmBodyParser :: PPMHeader -> Parser PPM
ppmBodyParser header :: PPMHeader
header@PPMHeader { ppmWidth :: PPMHeader -> Int
ppmWidth = Int
width, ppmHeight :: PPMHeader -> Int
ppmHeight = Int
height } = do
Parser ByteString ()
sep
Int
maxColorVal <- Parser Int
decimalC
Bool -> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Int -> Bool
isValidMaxval Int
maxColorVal) (Parser ByteString () -> Parser ByteString ())
-> Parser ByteString () -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$
String -> Parser ByteString ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ByteString ()) -> String -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ String
"PPM: invalid color maxval " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
maxColorVal
Parser ByteString ByteString -> Parser ByteString ()
forall (f :: * -> *) a. Alternative f => f a -> f ()
skipMany Parser ByteString ByteString
comment
Parser ByteString ()
singleWhitespace
PpmPixelData
raster <- case Int
maxColorVal of
Int
m | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
256 -> let v :: Parser Word8
v = Word8 -> Parser Word8
word8max (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m)
in Vector PpmPixelRGB8 -> PpmPixelData
PpmPixelDataRGB8 (Vector PpmPixelRGB8 -> PpmPixelData)
-> Parser ByteString (Vector PpmPixelRGB8)
-> Parser ByteString PpmPixelData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> Parser ByteString PpmPixelRGB8
-> Parser ByteString (Vector PpmPixelRGB8)
forall (m :: * -> *) a.
(Monad m, Storable a) =>
Int -> m a -> m (Vector a)
S.replicateM (Int
height Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
width) (Word8 -> Word8 -> Word8 -> PpmPixelRGB8
PpmPixelRGB8 (Word8 -> Word8 -> Word8 -> PpmPixelRGB8)
-> Parser Word8
-> Parser ByteString (Word8 -> Word8 -> PpmPixelRGB8)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word8
v Parser ByteString (Word8 -> Word8 -> PpmPixelRGB8)
-> Parser Word8 -> Parser ByteString (Word8 -> PpmPixelRGB8)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word8
v Parser ByteString (Word8 -> PpmPixelRGB8)
-> Parser Word8 -> Parser ByteString PpmPixelRGB8
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word8
v)
Int
m | Bool
otherwise -> let v :: Parser Word16
v = Word16 -> Parser Word16
word16max (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m)
in Vector PpmPixelRGB16 -> PpmPixelData
PpmPixelDataRGB16 (Vector PpmPixelRGB16 -> PpmPixelData)
-> Parser ByteString (Vector PpmPixelRGB16)
-> Parser ByteString PpmPixelData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> Parser ByteString PpmPixelRGB16
-> Parser ByteString (Vector PpmPixelRGB16)
forall (m :: * -> *) a.
(Monad m, Storable a) =>
Int -> m a -> m (Vector a)
S.replicateM (Int
height Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
width) (Word16 -> Word16 -> Word16 -> PpmPixelRGB16
PpmPixelRGB16 (Word16 -> Word16 -> Word16 -> PpmPixelRGB16)
-> Parser Word16
-> Parser ByteString (Word16 -> Word16 -> PpmPixelRGB16)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word16
v Parser ByteString (Word16 -> Word16 -> PpmPixelRGB16)
-> Parser Word16 -> Parser ByteString (Word16 -> PpmPixelRGB16)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word16
v Parser ByteString (Word16 -> PpmPixelRGB16)
-> Parser Word16 -> Parser ByteString PpmPixelRGB16
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word16
v)
PPM -> Parser PPM
forall (m :: * -> *) a. Monad m => a -> m a
return (PPM -> Parser PPM) -> PPM -> Parser PPM
forall a b. (a -> b) -> a -> b
$ PPMHeader -> PpmPixelData -> PPM
PPM PPMHeader
header PpmPixelData
raster
pgmBodyParser :: PPMHeader -> Parser PPM
pgmBodyParser :: PPMHeader -> Parser PPM
pgmBodyParser header :: PPMHeader
header@PPMHeader { ppmWidth :: PPMHeader -> Int
ppmWidth = Int
width, ppmHeight :: PPMHeader -> Int
ppmHeight = Int
height } = do
Parser ByteString ()
sep
Int
maxGreyVal <- Parser Int
decimalC
Bool -> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Int -> Bool
isValidMaxval Int
maxGreyVal) (Parser ByteString () -> Parser ByteString ())
-> Parser ByteString () -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$
String -> Parser ByteString ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ByteString ()) -> String -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ String
"PGM: invalid grey maxval " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
maxGreyVal
Parser ByteString ByteString -> Parser ByteString ()
forall (f :: * -> *) a. Alternative f => f a -> f ()
skipMany Parser ByteString ByteString
comment
Parser ByteString ()
singleWhitespace
PpmPixelData
raster <- case Int
maxGreyVal of
Int
m | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
256 -> let v :: Parser Word8
v = Word8 -> Parser Word8
word8max (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m)
in Vector PgmPixel8 -> PpmPixelData
PgmPixelData8 (Vector PgmPixel8 -> PpmPixelData)
-> Parser ByteString (Vector PgmPixel8)
-> Parser ByteString PpmPixelData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> Parser ByteString PgmPixel8
-> Parser ByteString (Vector PgmPixel8)
forall (m :: * -> *) a.
(Monad m, Storable a) =>
Int -> m a -> m (Vector a)
S.replicateM (Int
height Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
width) (Word8 -> PgmPixel8
PgmPixel8 (Word8 -> PgmPixel8) -> Parser Word8 -> Parser ByteString PgmPixel8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word8
v)
Int
m | Bool
otherwise -> let v :: Parser Word16
v = Word16 -> Parser Word16
word16max (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m)
in Vector PgmPixel16 -> PpmPixelData
PgmPixelData16 (Vector PgmPixel16 -> PpmPixelData)
-> Parser ByteString (Vector PgmPixel16)
-> Parser ByteString PpmPixelData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> Parser ByteString PgmPixel16
-> Parser ByteString (Vector PgmPixel16)
forall (m :: * -> *) a.
(Monad m, Storable a) =>
Int -> m a -> m (Vector a)
S.replicateM (Int
height Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
width) (Word16 -> PgmPixel16
PgmPixel16 (Word16 -> PgmPixel16)
-> Parser Word16 -> Parser ByteString PgmPixel16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word16
v)
PPM -> Parser PPM
forall (m :: * -> *) a. Monad m => a -> m a
return (PPM -> Parser PPM) -> PPM -> Parser PPM
forall a b. (a -> b) -> a -> b
$ PPMHeader -> PpmPixelData -> PPM
PPM PPMHeader
header PpmPixelData
raster
pbmBodyParser :: PPMHeader -> Parser PPM
pbmBodyParser :: PPMHeader -> Parser PPM
pbmBodyParser header :: PPMHeader
header@PPMHeader { ppmWidth :: PPMHeader -> Int
ppmWidth = Int
width, ppmHeight :: PPMHeader -> Int
ppmHeight = Int
height } = do
Parser ByteString ()
singleWhitespace
let widthBytes :: Int
widthBytes = (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) Int -> Int -> Int
// Int
8
Vector Word8
word8Vector <- Int -> Parser Word8 -> Parser ByteString (Vector Word8)
forall (m :: * -> *) a.
(Monad m, Storable a) =>
Int -> m a -> m (Vector a)
S.replicateM (Int
height Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
widthBytes) Parser Word8
anyWord8
let bits :: Vector PbmPixel
bits = (forall s. ST s (MVector s PbmPixel)) -> Vector PbmPixel
forall a. Storable a => (forall s. ST s (MVector s a)) -> Vector a
S.create ((forall s. ST s (MVector s PbmPixel)) -> Vector PbmPixel)
-> (forall s. ST s (MVector s PbmPixel)) -> Vector PbmPixel
forall a b. (a -> b) -> a -> b
$ do
MVector s PbmPixel
v <- Int -> PbmPixel -> ST s (MVector (PrimState (ST s)) PbmPixel)
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> a -> m (MVector (PrimState m) a)
SM.replicate (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
height) (Bool -> PbmPixel
PbmPixel Bool
False)
[Int] -> (Int -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..Int
heightInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
row ->
[Int] -> (Int -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..Int
widthInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
col ->
let i :: Int
i = Int
row Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
col
(Int
col8, Int
bitN) = Int
col Int -> Int -> (Int, Int)
/% Int
8
i8 :: Int
i8 = Int
row Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
widthBytes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
col8
in MVector (PrimState (ST s)) PbmPixel -> Int -> PbmPixel -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
SM.write MVector s PbmPixel
MVector (PrimState (ST s)) PbmPixel
v Int
i (Bool -> PbmPixel
PbmPixel (Bool -> PbmPixel) -> (Bool -> Bool) -> Bool -> PbmPixel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> PbmPixel) -> Bool -> PbmPixel
forall a b. (a -> b) -> a -> b
$ (Vector Word8
word8Vector Vector Word8 -> Int -> Word8
forall a. Storable a => Vector a -> Int -> a
! Int
i8) Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` (Int
7 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
bitN))
MVector s PbmPixel -> ST s (MVector s PbmPixel)
forall (m :: * -> *) a. Monad m => a -> m a
return MVector s PbmPixel
v
PPM -> Parser PPM
forall (m :: * -> *) a. Monad m => a -> m a
return (PPM -> Parser PPM) -> PPM -> Parser PPM
forall a b. (a -> b) -> a -> b
$ PPMHeader -> PpmPixelData -> PPM
PPM PPMHeader
header (Vector PbmPixel -> PpmPixelData
PbmPixelData Vector PbmPixel
bits)
where
// :: Int -> Int -> Int
(//) = Int -> Int -> Int
forall a. Integral a => a -> a -> a
quot
/% :: Int -> Int -> (Int, Int)
(/%) = Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
quotRem
pbmAsciiBodyParser :: PPMHeader -> Parser PPM
pbmAsciiBodyParser :: PPMHeader -> Parser PPM
pbmAsciiBodyParser header :: PPMHeader
header@PPMHeader { ppmWidth :: PPMHeader -> Int
ppmWidth = Int
width, ppmHeight :: PPMHeader -> Int
ppmHeight = Int
height } = do
Parser ByteString ()
singleWhitespace
let n :: Int
n = Int
height Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
width
Vector PbmPixel
bits <- Int
-> Parser ByteString PbmPixel
-> Parser ByteString (Vector PbmPixel)
forall (m :: * -> *) a.
(Monad m, Storable a) =>
Int -> m a -> m (Vector a)
S.replicateM Int
n ((Word8 -> Bool) -> Parser ByteString ByteString
A.takeWhile Word8 -> Bool
isSpace_w8 Parser ByteString ByteString
-> Parser ByteString PbmPixel -> Parser ByteString PbmPixel
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString PbmPixel
asciiBit)
() -> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option () ((Word8 -> Bool) -> Parser ByteString ByteString
A.takeWhile1 Word8 -> Bool
isSpace_w8 Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ByteString
takeLazyByteString Parser ByteString ByteString
-> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> () -> Parser ByteString ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
Parser ByteString ()
forall t. Chunk t => Parser t ()
endOfInput Parser ByteString () -> String -> Parser ByteString ()
forall i a. Parser i a -> String -> Parser i a
<?> String
"there is junk after the ASCII raster that is not separated by whitespace"
PPM -> Parser PPM
forall (m :: * -> *) a. Monad m => a -> m a
return (PPM -> Parser PPM) -> PPM -> Parser PPM
forall a b. (a -> b) -> a -> b
$ PPMHeader -> PpmPixelData -> PPM
PPM PPMHeader
header (Vector PbmPixel -> PpmPixelData
PbmPixelData Vector PbmPixel
bits)
where
asciiBit :: Parser ByteString PbmPixel
asciiBit = Bool -> PbmPixel
PbmPixel (Bool -> PbmPixel)
-> Parser ByteString Bool -> Parser ByteString PbmPixel
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Word8
anyWord8 Parser Word8
-> (Word8 -> Parser ByteString Bool) -> Parser ByteString Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> Parser ByteString Bool
forall a (m :: * -> *). (MonadFail m, Integral a) => a -> m Bool
toBool)
toBool :: a -> m Bool
toBool a
48 = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
toBool a
49 = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
toBool a
w = String -> m Bool
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m Bool) -> String -> m Bool
forall a b. (a -> b) -> a -> b
$ String
"ASCII bit must be '0' or '1', not " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show (Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w)
pgmAsciiBodyParser :: PPMHeader -> Parser PPM
pgmAsciiBodyParser :: PPMHeader -> Parser PPM
pgmAsciiBodyParser header :: PPMHeader
header@PPMHeader { ppmWidth :: PPMHeader -> Int
ppmWidth = Int
width, ppmHeight :: PPMHeader -> Int
ppmHeight = Int
height } = do
Parser ByteString ()
sep
Int
maxGreyVal <- Parser Int
decimalC
Bool -> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Int -> Bool
isValidMaxval Int
maxGreyVal) (Parser ByteString () -> Parser ByteString ())
-> Parser ByteString () -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$
String -> Parser ByteString ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ByteString ()) -> String -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ String
"PGM: invalid grey maxval " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
maxGreyVal
Parser ByteString ByteString -> Parser ByteString ()
forall (f :: * -> *) a. Alternative f => f a -> f ()
skipMany Parser ByteString ByteString
comment
Parser ByteString ()
singleWhitespace
let n :: Int
n = Int
height Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
width
PpmPixelData
raster <- case Int
maxGreyVal of
Int
m | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
256 -> Vector PgmPixel8 -> PpmPixelData
PgmPixelData8 (Vector PgmPixel8 -> PpmPixelData)
-> Parser ByteString (Vector PgmPixel8)
-> Parser ByteString PpmPixelData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> Parser ByteString PgmPixel8
-> Parser ByteString (Vector PgmPixel8)
forall (m :: * -> *) a.
(Monad m, Storable a) =>
Int -> m a -> m (Vector a)
S.replicateM Int
n ((Word8 -> Bool) -> Parser ByteString ByteString
A.takeWhile Word8 -> Bool
isSpace_w8 Parser ByteString ByteString
-> Parser ByteString PgmPixel8 -> Parser ByteString PgmPixel8
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Word8 -> PgmPixel8
PgmPixel8 (Word8 -> PgmPixel8) -> Parser Word8 -> Parser ByteString PgmPixel8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word8
forall a. Integral a => Parser a
decimal))
Int
_ -> Vector PgmPixel16 -> PpmPixelData
PgmPixelData16 (Vector PgmPixel16 -> PpmPixelData)
-> Parser ByteString (Vector PgmPixel16)
-> Parser ByteString PpmPixelData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> Parser ByteString PgmPixel16
-> Parser ByteString (Vector PgmPixel16)
forall (m :: * -> *) a.
(Monad m, Storable a) =>
Int -> m a -> m (Vector a)
S.replicateM Int
n ((Word8 -> Bool) -> Parser ByteString ByteString
A.takeWhile Word8 -> Bool
isSpace_w8 Parser ByteString ByteString
-> Parser ByteString PgmPixel16 -> Parser ByteString PgmPixel16
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Word16 -> PgmPixel16
PgmPixel16 (Word16 -> PgmPixel16)
-> Parser Word16 -> Parser ByteString PgmPixel16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word16
forall a. Integral a => Parser a
decimal))
() -> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option () ((Word8 -> Bool) -> Parser ByteString ByteString
A.takeWhile1 Word8 -> Bool
isSpace_w8 Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ByteString
takeLazyByteString Parser ByteString ByteString
-> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> () -> Parser ByteString ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
Parser ByteString ()
forall t. Chunk t => Parser t ()
endOfInput Parser ByteString () -> String -> Parser ByteString ()
forall i a. Parser i a -> String -> Parser i a
<?> String
"there is junk after the ASCII raster that is not separated by whitespace"
PPM -> Parser PPM
forall (m :: * -> *) a. Monad m => a -> m a
return (PPM -> Parser PPM) -> PPM -> Parser PPM
forall a b. (a -> b) -> a -> b
$ PPMHeader -> PpmPixelData -> PPM
PPM PPMHeader
header PpmPixelData
raster
ppmAsciiBodyParser :: PPMHeader -> Parser PPM
ppmAsciiBodyParser :: PPMHeader -> Parser PPM
ppmAsciiBodyParser header :: PPMHeader
header@PPMHeader { ppmWidth :: PPMHeader -> Int
ppmWidth = Int
width, ppmHeight :: PPMHeader -> Int
ppmHeight = Int
height } = do
Parser ByteString ()
sep
Int
maxColorVal <- Parser Int
decimalC
Bool -> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Int -> Bool
isValidMaxval Int
maxColorVal) (Parser ByteString () -> Parser ByteString ())
-> Parser ByteString () -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$
String -> Parser ByteString ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ByteString ()) -> String -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ String
"PGM: invalid color maxval " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
maxColorVal
Parser ByteString ByteString -> Parser ByteString ()
forall (f :: * -> *) a. Alternative f => f a -> f ()
skipMany Parser ByteString ByteString
comment
Parser ByteString ()
singleWhitespace
let n :: Int
n = Int
height Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
width
d8 :: Parser Word8
d8 = (Word8 -> Bool) -> Parser ByteString ByteString
A.takeWhile Word8 -> Bool
isSpace_w8 Parser ByteString ByteString -> Parser Word8 -> Parser Word8
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Word8
forall a. Integral a => Parser a
decimal :: Parser Word8
d16 :: Parser Word16
d16 = (Word8 -> Bool) -> Parser ByteString ByteString
A.takeWhile Word8 -> Bool
isSpace_w8 Parser ByteString ByteString -> Parser Word16 -> Parser Word16
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Word16
forall a. Integral a => Parser a
decimal :: Parser Word16
PpmPixelData
raster <- case Int
maxColorVal of
Int
m | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
256 -> Vector PpmPixelRGB8 -> PpmPixelData
PpmPixelDataRGB8 (Vector PpmPixelRGB8 -> PpmPixelData)
-> Parser ByteString (Vector PpmPixelRGB8)
-> Parser ByteString PpmPixelData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> Parser ByteString PpmPixelRGB8
-> Parser ByteString (Vector PpmPixelRGB8)
forall (m :: * -> *) a.
(Monad m, Storable a) =>
Int -> m a -> m (Vector a)
S.replicateM Int
n (Word8 -> Word8 -> Word8 -> PpmPixelRGB8
PpmPixelRGB8 (Word8 -> Word8 -> Word8 -> PpmPixelRGB8)
-> Parser Word8
-> Parser ByteString (Word8 -> Word8 -> PpmPixelRGB8)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word8
d8 Parser ByteString (Word8 -> Word8 -> PpmPixelRGB8)
-> Parser Word8 -> Parser ByteString (Word8 -> PpmPixelRGB8)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word8
d8 Parser ByteString (Word8 -> PpmPixelRGB8)
-> Parser Word8 -> Parser ByteString PpmPixelRGB8
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word8
d8 )
Int
_ -> Vector PpmPixelRGB16 -> PpmPixelData
PpmPixelDataRGB16 (Vector PpmPixelRGB16 -> PpmPixelData)
-> Parser ByteString (Vector PpmPixelRGB16)
-> Parser ByteString PpmPixelData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> Parser ByteString PpmPixelRGB16
-> Parser ByteString (Vector PpmPixelRGB16)
forall (m :: * -> *) a.
(Monad m, Storable a) =>
Int -> m a -> m (Vector a)
S.replicateM Int
n (Word16 -> Word16 -> Word16 -> PpmPixelRGB16
PpmPixelRGB16 (Word16 -> Word16 -> Word16 -> PpmPixelRGB16)
-> Parser Word16
-> Parser ByteString (Word16 -> Word16 -> PpmPixelRGB16)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word16
d16 Parser ByteString (Word16 -> Word16 -> PpmPixelRGB16)
-> Parser Word16 -> Parser ByteString (Word16 -> PpmPixelRGB16)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word16
d16 Parser ByteString (Word16 -> PpmPixelRGB16)
-> Parser Word16 -> Parser ByteString PpmPixelRGB16
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Word16
d16)
() -> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option () ((Word8 -> Bool) -> Parser ByteString ByteString
A.takeWhile1 Word8 -> Bool
isSpace_w8 Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ByteString
takeLazyByteString Parser ByteString ByteString
-> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> () -> Parser ByteString ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
Parser ByteString ()
forall t. Chunk t => Parser t ()
endOfInput Parser ByteString () -> String -> Parser ByteString ()
forall i a. Parser i a -> String -> Parser i a
<?> String
"there is junk after the ASCII raster that is not separated by whitespace"
PPM -> Parser PPM
forall (m :: * -> *) a. Monad m => a -> m a
return (PPM -> Parser PPM) -> PPM -> Parser PPM
forall a b. (a -> b) -> a -> b
$ PPMHeader -> PpmPixelData -> PPM
PPM PPMHeader
header PpmPixelData
raster
imageParserOfType :: Maybe PPMType -> Parser PPM
imageParserOfType :: Maybe PPMType -> Parser PPM
imageParserOfType Maybe PPMType
mpN = do
header :: PPMHeader
header@PPMHeader { PPMType
ppmType :: PPMType
ppmType :: PPMHeader -> PPMType
ppmType } <- Parser PPMHeader
headerParser
case Maybe PPMType
mpN of
Just PPMType
pN | PPMType
pN PPMType -> PPMType -> Bool
forall a. Eq a => a -> a -> Bool
/= PPMType
ppmType -> String -> Parser ByteString ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"an image in a multi-image file is not of the same type as the first image in the file"
Maybe PPMType
_ -> () -> Parser ByteString ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
case PPMType
ppmType of
PPMType
P1 -> PPMHeader -> Parser PPM
pbmAsciiBodyParser PPMHeader
header
PPMType
P2 -> PPMHeader -> Parser PPM
pgmAsciiBodyParser PPMHeader
header
PPMType
P3 -> PPMHeader -> Parser PPM
ppmAsciiBodyParser PPMHeader
header
PPMType
P4 -> PPMHeader -> Parser PPM
pbmBodyParser PPMHeader
header
PPMType
P5 -> PPMHeader -> Parser PPM
pgmBodyParser PPMHeader
header
PPMType
P6 -> PPMHeader -> Parser PPM
ppmBodyParser PPMHeader
header
imageParser :: Parser PPM
imageParser :: Parser PPM
imageParser = Maybe PPMType -> Parser PPM
imageParserOfType Maybe PPMType
forall a. Maybe a
Nothing
imagesParser :: Parser [PPM]
imagesParser :: Parser [PPM]
imagesParser = do
firstImage :: PPM
firstImage@PPM { ppmHeader :: PPM -> PPMHeader
ppmHeader = PPMHeader { PPMType
ppmType :: PPMType
ppmType :: PPMHeader -> PPMType
ppmType } } <- Parser PPM
imageParser Parser PPM -> Parser ByteString () -> Parser PPM
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
skipSpace
[PPM]
otherImages <- Parser PPM -> Parser [PPM]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Maybe PPMType -> Parser PPM
imageParserOfType (PPMType -> Maybe PPMType
forall a. a -> Maybe a
Just PPMType
ppmType) Parser PPM -> Parser ByteString () -> Parser PPM
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
skipSpace)
Bool -> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PPMType
ppmType PPMType -> [PPMType] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PPMType
P1, PPMType
P2, PPMType
P3] Bool -> Bool -> Bool
&& Bool -> Bool
not ([PPM] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PPM]
otherImages)) (Parser ByteString () -> Parser ByteString ())
-> Parser ByteString () -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$
String -> Parser ByteString ()
forall a. HasCallStack => String -> a
error String
"haskell-netpbm bug: ASCII formats should never contain more than one image (they treat remaining data as junk)"
[PPM] -> Parser [PPM]
forall (m :: * -> *) a. Monad m => a -> m a
return ([PPM] -> Parser [PPM]) -> [PPM] -> Parser [PPM]
forall a b. (a -> b) -> a -> b
$ PPM
firstImagePPM -> [PPM] -> [PPM]
forall a. a -> [a] -> [a]
:[PPM]
otherImages
type PpmParseResult = Either String ([PPM], Maybe ByteString)
parsePPM :: ByteString -> PpmParseResult
parsePPM :: ByteString -> PpmParseResult
parsePPM ByteString
bs = case Parser [PPM] -> ByteString -> Result [PPM]
forall a. Parser a -> ByteString -> Result a
parse Parser [PPM]
imagesParser ByteString
bs of
Partial ByteString -> Result [PPM]
cont -> Result [PPM] -> PpmParseResult
forall a a.
(Eq a, IsString a) =>
IResult a a -> Either String (a, Maybe a)
resultToEither (ByteString -> Result [PPM]
cont ByteString
"")
Result [PPM]
r -> Result [PPM] -> PpmParseResult
forall a a.
(Eq a, IsString a) =>
IResult a a -> Either String (a, Maybe a)
resultToEither Result [PPM]
r
where
resultToEither :: IResult a a -> Either String (a, Maybe a)
resultToEither IResult a a
r = case IResult a a
r of
Done a
"" a
images -> (a, Maybe a) -> Either String (a, Maybe a)
forall a b. b -> Either a b
Right (a
images, Maybe a
forall a. Maybe a
Nothing)
Done a
rest a
images -> (a, Maybe a) -> Either String (a, Maybe a)
forall a b. b -> Either a b
Right (a
images, a -> Maybe a
forall a. a -> Maybe a
Just a
rest)
Partial a -> IResult a a
_ -> String -> Either String (a, Maybe a)
forall a. HasCallStack => String -> a
error String
"parsePPM bug: Got a partial result after end of input"
Fail a
_ [String]
cs String
e -> String -> Either String (a, Maybe a)
forall a b. a -> Either a b
Left (String -> Either String (a, Maybe a))
-> String -> Either String (a, Maybe a)
forall a b. (a -> b) -> a -> b
$ String
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"; contexts: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
cs
derivingUnbox "PpmPixelRGB8"
[t| PpmPixelRGB8 -> (Word8, Word8, Word8) |]
[| \ (PpmPixelRGB8 a b c) -> (a, b, c) |]
[| \ (a, b, c) -> PpmPixelRGB8 a b c |]
derivingUnbox "PpmPixelRGB16"
[t| PpmPixelRGB16 -> (Word16, Word16, Word16) |]
[| \ (PpmPixelRGB16 a b c) -> (a, b, c) |]
[| \ (a, b, c) -> PpmPixelRGB16 a b c |]
derivingUnbox "PbmPixel"
[t| PbmPixel -> Bool |]
[| \ (PbmPixel b) -> b |]
[| \ b -> PbmPixel b |]
derivingUnbox "PgmPixel8"
[t| PgmPixel8 -> Word8 |]
[| \ (PgmPixel8 x) -> x |]
[| \ x -> PgmPixel8 x |]
derivingUnbox "PgmPixel16"
[t| PgmPixel16 -> Word16 |]
[| \ (PgmPixel16 x) -> x |]
[| \ x -> PgmPixel16 x |]