{-|
Module      : Data.Fits.MegaParser
Description : MegaParsec based parser for an HDU.
Copyright   : (c) Zac Slade, 2023
License     : BSD2
Maintainer  : krakrjak@gmail.com
Stability   : experimental

Parsing rules for an HDU in a FITS file.
-}

{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE OverloadedStrings #-}

module Data.Fits.MegaParser where

-- qualified imports
---- bytestring
import qualified Data.ByteString as BS
import qualified Data.ByteString.Internal as BS ( c2w )
---- megaparsec
import qualified Text.Megaparsec as M
import qualified Text.Megaparsec.Char as MC
import qualified Text.Megaparsec.Stream as M
import qualified Text.Megaparsec.Pos as MP
import qualified Text.Megaparsec.Byte as M
import qualified Text.Megaparsec.Byte.Lexer as MBL
---- text
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
---- local imports
import qualified Data.Fits as Fits
import qualified Data.ByteString.Char8 as C8
import qualified Data.Binary as C8


-- symbol imports
---- bytestring
import Data.ByteString ( ByteString )
---- text
import Data.Text ( Text )
---- megaparsec
import Text.Ascii ( isAscii )
import Text.Megaparsec ( Parsec, ParseErrorBundle, (<|>), (<?>))
---- microlens
import Lens.Micro ((^.))
---- base
import Control.Applicative ( (<$>) )
import Control.Exception ( Exception(displayException) )
import Control.Monad ( void, foldM, replicateM_ )
import Data.Bifunctor ( first )
import Data.Char ( ord )
import Data.Maybe ( catMaybes, fromMaybe )
import Data.Word ( Word8, Word16, Word32, Word64 )
import Data.Void ( Void )
---- local imports
import Data.Fits
  ( Axes
  , Dimensions(Dimensions)
  , Header(Header)
  , KeywordRecord(..)
  , HeaderRecord(..)
  , HeaderDataUnit(HeaderDataUnit)
  , BitPixFormat(..)
  , Extension(..)
  , LogicalConstant(..)
  , Value(..)
  , bitPixToByteSize, hduRecordLength
  )


type Parser = Parsec Void ByteString
type ParseErr = ParseErrorBundle ByteString Void

data DataUnitValues
  = FITSUInt8 Word8
  | FITSInt16 Word16
  | FITSInt32 Word32
  | FITSInt64 Word64
  | FITSFloat32 Float
  | FITSFloat64 Double 


toWord :: Char -> Word8
toWord :: Char -> Word8
toWord = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord

wordsText :: [Word8] -> Text
wordsText :: [Word8] -> Text
wordsText = ByteString -> Text
TE.decodeUtf8 (ByteString -> Text) -> ([Word8] -> ByteString) -> [Word8] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack


-- | Consumes ALL header blocks until end, then all remaining space
parseHeader :: Parser Header
parseHeader :: Parser Header
parseHeader = do
    [HeaderRecord]
pairs <- ParsecT Void ByteString Identity HeaderRecord
-> ParsecT Void ByteString Identity (Tokens ByteString)
-> ParsecT Void ByteString Identity [HeaderRecord]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
M.manyTill ParsecT Void ByteString Identity HeaderRecord
parseRecordLine (Tokens ByteString
-> ParsecT Void ByteString Identity (Tokens ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
M.string' Tokens ByteString
"end")
    ParsecT Void ByteString Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m ()
M.space -- consume space padding all the way to the end of the next 2880 bytes header block
    Header -> Parser Header
forall a. a -> ParsecT Void ByteString Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Header -> Parser Header) -> Header -> Parser Header
forall a b. (a -> b) -> a -> b
$ [HeaderRecord] -> Header
Header [HeaderRecord]
pairs

parseRecordLine :: Parser HeaderRecord
parseRecordLine :: ParsecT Void ByteString Identity HeaderRecord
parseRecordLine = do
    ParsecT Void ByteString Identity HeaderRecord
-> ParsecT Void ByteString Identity HeaderRecord
forall a.
ParsecT Void ByteString Identity a
-> ParsecT Void ByteString Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
M.try (KeywordRecord -> HeaderRecord
Keyword (KeywordRecord -> HeaderRecord)
-> ParsecT Void ByteString Identity KeywordRecord
-> ParsecT Void ByteString Identity HeaderRecord
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void ByteString Identity KeywordRecord
parseKeywordRecord)
      ParsecT Void ByteString Identity HeaderRecord
-> ParsecT Void ByteString Identity HeaderRecord
-> ParsecT Void ByteString Identity HeaderRecord
forall a.
ParsecT Void ByteString Identity a
-> ParsecT Void ByteString Identity a
-> ParsecT Void ByteString Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void ByteString Identity HeaderRecord
-> ParsecT Void ByteString Identity HeaderRecord
forall a.
ParsecT Void ByteString Identity a
-> ParsecT Void ByteString Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
M.try (Text -> HeaderRecord
Comment (Text -> HeaderRecord)
-> ParsecT Void ByteString Identity Text
-> ParsecT Void ByteString Identity HeaderRecord
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void ByteString Identity Text
parseLineComment)
      ParsecT Void ByteString Identity HeaderRecord
-> ParsecT Void ByteString Identity HeaderRecord
-> ParsecT Void ByteString Identity HeaderRecord
forall a.
ParsecT Void ByteString Identity a
-> ParsecT Void ByteString Identity a
-> ParsecT Void ByteString Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> HeaderRecord
BlankLine HeaderRecord
-> ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity HeaderRecord
forall a b.
a
-> ParsecT Void ByteString Identity b
-> ParsecT Void ByteString Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Void ByteString Identity ()
parseLineBlank


parseKeywordRecord :: Parser KeywordRecord
parseKeywordRecord :: ParsecT Void ByteString Identity KeywordRecord
parseKeywordRecord = do
    ((Text
k, Value
v), Maybe Text
mc) <- Parser (Text, Value) -> Parser ((Text, Value), Maybe Text)
forall a. Parser a -> Parser (a, Maybe Text)
withComments Parser (Text, Value)
parseKeywordValue
    KeywordRecord -> ParsecT Void ByteString Identity KeywordRecord
forall a. a -> ParsecT Void ByteString Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (KeywordRecord -> ParsecT Void ByteString Identity KeywordRecord)
-> KeywordRecord -> ParsecT Void ByteString Identity KeywordRecord
forall a b. (a -> b) -> a -> b
$ Text -> Value -> Maybe Text -> KeywordRecord
KeywordRecord Text
k Value
v Maybe Text
mc

-- | Parses the specified keyword
parseKeywordRecord' :: ByteString -> Parser a -> Parser a
parseKeywordRecord' :: forall a. ByteString -> Parser a -> Parser a
parseKeywordRecord' ByteString
k Parser a
pval = Parser a -> Parser a
forall a.
ParsecT Void ByteString Identity a
-> ParsecT Void ByteString Identity a
ignoreComments (Parser a -> Parser a) -> Parser a -> Parser a
forall a b. (a -> b) -> a -> b
$ do
    Tokens ByteString
-> ParsecT Void ByteString Identity (Tokens ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
M.string' ByteString
Tokens ByteString
k
    ParsecT Void ByteString Identity ()
parseEquals
    Parser a
pval




-- | Combinator to allow for parsing a record with inline comments
withComments :: Parser a -> Parser (a, Maybe Text)
withComments :: forall a. Parser a -> Parser (a, Maybe Text)
withComments Parser a
parse = do
    -- assumes we are at the beginning of the line
    Int
lineStart <- Parser Int
parsePos
    a
a <- Parser a
parse
    Maybe Text
mc <- Int -> Parser (Maybe Text)
parseLineEnd Int
lineStart
    (a, Maybe Text) -> Parser (a, Maybe Text)
forall a. a -> ParsecT Void ByteString Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, Maybe Text
mc)

ignoreComments :: Parser a -> Parser a
ignoreComments :: forall a.
ParsecT Void ByteString Identity a
-> ParsecT Void ByteString Identity a
ignoreComments Parser a
parse = do
    (a
a, Maybe Text
_) <- Parser a -> Parser (a, Maybe Text)
forall a. Parser a -> Parser (a, Maybe Text)
withComments Parser a
parse
    a -> Parser a
forall a. a -> ParsecT Void ByteString Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a


parseKeywordValue :: Parser (Text, Value)
parseKeywordValue :: Parser (Text, Value)
parseKeywordValue = do
    Text
key <- ParsecT Void ByteString Identity Text
parseKeyword
    ParsecT Void ByteString Identity ()
parseEquals
    Value
val <- Parser Value
parseValue
    (Text, Value) -> Parser (Text, Value)
forall a. a -> ParsecT Void ByteString Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
key, Value
val)


