{-# LANGUAGE OverloadedStrings #-}

-- {-# OPTIONS_HADDOCK hide #-}

module Telescope.Fits.Encoding.MegaHeader where

import Control.Monad (void)
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.ByteString.Char8 qualified as C8
import Data.Char (ord)
import Data.List qualified as L
import Data.List.NonEmpty qualified as NE
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Encoding qualified as TE
import Data.Void (Void)
import Data.Word (Word8)
import Telescope.Data.Axes
import Telescope.Fits.BitPix
import Telescope.Fits.DataArray
import Telescope.Fits.HDU.Block (hduRecordLength)
import Telescope.Fits.Header hiding (FromKeyword (..), parseHeader, parseKeyword)
import Text.Megaparsec (ParseErrorBundle, Parsec, (<|>))
import Text.Megaparsec qualified as M
import Text.Megaparsec.Byte qualified as M
import Text.Megaparsec.Byte.Lexer qualified as MBL
import Text.Megaparsec.Error (ParseError (..), ParseErrorBundle (..))
import Text.Megaparsec.Error qualified as MP
import Text.Megaparsec.Pos qualified as MP
import Text.Megaparsec.State qualified as M


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


-- | Runs a single parser and returns the remainder of the input
runNextParser :: String -> BS.ByteString -> Parser a -> Either ParseErr (a, BS.ByteString)
runNextParser :: forall a.
String -> ByteString -> Parser a -> Either ParseErr (a, ByteString)
runNextParser String
src ByteString
inp Parser a
parse = do
  let st1 :: State ByteString Void
st1 = String -> ByteString -> State ByteString Void
forall s e. String -> s -> State s e
M.initialState String
src ByteString
inp
  case Parser a
-> State ByteString Void
-> (State ByteString Void, Either ParseErr a)
forall e s a.
Parsec e s a
-> State s e -> (State s e, Either (ParseErrorBundle s e) a)
M.runParser' Parser a
parse State ByteString Void
st1 of
    (State ByteString Void
st2, Right a
a) -> do
      -- only consumes input if it succeeds
      let rest :: ByteString
rest = Int -> ByteString -> ByteString
BS.drop State ByteString Void
st2.stateOffset ByteString
inp
      (a, ByteString) -> Either ParseErr (a, ByteString)
forall a. a -> Either ParseErr a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, ByteString
rest)
    (State ByteString Void
_, Left ParseErr
err) -> ParseErr -> Either ParseErr (a, ByteString)
forall a b. a -> Either a b
Left ParseErr
err


showParseError :: ParseErr -> String
showParseError :: ParseErr -> String
showParseError ParseErr
bundle =
  let pos :: PosState ByteString
pos = ParseErr
bundle.bundlePosState
      inp :: ByteString
inp = PosState ByteString
pos.pstateInput
   in String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate String
"\n HI " (NonEmpty String -> [String]
forall a. NonEmpty a -> [a]
NE.toList ((ParseError ByteString Void -> String)
-> NonEmpty (ParseError ByteString Void) -> NonEmpty String
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> ParseError ByteString Void -> String
showError ByteString
inp) ParseErr
bundle.bundleErrors))
 where
  showError :: ByteString -> ParseError ByteString Void -> String
  showError :: ByteString -> ParseError ByteString Void -> String
showError ByteString
inp ParseError ByteString Void
err =
    ByteString -> Int -> String
showCurrent ByteString
inp (ParseError ByteString Void -> Int
forall s e. ParseError s e -> Int
MP.errorOffset ParseError ByteString Void
err) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n  " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate String
"\n  " (String -> [String]
lines (ParseError ByteString Void -> String
forall s e.
(VisualStream s, ShowErrorComponent e) =>
ParseError s e -> String
MP.parseErrorPretty ParseError ByteString Void
err))

  showCurrent :: ByteString -> Int -> String
showCurrent ByteString
inp Int
off =
    let line :: Int
line = forall a b. (RealFrac a, Integral b) => a -> b
floor @Float @Int (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
off Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
hduRecordLength)
        col :: Int
col = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
hduRecordLength)
     in String
"HDU Header "
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
line
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" column "
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
col
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": \n"
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall a. Show a => a -> String
show (Int -> ByteString -> ByteString
BS.take Int
hduRecordLength (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop (Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
hduRecordLength) ByteString
inp)


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 (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)
    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
<|> 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
parseLineCommentSpaces)
    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
<|> (Text -> HeaderRecord
History (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
parseLineHistory)


parseLineHistory :: Parser Text
parseLineHistory :: ParsecT Void ByteString Identity Text
parseLineHistory = do
  Int
lineStart <- Parser Int
parsePos
  Tokens 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' Tokens ByteString
"HISTORY "
  ParsecT Void ByteString Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m ()
M.space
  Int -> Parser Word8 -> ParsecT Void ByteString Identity Text
untilLineEnd Int
lineStart Parser Word8
ParsecT Void ByteString Identity (Token ByteString)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
M.anySingle


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
_ <- 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)


