{-|
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 )
---- containers
import qualified Data.Map.Lazy as Map
---- megaparsec
import qualified Text.Megaparsec as M
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.Text.Encoding as C8
import qualified Data.Binary as C8


-- symbol imports
---- bytestring
import Data.ByteString ( ByteString )
---- containers
import Data.Map ( Map )
---- 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 )
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
  , Comment(Comment)
  , Dimensions(Dimensions)
  , Header(Header)
  , HeaderDataUnit(HeaderDataUnit)
  , Keyword(Keyword)
  , 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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord

wordsText :: [Word8] -> Text
wordsText :: [Word8] -> Text
wordsText = ByteString -> Text
TE.decodeUtf8 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 (Map Keyword Value)
parseHeader :: Parser (Map Keyword Value)
parseHeader = do
    [Maybe (Keyword, Value)]
pairs <- forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
M.manyTill Parser (Maybe (Keyword, Value))
parseRecordLine (forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
M.string' Tokens ByteString
"end")
    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
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes [Maybe (Keyword, Value)]
pairs

parseRecordLine :: Parser (Maybe (Keyword, Value))
parseRecordLine :: Parser (Maybe (Keyword, Value))
parseRecordLine = do
    forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
M.try forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Keyword, Value)
parseKeywordRecord
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser Comment
parseLineComment
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ 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
' '))

-- | Combinator to allow for parsing a record with inline comments
withComments :: Parser a -> Parser a
withComments :: forall a. Parser a -> Parser a
withComments Parser a
parse = do
    Int
start <- Parser Int
parsePos
    a
a <- Parser a
parse
    forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m ()
M.space
    forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
M.optional forall a b. (a -> b) -> a -> b
$ Int -> Parser Comment
parseInlineComment Int
start
    forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m ()
M.space
    forall (m :: * -> *) a. Monad m => a -> m a
return a
a

parseKeywordRecord :: Parser (Keyword, Value)
parseKeywordRecord :: Parser (Keyword, Value)
parseKeywordRecord = forall a. Parser a -> Parser a
withComments Parser (Keyword, Value)
parseKeywordValue

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

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

parseInlineComment :: Int -> Parser Comment
parseInlineComment :: Int -> Parser Comment
parseInlineComment Int
start = do
    forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
M.char forall a b. (a -> b) -> a -> b
$ Char -> Word8
toWord Char
'/'
    forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m ()
M.space
    Int
com <- Parser Int
parsePos
    let end :: Int
end = Int
start forall a. Num a => a -> a -> a
+ Int
hduRecordLength
    let rem :: Int
rem = Int
end forall a. Num a => a -> a -> a
- Int
com
    [Word8]
c <- forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
M.count Int
rem forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
M.anySingle
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Comment
Comment ([Word8] -> Text
wordsText [Word8]
c)

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

-- | Anything but a space or equals
parseKeyword :: Parser Keyword
parseKeyword :: Parser Keyword
parseKeyword = Text -> Keyword
Keyword forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> Text
wordsText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
M.some (forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
M.noneOf 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
    forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
M.try (Float -> Value
Float forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Float
parseFloat)
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
M.try (Int -> Value
Integer forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Num a => Parser a
parseInt)
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (LogicalConstant -> Value
Logic forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser LogicalConstant
parseLogic)
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Value
String forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
parseStringContinue)

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

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

parseLogic :: Parser LogicalConstant
parseLogic :: Parser LogicalConstant
parseLogic = do
    forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
M.string' Tokens ByteString
"T"
    forall (m :: * -> *) a. Monad m => a -> m a
return LogicalConstant
T

parseStringContinue :: Parser Text
parseStringContinue :: Parser Text
parseStringContinue = do
    Text
t <- Parser Text
parseStringValue

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

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

parseStringValue :: Parser Text
parseStringValue :: Parser 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 <- forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
M.between (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
M.char Word8
quote) (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
M.char Word8
quote) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
M.many forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
M.anySingleBut Word8
quote
    Parser ()
consumeDead
    forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Text
T.stripEnd forall a b. (a -> b) -> a -> b
$ [Word8] -> Text
wordsText [Word8]
ls)
    where quote :: Word8
quote = Char -> Word8
toWord Char
'\''

requireKeyword :: Keyword -> Header -> Parser Value
requireKeyword :: Keyword -> Header -> Parser Value
requireKeyword Keyword
k Header
kvs = do
    case Keyword -> Header -> Maybe Value
Fits.lookup Keyword
k Header
kvs of
      Maybe Value
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Missing: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Keyword
k
      Just Value