parseLineEnd :: Int -> Parser (Maybe Text)
parseLineEnd :: Int -> Parser (Maybe Text)
parseLineEnd Int
lineStart = do
  Parser (Maybe Text) -> Parser (Maybe Text)
forall a.
ParsecT Void ByteString Identity a
-> ParsecT Void ByteString Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
M.try (Maybe Text
forall a. Maybe a
Nothing Maybe Text
-> ParsecT Void ByteString Identity () -> Parser (Maybe Text)
forall a b.
a
-> ParsecT Void ByteString Identity b
-> ParsecT Void ByteString Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Int -> ParsecT Void ByteString Identity ()
spacesToLineEnd Int
lineStart) Parser (Maybe Text) -> Parser (Maybe Text) -> Parser (Maybe Text)
forall a.
ParsecT Void ByteString Identity a
-> ParsecT Void ByteString Identity a
-> ParsecT Void ByteString Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text)
-> ParsecT Void ByteString Identity Text -> Parser (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ParsecT Void ByteString Identity Text
parseInlineComment Int
lineStart)


spacesToLineEnd :: Int -> Parser ()
spacesToLineEnd :: Int -> ParsecT Void ByteString Identity ()
spacesToLineEnd Int
lineStart = do
  Int
curr <- Parser Int
parsePos
  let used :: Int