untilLineEnd :: Int -> Parser Word8 -> Parser Text
untilLineEnd :: Int -> Parser Word8 -> ParsecT Void ByteString Identity Text
untilLineEnd Int
lineStart Parser Word8
parseChar = do
  Int
curr <- Parser Int
parsePos
  let used :: Int
used = Int
curr Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lineStart
  [Word8]
bs <- Int -> Parser 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) Parser Word8
parseChar
  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]
bs


spacesToLineEnd :: Int -> Parser ()
spacesToLineEnd :: Int -> ParsecT Void ByteString Identity ()
spacesToLineEnd Int
lineStart = do
  Text
_ <- Int -> Parser Word8 -> ParsecT Void ByteString Identity Text
untilLineEnd Int
lineStart (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 ()
forall a. a -> ParsecT Void ByteString Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


parseInlineComment :: Int -> Parser Text
parseInlineComment :: Int -> ParsecT Void ByteString Identity Text
parseInlineComment Int
lineStart = do
  ParsecT Void ByteString Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m ()
M.space
  Word8
_ <- 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
'/'
  Maybe (Token ByteString)
_ <- 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
  Text -> Text
T.strip (Text -> Text)
-> ParsecT Void ByteString Identity Text
-> ParsecT Void ByteString Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser Word8 -> ParsecT Void ByteString Identity Text
untilLineEnd Int
lineStart Parser Word8
ParsecT Void ByteString Identity (Token ByteString)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
M.anySingle
 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 kw :: ByteString
kw = ByteString
"COMMENT " :: ByteString
  Tokens 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
kw
  [Word8]
c <- Int -> Parser 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
kw) Parser 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


parseLineCommentSpaces :: Parser Text
parseLineCommentSpaces :: ParsecT Void ByteString Identity Text
parseLineCommentSpaces = do
  -- Invalid comments used by JWST
  Int
lineStart <- Parser Int
parsePos
  -- exactly 8 spaces
  [Token ByteString]