v -> 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 <- Keyword -> Header -> Parser Value
requireKeyword Keyword
"NAXIS" Header
kvs
    case Value
v of
      Integer Int
n -> forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
      Value
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid NAXIS header"

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

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

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

parseEquals :: Parser ()
parseEquals :: Parser ()
parseEquals = forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m ()
M.space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
M.char (Char -> Word8
toWord Char
'=') forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcePos -> Pos
MP.sourceColumn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
M.getSourcePos


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

parseNaxes :: Parser Axes
parseNaxes :: Parser Axes
parseNaxes = do
    Int
n <- forall a. ByteString -> Parser a -> Parser a
parseKeywordRecord' ByteString
"NAXIS" forall a. Num a => Parser a
parseInt
    forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Int -> Parser Int
parseN [Int
1..Int
n]
  where
    parseN :: Int -> Parser Int
    parseN :: Int -> Parser Int
parseN Int
n = forall a. Parser a -> Parser a
withComments forall a b. (a -> b) -> a -> b
$ do
      forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
M.string' Tokens ByteString
"NAXIS"
      forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
M.string' forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
BS.pack forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
toWord (forall a. Show a => a -> String
show Int
n)
      Parser ()
parseEquals
      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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Axes
parseNaxes

parsePrimary :: Parser HeaderDataUnit
parsePrimary :: Parser HeaderDataUnit
parsePrimary = do
    forall a. ByteString -> Parser a -> Parser a
parseKeywordRecord' ByteString
"SIMPLE" Parser LogicalConstant
parseLogic
    Dimensions
dm <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
M.lookAhead Parser Dimensions
parseDimensions
    Map Keyword Value
hd <- Parser (Map Keyword Value)
parseHeader
    ByteString
dt <- Dimensions -> Parser ByteString
parseMainData Dimensions
dm
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Header -> Dimensions -> Extension -> ByteString -> HeaderDataUnit
HeaderDataUnit (Map Keyword Value -> Header
Header Map Keyword Value
hd) Dimensions
dm Extension
Primary ByteString
dt

parseImage :: Parser HeaderDataUnit
parseImage :: Parser HeaderDataUnit
parseImage = do
    forall a. Parser a -> Parser a
withComments forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
M.string' Tokens ByteString
"XTENSION= 'IMAGE   '"
    Dimensions
dm <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
M.lookAhead Parser Dimensions
parseDimensions
    Map Keyword Value
hd <- Parser (Map Keyword Value)
parseHeader
    ByteString
dt <- Dimensions -> Parser ByteString
parseMainData Dimensions
dm
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Header -> Dimensions -> Extension -> ByteString -> HeaderDataUnit
HeaderDataUnit (Map Keyword Value -> Header
Header Map Keyword Value
hd) Dimensions
dm Extension
Image ByteString
dt

parseBinTable :: Parser HeaderDataUnit
parseBinTable :: Parser HeaderDataUnit
parseBinTable = do
    (Dimensions
dm, Int
pc) <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
M.lookAhead Parser (Dimensions, Int)
parseBinTableKeywords
    Map Keyword Value
hd <- Parser (Map Keyword Value)
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
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Header -> Dimensions -> Extension -> ByteString -> HeaderDataUnit
HeaderDataUnit (Map Keyword Value -> Header
Header Map Keyword Value
hd) Dimensions
dm Extension
tab ByteString
dt
    where
      parseBinTableHeap :: Parser ByteString
parseBinTableHeap = forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
""

parseBinTableKeywords :: Parser (Dimensions, Int)
parseBinTableKeywords :: Parser (Dimensions, Int)
parseBinTableKeywords = do 
  forall a. Parser a -> Parser a
withComments forall a b. (a -> b) -> a -> b
$ 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 <- forall a. ByteString -> Parser a -> Parser a
parseKeywordRecord' ByteString
"PCOUNT" forall a. Num a => Parser a
parseInt
  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
    forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> Int -> m (Tokens s)
M.takeP (forall a. a -> Maybe a
Just (String
"Data Array of " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
len forall a. Semigroup a => a -> a -> a
<> String
" Bytes")) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)

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

parseHDUs :: Parser [HeaderDataUnit]
parseHDUs :: Parser [HeaderDataUnit]
parseHDUs = do
    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 forall a. Num a => a -> a -> a
* forall {a} {a}. (Integral a, Num a) => [a] -> a
count Axes
axes
  where
    count :: [a] -> a
count [] = a
0
    count [a]
ax = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [a]
ax
    size :: BitPixFormat -> Int
size = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. BitPixFormat -> Int
bitPixToByteSize