used = Int
curr Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lineStart
  Int -> ParsecT Void ByteString Identity ()
parseSpacesN (Int
hduRecordLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
used)
  () -> ParsecT Void ByteString Identity ()
forall a. a -> ParsecT Void ByteString Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

parseSpacesN :: Int -> Parser ()
parseSpacesN :: Int -> ParsecT Void ByteString Identity ()
parseSpacesN Int
n = Int
-> ParsecT Void ByteString Identity Word8
-> ParsecT Void ByteString Identity ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
n (Token ByteString
-> ParsecT Void ByteString Identity (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
M.char (Token ByteString
 -> ParsecT Void ByteString Identity (Token ByteString))
-> Token ByteString
-> ParsecT Void ByteString Identity (Token ByteString)
forall a b. (a -> b) -> a -> b
$ Char -> Word8
toWord Char
' ')

parseInlineComment :: Int -> Parser Text
parseInlineComment :: Int -> ParsecT Void ByteString Identity Text
parseInlineComment Int
lineStart = do
    -- any number of spaces... the previous combinator has eaten up blank lines already
    ParsecT Void ByteString Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m ()
M.space
    Token ByteString
-> ParsecT Void ByteString Identity (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
M.char (Token ByteString
 -> ParsecT Void ByteString Identity (Token ByteString))
-> Token ByteString
-> ParsecT Void ByteString Identity (Token ByteString)
forall a b. (a -> b) -> a -> b
$ Char -> Word8
toWord Char
'/'
    ParsecT Void ByteString Identity (Token ByteString)
-> ParsecT Void ByteString Identity (Maybe (Token ByteString))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
M.optional ParsecT Void ByteString Identity (Token ByteString)
charSpace
    Int
curr <- Parser Int
parsePos
    let used :: Int
used = Int
curr Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lineStart
    [Word8]
c <- Int
-> ParsecT Void ByteString Identity Word8
-> ParsecT Void ByteString Identity [Word8]
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
M.count (Int
hduRecordLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
used) ParsecT Void ByteString Identity Word8
ParsecT Void ByteString Identity (Token ByteString)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
M.anySingle
    Text -> ParsecT Void ByteString Identity Text
forall a. a -> ParsecT Void ByteString Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ParsecT Void ByteString Identity Text)
-> Text -> ParsecT Void ByteString Identity Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Word8] -> Text
wordsText [Word8]
c
  where
    charSpace :: ParsecT Void ByteString Identity (Token ByteString)