_ <- Int
-> ParsecT Void ByteString Identity (Token ByteString)
-> ParsecT Void ByteString Identity [Token ByteString]
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
M.count Int
8 ((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 (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
toWord Char
' '))
  Text -> Text
T.strip (Text -> Text)
-> ParsecT Void ByteString Identity Text
-> ParsecT Void ByteString Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser Word8 -> ParsecT Void ByteString Identity Text
untilLineEnd Int
lineStart Parser Word8
ParsecT Void ByteString Identity (Token ByteString)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
M.anySingle


parseLineBlank :: Parser ()
parseLineBlank :: ParsecT Void ByteString Identity ()
parseLineBlank = do
  ([Token ByteString], Maybe Text)
_ <- ParsecT Void ByteString Identity [Token ByteString]
-> Parser ([Token ByteString], Maybe Text)
forall a. Parser a -> Parser (a, Maybe Text)
withComments (ParsecT Void ByteString Identity [Token ByteString]
 -> Parser ([Token ByteString], Maybe Text))
-> ParsecT Void ByteString Identity [Token ByteString]
-> Parser ([Token ByteString], Maybe Text)
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> ParsecT Void ByteString Identity (Token ByteString)
-> ParsecT Void ByteString Identity [Token ByteString]
forall (m :: * -> *) a. MonadPlus m => Int -> Int -> m a -> m [a]
M.count' Int
0 Int
80 ((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 (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 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
<$> Parser 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 (Double -> Value
Float (Double -> Value)
-> ParsecT Void ByteString Identity Double -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void ByteString Identity Double
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 Double
parseFloat :: ParsecT Void ByteString Identity Double
parseFloat = ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity Double
-> ParsecT Void ByteString Identity Double
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 Double
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
$ ParsecT Void ByteString Identity Text
-> ParsecT Void ByteString Identity 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 ParsecT Void ByteString Identity Text
parseContinue

  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


parseContinue :: Parser Text
parseContinue :: ParsecT Void ByteString Identity Text
parseContinue = do
  ParsecT Void ByteString Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m ()
M.space
  Int
lineStart <- Parser Int
parsePos
  Tokens 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' Tokens ByteString
"CONTINUE"
  ParsecT Void ByteString Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m ()
M.space
  Text
more <- ParsecT Void ByteString Identity Text
parseStringContinue
  Maybe Text
_ <- Int -> Parser (Maybe Text)
parseLineEnd Int
lineStart
  Text -> ParsecT Void ByteString Identity Text
forall a. a -> ParsecT Void ByteString Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
more


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 <- Parser Word8
-> Parser 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
$ Parser Word8 -> ParsecT Void ByteString Identity [Word8]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
M.many (Parser Word8 -> ParsecT Void ByteString Identity [Word8])
-> Parser 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
  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
  -- consumeDead :: Parser ()
  -- consumeDead = M.space >> skipEmpty
  quote :: Word8
quote = Char -> Word8
toWord Char
'\''


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' ==))


-- parseEnd :: Parser ()
-- parseEnd = M.string' "end" >> M.space <* 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 () -> Parser Word8 -> Parser 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
'=') Parser 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 BitPix
parseBitPix :: Parser BitPix
parseBitPix = do
  Value
v <- ByteString -> Parser Value -> Parser Value
forall a. ByteString -> Parser a -> Parser a
parseKeywordRecord' ByteString
"BITPIX" Parser Value
parseValue
  Value -> Parser BitPix
forall {m :: * -> *}. MonadFail m => Value -> m BitPix
toBitpix Value
v
 where
  toBitpix :: Value -> m BitPix
toBitpix (Integer Int
8) = BitPix -> m BitPix
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return BitPix
BPInt8
  toBitpix (Integer Int
16) = BitPix -> m BitPix
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return BitPix
BPInt16
  toBitpix (Integer Int
32) = BitPix -> m BitPix
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return BitPix
BPInt32
  toBitpix (Integer Int
64) = BitPix -> m BitPix
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return BitPix
BPInt64
  toBitpix (Integer (-32)) = BitPix -> m BitPix
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return BitPix
BPFloat
  toBitpix (Integer (-64)) = BitPix -> m BitPix
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return BitPix
BPDouble
  toBitpix Value
_ = String -> m BitPix
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid BITPIX header"


parseNaxes :: Parser (Axes Column)
parseNaxes :: Parser (Axes 'Column)
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] -> Axes 'Column
forall (a :: Major). [Int] -> Axes a
Axes ([Int] -> Axes 'Column)
-> ParsecT Void ByteString Identity [Int] -> Parser (Axes 'Column)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Parser Int)
-> [Int] -> ParsecT Void ByteString Identity [Int]
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
  BitPix
bp <- Parser BitPix
parseBitPix
  BitPix -> Axes 'Column -> Dimensions
Dimensions BitPix
bp (Axes 'Column -> Dimensions)
-> Parser (Axes 'Column) -> Parser Dimensions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Axes 'Column)
parseNaxes


parsePrimaryKeywords :: Parser Dimensions
parsePrimaryKeywords :: Parser Dimensions
parsePrimaryKeywords = do
  LogicalConstant
_ <- 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
parseDimensions


parseImageKeywords :: Parser Dimensions
parseImageKeywords :: Parser Dimensions
parseImageKeywords = do
  Tokens ByteString
_ <- 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
parseDimensions


parseBinTableKeywords :: Parser (Dimensions, Int)
parseBinTableKeywords :: Parser (Dimensions, Int)
parseBinTableKeywords = do
  Tokens ByteString
_ <- 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) -> Parser (Dimensions, Int)
forall a. a -> ParsecT Void ByteString Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Dimensions
sz, Int
pc)

-- parsePrimary :: Parser DataHDU
-- parsePrimary = do
--   -- do not consume the headers used for the dimensions
--   dm <- M.lookAhead parsePrimaryKeywords
--   hd <- parseHeader
--   dt <- parseMainData dm
--   return $ DataHDU hd (dataArray dm dt)

-- parseImage :: Parser DataHDU
-- parseImage = do
--   -- do not consume the headers used for the dimensions
--   dm <- M.lookAhead parseImageKeywords
--   hd <- parseHeader
--   dt <- parseMainData dm
--   return $ DataHDU hd (dataArray dm dt)
-- parseBinTable :: Parser BinTableHDU
-- parseBinTable = do
--   (dm, pc) <- M.lookAhead parseBinTableKeywords
--   hd <- parseHeader
--   dt <- parseMainData dm
--   hp <- parseBinTableHeap
--   return $ BinTableHDU hd pc hp (dataArray dm dt)
--  where
--   parseBinTableHeap = return ""

-- parseMainData :: Dimensions -> Parser ByteString
-- parseMainData size = do
--   let len = dataSizeBytes size
--   M.takeP (Just ("Data Array of " <> show len <> " Bytes")) (fromIntegral len)
--
--
-- parseExtensions :: Parser [Extension]
-- parseExtensions = do
--   M.many parseExtension
--  where
--   parseExtension :: Parser Extension
--   parseExtension =
--     Image <$> parseImage <|> BinTable <$> parseBinTable