{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE OverloadedStrings #-}
module Data.Fits.MegaParser where
import qualified Data.ByteString as BS
import qualified Data.ByteString.Internal as BS ( c2w )
import qualified Data.Map.Lazy as Map
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
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Data.Fits as Fits
import qualified Data.Text.Encoding as C8
import qualified Data.Binary as C8
import Data.ByteString ( ByteString )
import Data.Map ( Map )
import Data.Text ( Text )
import Text.Ascii ( isAscii )
import Text.Megaparsec ( Parsec, ParseErrorBundle, (<|>), (<?>))
import Lens.Micro ((^.))
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 )
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
parseHeader :: Parser (Map Keyword Value)
= 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
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
' '))
withComments :: Parser a -> Parser a
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
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
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
= 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)
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 =
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
[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
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