charSpace = Token ByteString
-> ParsecT Void ByteString Identity (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
M.char (Token ByteString
 -> ParsecT Void ByteString Identity (Token ByteString))
-> Token ByteString
-> ParsecT Void ByteString Identity (Token ByteString)
forall a b. (a -> b) -> a -> b
$ Char -> Word8
toWord Char
' '


parseLineComment :: Parser Text
parseLineComment :: ParsecT Void ByteString Identity Text
parseLineComment = do
    let keyword :: ByteString
keyword = ByteString
"COMMENT " :: ByteString
    Tokens ByteString
-> ParsecT Void ByteString Identity (Tokens ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
M.string' ByteString
Tokens ByteString
keyword
    [Word8]
c <- Int
-> ParsecT Void ByteString Identity Word8
-> ParsecT Void ByteString Identity [Word8]
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
M.count (Int
hduRecordLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
BS.length ByteString
keyword) ParsecT Void ByteString Identity Word8
ParsecT Void ByteString Identity (Token ByteString)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
M.anySingle
    Text -> ParsecT Void ByteString Identity Text
forall a. a -> ParsecT Void ByteString Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ParsecT Void ByteString Identity Text)
-> Text -> ParsecT Void ByteString Identity Text
forall a b. (a -> b) -> a -> b
$ [Word8] -> Text
wordsText [Word8]
c

parseLineBlank :: Parser ()
parseLineBlank :: ParsecT Void ByteString Identity ()
parseLineBlank = do
  Tokens ByteString
-> ParsecT Void ByteString Identity (Tokens ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
M.string' (Int -> Word8 -> ByteString
BS.replicate Int
hduRecordLength (Char -> Word8
toWord Char
' '))
  () -> ParsecT Void ByteString Identity ()
forall a. a -> ParsecT Void ByteString Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


-- | Anything but a space or equals
parseKeyword :: Parser Text
parseKeyword :: ParsecT Void ByteString Identity Text
parseKeyword = [Word8] -> Text
wordsText ([Word8] -> Text)
-> ParsecT Void ByteString Identity [Word8]
-> ParsecT Void ByteString Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void ByteString Identity Word8
-> ParsecT Void ByteString Identity [Word8]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
M.some ([Token ByteString]
-> ParsecT Void ByteString Identity (Token ByteString)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
M.noneOf ([Token ByteString]
 -> ParsecT Void ByteString Identity (Token ByteString))
-> [Token ByteString]
-> ParsecT Void ByteString Identity (Token ByteString)
forall a b. (a -> b) -> a -> b
$ (Char -> Word8) -> String -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Word8
toWord [Char
' ', Char
'='])

parseValue :: Parser Value
parseValue :: Parser Value
parseValue =
    -- try is required here because Megaparsec doesn't automatically backtrack if the parser consumes anything
    Parser Value -> Parser Value
forall a.
ParsecT Void ByteString Identity a
-> ParsecT Void ByteString Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
M.try (Float -> Value
Float (Float -> Value)
-> ParsecT Void ByteString Identity Float -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void ByteString Identity Float
parseFloat)
    Parser Value -> Parser Value -> Parser Value
forall a.
ParsecT Void ByteString Identity a
-> ParsecT Void ByteString Identity a
-> ParsecT Void ByteString Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Value -> Parser Value
forall a.
ParsecT Void ByteString Identity a
-> ParsecT Void ByteString Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
M.try (Int -> Value
Integer (Int -> Value) -> Parser Int -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int
forall a. Num a => Parser a
parseInt)
    Parser Value -> Parser Value -> Parser Value
forall a.
ParsecT Void ByteString Identity a
-> ParsecT Void ByteString Identity a
-> ParsecT Void ByteString Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (LogicalConstant -> Value
Logic (LogicalConstant -> Value)
-> ParsecT Void ByteString Identity LogicalConstant -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void ByteString Identity LogicalConstant
parseLogic)
    Parser Value -> Parser Value -> Parser Value
forall a.
ParsecT Void ByteString Identity a
-> ParsecT Void ByteString Identity a
-> ParsecT Void ByteString Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Value
String (Text -> Value)
-> ParsecT Void ByteString Identity Text -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void ByteString Identity Text
parseStringContinue)

parseInt :: Num a => Parser a
parseInt :: forall a. Num a => Parser a
parseInt = ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity a
-> ParsecT Void ByteString Identity a
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Word8, Num a) =>
m () -> m a -> m a
MBL.signed ParsecT Void ByteString Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m ()
M.space ParsecT Void ByteString Identity a
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Word8, Num a) =>
m a
MBL.decimal

parseFloat :: Parser Float
parseFloat :: ParsecT Void ByteString Identity Float
parseFloat = ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity Float
-> ParsecT Void ByteString Identity Float
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Word8, Num a) =>
m () -> m a -> m a
MBL.signed ParsecT Void ByteString Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m ()
M.space ParsecT Void ByteString Identity Float
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Word8, RealFloat a) =>
m a
MBL.float

parseLogic :: Parser LogicalConstant
parseLogic :: ParsecT Void ByteString Identity LogicalConstant
parseLogic = do
    LogicalConstant
T LogicalConstant
-> ParsecT Void ByteString Identity (Tokens ByteString)
-> ParsecT Void ByteString Identity LogicalConstant
forall a b.
a
-> ParsecT Void ByteString Identity b
-> ParsecT Void ByteString Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens ByteString
-> ParsecT Void ByteString Identity (Tokens ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
M.string' Tokens ByteString
"T" ParsecT Void ByteString Identity LogicalConstant
-> ParsecT Void ByteString Identity LogicalConstant
-> ParsecT Void ByteString Identity LogicalConstant
forall a.
ParsecT Void ByteString Identity a
-> ParsecT Void ByteString Identity a
-> ParsecT Void ByteString Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LogicalConstant
F LogicalConstant
-> ParsecT Void ByteString Identity (Tokens ByteString)
-> ParsecT Void ByteString Identity LogicalConstant
forall a b.
a
-> ParsecT Void ByteString Identity b
-> ParsecT Void ByteString Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens ByteString
-> ParsecT Void ByteString Identity (Tokens ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
M.string' Tokens ByteString
"F"

parseStringContinue :: Parser Text
parseStringContinue :: ParsecT Void ByteString Identity Text
parseStringContinue = do
    Text
t <- ParsecT Void ByteString Identity Text
parseStringValue

    Maybe Text
mc <- ParsecT Void ByteString Identity Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
M.optional (ParsecT Void ByteString Identity Text -> Parser (Maybe Text))
-> ParsecT Void ByteString Identity Text -> Parser (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
      Tokens ByteString
-> ParsecT Void ByteString Identity (Tokens ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
M.string' Tokens ByteString
"CONTINUE"
      ParsecT Void ByteString Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m ()
M.space
      ParsecT Void ByteString Identity Text
parseStringContinue

    case Maybe Text
mc of
      Maybe Text
Nothing -> Text -> ParsecT Void ByteString Identity Text
forall a. a -> ParsecT Void ByteString Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
t
      Just Text
tc -> Text -> ParsecT Void ByteString Identity Text
forall a. a -> ParsecT Void ByteString Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ParsecT Void ByteString Identity Text)
-> Text -> ParsecT Void ByteString Identity Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'&') Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tc

parseStringValue :: Parser Text
parseStringValue :: ParsecT Void ByteString Identity Text
parseStringValue = do
    -- The rules are weird, NULL means a NULL string, '' is an empty
    -- string, a ' followed by a bunch of spaces and a close ' is
    -- considered an empty string, and trailing whitespace is ignored
    -- within the quotes, but not leading spaces.
    [Word8]
ls <- ParsecT Void ByteString Identity Word8
-> ParsecT Void ByteString Identity Word8
-> ParsecT Void ByteString Identity [Word8]
-> ParsecT Void ByteString Identity [Word8]
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
M.between (Token ByteString
-> ParsecT Void ByteString Identity (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
M.char Word8
Token ByteString
quote) (Token ByteString
-> ParsecT Void ByteString Identity (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
M.char Word8
Token ByteString
quote) (ParsecT Void ByteString Identity [Word8]
 -> ParsecT Void ByteString Identity [Word8])
-> ParsecT Void ByteString Identity [Word8]
-> ParsecT Void ByteString Identity [Word8]
forall a b. (a -> b) -> a -> b
$ ParsecT Void ByteString Identity Word8
-> ParsecT Void ByteString Identity [Word8]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
M.many (ParsecT Void ByteString Identity Word8
 -> ParsecT Void ByteString Identity [Word8])
-> ParsecT Void ByteString Identity Word8
-> ParsecT Void ByteString Identity [Word8]
forall a b. (a -> b) -> a -> b
$ Token ByteString
-> ParsecT Void ByteString Identity (Token ByteString)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
M.anySingleBut Word8
Token ByteString
quote
    ParsecT Void ByteString Identity ()
consumeDead
    Text -> ParsecT Void ByteString Identity Text
forall a. a -> ParsecT Void ByteString Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Text
T.stripEnd (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Word8] -> Text
wordsText [Word8]
ls)
    where quote :: Word8
quote = Char -> Word8
toWord Char
'\''

requireKeyword :: Text -> Header -> Parser Value
requireKeyword :: Text -> Header -> Parser Value
requireKeyword Text
k Header
kvs = do
    case Text -> Header -> Maybe Value
Fits.lookup Text
k Header
kvs of
      Maybe Value
Nothing -> String -> Parser Value
forall a. String -> ParsecT Void ByteString Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Value) -> String -> Parser Value
forall a b. (a -> b) -> a -> b
$ String
"Missing: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
k
      Just Value
v -> Value -> Parser Value
forall a. a -> ParsecT Void ByteString Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Value
v

requireNaxis :: Header -> Parser Int
requireNaxis :: Header -> Parser Int
requireNaxis Header
kvs = do
    Value
v <- Text -> Header -> Parser Value
requireKeyword Text
"NAXIS" Header
kvs
    case Value
v of
      Integer Int
n -> Int -> Parser Int
forall a. a -> ParsecT Void ByteString Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
      Value
_ -> String -> Parser Int
forall a. String -> ParsecT Void ByteString Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid NAXIS header"

skipEmpty :: Parser ()
skipEmpty :: ParsecT Void ByteString Identity ()
skipEmpty = ParsecT Void ByteString Identity [Token ByteString]
-> ParsecT Void ByteString Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void ByteString Identity (Token ByteString)
-> ParsecT Void ByteString Identity [Token ByteString]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
M.many (ParsecT Void ByteString Identity (Token ByteString)
 -> ParsecT Void ByteString Identity [Token ByteString])
-> ParsecT Void ByteString Identity (Token ByteString)
-> ParsecT Void ByteString Identity [Token ByteString]
forall a b. (a -> b) -> a -> b
$ (Token ByteString -> Bool)
-> ParsecT Void ByteString Identity (Token ByteString)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
M.satisfy (Char -> Word8
toWord Char
'\0' Token ByteString -> Token ByteString -> Bool
forall a. Eq a => a -> a -> Bool
==))

consumeDead :: Parser ()
consumeDead :: ParsecT Void ByteString Identity ()
consumeDead = ParsecT Void ByteString Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m ()
M.space ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
forall a b.
ParsecT Void ByteString Identity a
-> ParsecT Void ByteString Identity b
-> ParsecT Void ByteString Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void ByteString Identity ()
skipEmpty

parseEnd :: Parser ()
parseEnd :: ParsecT Void ByteString Identity ()
parseEnd = Tokens ByteString
-> ParsecT Void ByteString Identity (Tokens ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
M.string' Tokens ByteString
"end" ParsecT Void ByteString Identity (Tokens ByteString)
-> ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
forall a b.
ParsecT Void ByteString Identity a
-> ParsecT Void ByteString Identity b
-> ParsecT Void ByteString Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void ByteString Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m ()
M.space ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
forall a b.
ParsecT Void ByteString Identity a
-> ParsecT Void ByteString Identity b
-> ParsecT Void ByteString Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void ByteString Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
M.eof

parseEquals :: Parser ()
parseEquals :: ParsecT Void ByteString Identity ()
parseEquals = ParsecT Void ByteString Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m ()
M.space ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity Word8
-> ParsecT Void ByteString Identity Word8
forall a b.
ParsecT Void ByteString Identity a
-> ParsecT Void ByteString Identity b
-> ParsecT Void ByteString Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Token ByteString
-> ParsecT Void ByteString Identity (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
M.char (Char -> Word8
toWord Char
'=') ParsecT Void ByteString Identity Word8
-> ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
forall a b.
ParsecT Void ByteString Identity a
-> ParsecT Void ByteString Identity b
-> ParsecT Void ByteString Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void ByteString Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m ()
M.space

parsePos :: Parser Int
parsePos :: Parser Int
parsePos = Pos -> Int
MP.unPos (Pos -> Int) -> (SourcePos -> Pos) -> SourcePos -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcePos -> Pos
MP.sourceColumn (SourcePos -> Int)
-> ParsecT Void ByteString Identity SourcePos -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void ByteString Identity SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
M.getSourcePos


parseBitPix :: Parser BitPixFormat
parseBitPix :: Parser BitPixFormat
parseBitPix = do
    Value
v <- ByteString -> Parser Value -> Parser Value
forall a. ByteString -> Parser a -> Parser a
parseKeywordRecord' ByteString
"BITPIX" Parser Value
parseValue
    Value -> Parser BitPixFormat
forall {m :: * -> *}. MonadFail m => Value -> m BitPixFormat
toBitpix Value
v
    where
      toBitpix :: Value -> m BitPixFormat
toBitpix (Integer Int
8) = BitPixFormat -> m BitPixFormat
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return BitPixFormat
EightBitInt
      toBitpix (Integer Int
16) = BitPixFormat -> m BitPixFormat
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return BitPixFormat
SixteenBitInt
      toBitpix (Integer Int
32) = BitPixFormat -> m BitPixFormat
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return BitPixFormat
ThirtyTwoBitInt
      toBitpix (Integer Int
64) = BitPixFormat -> m BitPixFormat
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return BitPixFormat
SixtyFourBitInt
      toBitpix (Integer (-32)) = BitPixFormat -> m BitPixFormat
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return BitPixFormat
ThirtyTwoBitFloat
      toBitpix (Integer (-64)) = BitPixFormat -> m BitPixFormat
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return BitPixFormat
SixtyFourBitFloat
      toBitpix Value
_ = String -> m BitPixFormat
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid BITPIX header"

parseNaxes :: Parser Axes
parseNaxes :: Parser Axes
parseNaxes = do
    Int
n <- ByteString -> Parser Int -> Parser Int
forall a. ByteString -> Parser a -> Parser a
parseKeywordRecord' ByteString
"NAXIS" Parser Int
forall a. Num a => Parser a
parseInt
    (Int -> Parser Int) -> Axes -> Parser Axes
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Int -> Parser Int
parseN [Int
1..Int
n]
  where
    parseN :: Int -> Parser Int
    parseN :: Int -> Parser Int
parseN Int
n = ByteString -> Parser Int -> Parser Int
forall a. ByteString -> Parser a -> Parser a
parseKeywordRecord' (String -> ByteString
C8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String
"NAXIS" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
n) Parser Int
forall a. Num a => Parser a
parseInt

-- | We don't parse simple here, because it isn't required on all HDUs
parseDimensions :: Parser Dimensions
parseDimensions :: Parser Dimensions
parseDimensions = do
    BitPixFormat
bp <- Parser BitPixFormat
parseBitPix
    BitPixFormat -> Axes -> Dimensions
Dimensions BitPixFormat
bp (Axes -> Dimensions) -> Parser Axes -> Parser Dimensions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Axes
parseNaxes

parsePrimary :: Parser HeaderDataUnit
parsePrimary :: Parser HeaderDataUnit
parsePrimary = do
    Dimensions
dm <- Parser Dimensions
parsePrimaryKeywords
    Header
hd <- Parser Header
parseHeader
    ByteString
dt <- Dimensions -> Parser ByteString
parseMainData Dimensions
dm
    HeaderDataUnit -> Parser HeaderDataUnit
forall a. a -> ParsecT Void ByteString Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (HeaderDataUnit -> Parser HeaderDataUnit)
-> HeaderDataUnit -> Parser HeaderDataUnit
forall a b. (a -> b) -> a -> b
$ Header -> Dimensions -> Extension -> ByteString -> HeaderDataUnit
HeaderDataUnit Header
hd Dimensions
dm Extension
Primary ByteString
dt


parsePrimaryKeywords :: Parser Dimensions
parsePrimaryKeywords :: Parser Dimensions
parsePrimaryKeywords = do
    ByteString
-> ParsecT Void ByteString Identity LogicalConstant
-> ParsecT Void ByteString Identity LogicalConstant
forall a. ByteString -> Parser a -> Parser a
parseKeywordRecord' ByteString
"SIMPLE" ParsecT Void ByteString Identity LogicalConstant
parseLogic
    Parser Dimensions -> Parser Dimensions
forall a.
ParsecT Void ByteString Identity a
-> ParsecT Void ByteString Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
M.lookAhead Parser Dimensions
parseDimensions


parseImage :: Parser HeaderDataUnit
parseImage :: Parser HeaderDataUnit
parseImage = do
    Dimensions
dm <- Parser Dimensions
parseImageKeywords
    Header
hd <- Parser Header
parseHeader
    ByteString
dt <- Dimensions -> Parser ByteString
parseMainData Dimensions
dm
    HeaderDataUnit -> Parser HeaderDataUnit
forall a. a -> ParsecT Void ByteString Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (HeaderDataUnit -> Parser HeaderDataUnit)
-> HeaderDataUnit -> Parser HeaderDataUnit
forall a b. (a -> b) -> a -> b
$ Header -> Dimensions -> Extension -> ByteString -> HeaderDataUnit
HeaderDataUnit Header
hd Dimensions
dm Extension
Image ByteString
dt

parseImageKeywords :: Parser Dimensions
parseImageKeywords :: Parser Dimensions
parseImageKeywords = do
    ParsecT Void ByteString Identity (Tokens ByteString)
-> ParsecT Void ByteString Identity (Tokens ByteString)
forall a.
ParsecT Void ByteString Identity a
-> ParsecT Void ByteString Identity a
ignoreComments (ParsecT Void ByteString Identity (Tokens ByteString)
 -> ParsecT Void ByteString Identity (Tokens ByteString))
-> ParsecT Void ByteString Identity (Tokens ByteString)
-> ParsecT Void ByteString Identity (Tokens ByteString)
forall a b. (a -> b) -> a -> b
$ Tokens ByteString
-> ParsecT Void ByteString Identity (Tokens ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
M.string' Tokens ByteString
"XTENSION= 'IMAGE   '"
    Parser Dimensions -> Parser Dimensions
forall a.
ParsecT Void ByteString Identity a
-> ParsecT Void ByteString Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
M.lookAhead Parser Dimensions
parseDimensions

parseBinTable :: Parser HeaderDataUnit
parseBinTable :: Parser HeaderDataUnit
parseBinTable = do
    (Dimensions
dm, Int
pc) <- ParsecT Void ByteString Identity (Dimensions, Int)
-> ParsecT Void ByteString Identity (Dimensions, Int)
forall a.
ParsecT Void ByteString Identity a
-> ParsecT Void ByteString Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
M.lookAhead ParsecT Void ByteString Identity (Dimensions, Int)
parseBinTableKeywords
    Header
hd <- Parser Header
parseHeader
    ByteString
dt <- Dimensions -> Parser ByteString
parseMainData Dimensions
dm
    ByteString
hp <- Parser ByteString
parseBinTableHeap
    let tab :: Extension
tab = Int -> ByteString -> Extension
BinTable Int
pc ByteString
hp
    HeaderDataUnit -> Parser HeaderDataUnit
forall a. a -> ParsecT Void ByteString Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (HeaderDataUnit -> Parser HeaderDataUnit)
-> HeaderDataUnit -> Parser HeaderDataUnit
forall a b. (a -> b) -> a -> b
$ Header -> Dimensions -> Extension -> ByteString -> HeaderDataUnit
HeaderDataUnit Header
hd Dimensions
dm Extension
tab ByteString
dt
    where
      parseBinTableHeap :: Parser ByteString
parseBinTableHeap = ByteString -> Parser ByteString
forall a. a -> ParsecT Void ByteString Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
""

parseBinTableKeywords :: Parser (Dimensions, Int)
parseBinTableKeywords :: ParsecT Void ByteString Identity (Dimensions, Int)
parseBinTableKeywords = do 
  ParsecT Void ByteString Identity (Tokens ByteString)
-> ParsecT Void ByteString Identity (Tokens ByteString)
forall a.
ParsecT Void ByteString Identity a
-> ParsecT Void ByteString Identity a
ignoreComments (ParsecT Void ByteString Identity (Tokens ByteString)
 -> ParsecT Void ByteString Identity (Tokens ByteString))
-> ParsecT Void ByteString Identity (Tokens ByteString)
-> ParsecT Void ByteString Identity (Tokens ByteString)
forall a b. (a -> b) -> a -> b
$ Tokens ByteString
-> ParsecT Void ByteString Identity (Tokens ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
M.string' Tokens ByteString
"XTENSION= 'BINTABLE'"
  Dimensions
sz <- Parser Dimensions
parseDimensions
  Int
pc <- ByteString -> Parser Int -> Parser Int
forall a. ByteString -> Parser a -> Parser a
parseKeywordRecord' ByteString
"PCOUNT" Parser Int
forall a. Num a => Parser a
parseInt
  (Dimensions, Int)
-> ParsecT Void ByteString Identity (Dimensions, Int)
forall a. a -> ParsecT Void ByteString Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Dimensions
sz, Int
pc)

parseMainData :: Dimensions -> Parser ByteString
parseMainData :: Dimensions -> Parser ByteString
parseMainData Dimensions
size = do
    let len :: Int
len = Dimensions -> Int
dataSize Dimensions
size
    Maybe String
-> Int -> ParsecT Void ByteString Identity (Tokens ByteString)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> Int -> m (Tokens s)
M.takeP (String -> Maybe String
forall a. a -> Maybe a
Just (String
"Data Array of " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
len String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" Bytes")) (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)

parseHDU :: Parser HeaderDataUnit
parseHDU :: Parser HeaderDataUnit
parseHDU =
    Parser HeaderDataUnit
parsePrimary Parser HeaderDataUnit
-> Parser HeaderDataUnit -> Parser HeaderDataUnit
forall a.
ParsecT Void ByteString Identity a
-> ParsecT Void ByteString Identity a
-> ParsecT Void ByteString Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser HeaderDataUnit
parseImage Parser HeaderDataUnit
-> Parser HeaderDataUnit -> Parser HeaderDataUnit
forall a.
ParsecT Void ByteString Identity a
-> ParsecT Void ByteString Identity a
-> ParsecT Void ByteString Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser HeaderDataUnit
parseBinTable

parseHDUs :: Parser [HeaderDataUnit]
parseHDUs :: Parser [HeaderDataUnit]
parseHDUs = do
    Parser HeaderDataUnit -> Parser [HeaderDataUnit]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
M.many Parser HeaderDataUnit
parseHDU

dataSize :: Dimensions -> Int
dataSize :: Dimensions -> Int
dataSize (Dimensions BitPixFormat
bitpix Axes
axes) = BitPixFormat -> Int
size BitPixFormat
bitpix Int -> Int -> Int
forall a. Num a => a -> a -> a
* Axes -> Int
forall {a} {a}. (Integral a, Num a) => [a] -> a
count Axes
axes
  where
    count :: [a] -> a
count [] = a
0
    count [a]
ax = a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ [a] -> a
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [a]
ax
    size :: BitPixFormat -> Int
size = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> (BitPixFormat -> Int) -> BitPixFormat -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BitPixFormat -> Int
bitPixToByteSize