module Telescope.Fits.Encoding where

import Control.Monad.Catch (MonadThrow, throwM)
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.Text (Text)
import Data.Text.Encoding qualified as TE
import Effectful
import Effectful.Dispatch.Dynamic
import Effectful.Error.Static
import Effectful.State.Static.Local
import Telescope.Data.Parser
import Telescope.Fits.Checksum
import Telescope.Fits.DataArray (DataArray (..), Dimensions (..), dataArray, dataSizeBytes)
import Telescope.Fits.Encoding.MegaHeader qualified as MH
import Telescope.Fits.Encoding.Render
import Telescope.Fits.HDU
import Telescope.Fits.Header
import Text.Megaparsec (lookAhead)
import Text.Megaparsec qualified as MP


{- | Decode a FITS file read from a strict 'ByteString'

>  decode =<< BS.readFile "samples/simple2x3.fits"
-}
decode :: forall m. (MonadThrow m) => ByteString -> m Fits
decode :: forall (m :: * -> *). MonadThrow m => ByteString -> m Fits
decode = Eff '[State ByteString, Parser, Error ParseError] Fits
-> ByteString -> m Fits
forall (m :: * -> *) a.
MonadThrow m =>
Eff '[State ByteString, Parser, Error ParseError] a
-> ByteString -> m a
fitsParseThrow Eff '[State ByteString, Parser, Error ParseError] Fits
forall (es :: [(* -> *) -> * -> *]).
(State ByteString :> es, Parser :> es) =>
Eff es Fits
parseFits


{- | Encode a FITS file to a strict 'ByteString'

> BS.writeFile $ encode fits
-}
encode :: Fits -> ByteString
encode :: Fits -> ByteString
encode Fits
f =
  let prim :: ByteString
prim = DataHDU -> ByteString
encodePrimaryHDU Fits
f.primaryHDU
      exts :: [ByteString]
exts = (Extension -> ByteString) -> [Extension] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Extension -> ByteString
encodeExtension Fits
f.extensions
   in [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
prim ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
exts


fitsParseThrow :: (MonadThrow m) => Eff '[State ByteString, Parser, Error ParseError] a -> ByteString -> m a
fitsParseThrow :: forall (m :: * -> *) a.
MonadThrow m =>
Eff '[State ByteString, Parser, Error ParseError] a
-> ByteString -> m a
fitsParseThrow Eff '[State ByteString, Parser, Error ParseError] a
parse ByteString
inp =
  case Eff '[State ByteString, Parser, Error ParseError] a
-> ByteString -> Either ParseError a
forall a.
Eff '[State ByteString, Parser, Error ParseError] a
-> ByteString -> Either ParseError a
runFitsParse Eff '[State ByteString, Parser, Error ParseError] a
parse ByteString
inp of
    Left ParseError
e -> ParseError -> m a
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM ParseError
e
    Right a
a -> a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a


runFitsParse :: Eff '[State ByteString, Parser, Error ParseError] a -> BS.ByteString -> Either ParseError a
runFitsParse :: forall a.
Eff '[State ByteString, Parser, Error ParseError] a
-> ByteString -> Either ParseError a
runFitsParse Eff '[State ByteString, Parser, Error ParseError] a
parse ByteString
inp = do
  Eff '[Parser, Error ParseError] a -> Either ParseError a
forall a. Eff '[Parser, Error ParseError] a -> Either ParseError a
runParserPure (Eff '[Parser, Error ParseError] a -> Either ParseError a)
-> Eff '[Parser, Error ParseError] a -> Either ParseError a
forall a b. (a -> b) -> a -> b
$ ByteString
-> Eff '[State ByteString, Parser, Error ParseError] a
-> Eff '[Parser, Error ParseError] a
forall s (es :: [(* -> *) -> * -> *]) a.
HasCallStack =>
s -> Eff (State s : es) a -> Eff es a
evalState ByteString
inp Eff '[State ByteString, Parser, Error ParseError] a
parse


parseFits :: forall es. (State ByteString :> es, Parser :> es) => Eff es Fits
parseFits :: forall (es :: [(* -> *) -> * -> *]).
(State ByteString :> es, Parser :> es) =>
Eff es Fits
parseFits = do
  DataHDU
p <- Eff es DataHDU
forall (es :: [(* -> *) -> * -> *]).
(State ByteString :> es, Parser :> es) =>
Eff es DataHDU
primary
  [Extension]
es <- Ref -> Eff es [Extension] -> Eff es [Extension]
forall (es :: [(* -> *) -> * -> *]) a.
(Parser :> es) =>
Ref -> Eff es a -> Eff es a
parseAt (Text -> Ref
Child Text
"extensions") (Eff es [Extension] -> Eff es [Extension])
-> Eff es [Extension] -> Eff es [Extension]
forall a b. (a -> b) -> a -> b
$ Int -> Eff es [Extension]
forall (es :: [(* -> *) -> * -> *]).
(State ByteString :> es, Parser :> es) =>
Int -> Eff es [Extension]
extensions Int
1
  Fits -> Eff es Fits
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Fits -> Eff es Fits) -> Fits -> Eff es Fits
forall a b. (a -> b) -> a -> b
$ DataHDU -> [Extension] -> Fits
Fits DataHDU
p [Extension]
es


primary :: (State ByteString :> es, Parser :> es) => Eff es DataHDU
primary :: forall (es :: [(* -> *) -> * -> *]).
(State ByteString :> es, Parser :> es) =>
Eff es DataHDU
primary = do
  Ref -> Eff es DataHDU -> Eff es DataHDU
forall (es :: [(* -> *) -> * -> *]) a.
(Parser :> es) =>
Ref -> Eff es a -> Eff es a
parseAt (Text -> Ref
Child Text
"primary") (Eff es DataHDU -> Eff es DataHDU)
-> Eff es DataHDU -> Eff es DataHDU
forall a b. (a -> b) -> a -> b
$ do
    (Dimensions
dm, Header
hd) <- String
-> Parser (Dimensions, Header) -> Eff es (Dimensions, Header)
forall (es :: [(* -> *) -> * -> *]) a.
(Parser :> es, State ByteString :> es) =>
String -> Parser a -> Eff es a
runMega String
"Primary Header" (Parser (Dimensions, Header) -> Eff es (Dimensions, Header))
-> Parser (Dimensions, Header) -> Eff es (Dimensions, Header)
forall a b. (a -> b) -> a -> b
$ do
      Dimensions
dm <- ParsecT Void ByteString Identity Dimensions
-> ParsecT Void ByteString Identity 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
MP.lookAhead ParsecT Void ByteString Identity Dimensions
MH.parsePrimaryKeywords
      Header
hd <- Parser Header
MH.parseHeader
      (Dimensions, Header) -> Parser (Dimensions, Header)
forall a. a -> ParsecT Void ByteString Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dimensions
dm, Header
hd)
    DataArray
darr <- Dimensions -> Eff es DataArray
forall (es :: [(* -> *) -> * -> *]).
(State ByteString :> es) =>
Dimensions -> Eff es DataArray
mainData Dimensions
dm
    DataHDU -> Eff es DataHDU
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DataHDU -> Eff es DataHDU) -> DataHDU -> Eff es DataHDU
forall a b. (a -> b) -> a -> b
$ Header -> DataArray -> DataHDU
DataHDU Header
hd DataArray
darr


extensions :: (State ByteString :> es, Parser :> es) => Int -> Eff es [Extension]
extensions :: forall (es :: [(* -> *) -> * -> *]).
(State ByteString :> es, Parser :> es) =>
Int -> Eff es [Extension]
extensions Int
n = do
  ByteString
inp <- forall s (es :: [(* -> *) -> * -> *]).
(HasCallStack, State s :> es) =>
Eff es s
get @ByteString
  -- recurse until you run out of input or error
  case ByteString
inp of
    ByteString
"" -> [Extension] -> Eff es [Extension]
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    ByteString
_ -> do
      Extension
e <- Ref -> Eff es Extension -> Eff es Extension
forall (es :: [(* -> *) -> * -> *]) a.
(Parser :> es) =>
Ref -> Eff es a -> Eff es a
parseAt (Int -> Ref
Index Int
n) Eff es Extension
forall (es :: [(* -> *) -> * -> *]).
(State ByteString :> es, Parser :> es) =>
Eff es Extension
extension
      [Extension]
es <- Int -> Eff es [Extension]
forall (es :: [(* -> *) -> * -> *]).
(State ByteString :> es, Parser :> es) =>
Int -> Eff es [Extension]
extensions (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      [Extension] -> Eff es [Extension]
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Extension
e Extension -> [Extension] -> [Extension]
forall a. a -> [a] -> [a]
: [Extension]
es)


extension :: (State ByteString :> es, Parser :> es) => Eff es Extension
extension :: forall (es :: [(* -> *) -> * -> *]).
(State ByteString :> es, Parser :> es) =>
Eff es Extension
extension = do
  -- I don't understand how to use NonDet to fix this
  Either ParseError DataHDU
resImg <- forall e (es :: [(* -> *) -> * -> *]) a.
HasCallStack =>
Eff (Error e : es) a -> Eff es (Either e a)
runErrorNoCallStack @ParseError (Eff (Error ParseError : es) DataHDU
 -> Eff es (Either ParseError DataHDU))
-> Eff (Error ParseError : es) DataHDU
-> Eff es (Either ParseError DataHDU)
forall a b. (a -> b) -> a -> b
$ Eff (Parser : Error ParseError : es) DataHDU
-> Eff (Error ParseError : es) DataHDU
forall (es :: [(* -> *) -> * -> *]) a.
(Error ParseError :> es) =>
Eff (Parser : es) a -> Eff es a
runParser Eff (Parser : Error ParseError : es) DataHDU
forall (es :: [(* -> *) -> * -> *]).
(State ByteString :> es, Parser :> es) =>
Eff es DataHDU
image
  Either ParseError BinTableHDU
resTbl <- forall e (es :: [(* -> *) -> * -> *]) a.
HasCallStack =>
Eff (Error e : es) a -> Eff es (Either e a)
runErrorNoCallStack @ParseError (Eff (Error ParseError : es) BinTableHDU
 -> Eff es (Either ParseError BinTableHDU))
-> Eff (Error ParseError : es) BinTableHDU
-> Eff es (Either ParseError BinTableHDU)
forall a b. (a -> b) -> a -> b
$ Eff (Parser : Error ParseError : es) BinTableHDU
-> Eff (Error ParseError : es) BinTableHDU
forall (es :: [(* -> *) -> * -> *]) a.
(Error ParseError :> es) =>
Eff (Parser : es) a -> Eff es a
runParser Eff (Parser : Error ParseError : es) BinTableHDU
forall (es :: [(* -> *) -> * -> *]).
(State ByteString :> es, Parser :> es) =>
Eff es BinTableHDU
binTable
  case (Either ParseError DataHDU
resImg, Either ParseError BinTableHDU
resTbl) of
    (Right DataHDU
i, Either ParseError BinTableHDU
_) -> Extension -> Eff es Extension
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Extension -> Eff es Extension) -> Extension -> Eff es Extension
forall a b. (a -> b) -> a -> b
$ DataHDU -> Extension
Image DataHDU
i
    (Either ParseError DataHDU
_, Right BinTableHDU
b) -> Extension -> Eff es Extension
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Extension -> Eff es Extension) -> Extension -> Eff es Extension
forall a b. (a -> b) -> a -> b
$ BinTableHDU -> Extension
BinTable BinTableHDU
b
    -- (Left (_, FormatError ie), Left (_, FormatError be)) -> throwM $ InvalidHDU [ie, be]
    (Left ParseError
_, Left (ParseFailure Path
p String
e)) -> do
      Parser (Eff es) Extension -> Eff es Extension
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (Parser (Eff es) Extension -> Eff es Extension)
-> Parser (Eff es) Extension -> Eff es Extension
forall a b. (a -> b) -> a -> b
$ (Path -> Path) -> Eff es Extension -> Parser (Eff es) Extension
forall (a :: * -> *) b. (Path -> Path) -> a b -> Parser a b
PathMod (Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path
p) (Eff es Extension -> Parser (Eff es) Extension)
-> Eff es Extension -> Parser (Eff es) Extension
forall a b. (a -> b) -> a -> b
$ String -> Eff es Extension
forall (es :: [(* -> *) -> * -> *]) a.
(Parser :> es) =>
String -> Eff es a
parseFail String
e


image :: (State ByteString :> es, Parser :> es) => Eff es DataHDU
image :: forall (es :: [(* -> *) -> * -> *]).
(State ByteString :> es, Parser :> es) =>
Eff es DataHDU
image = do
  (Dimensions
dm, Header
hd) <- String
-> Parser (Dimensions, Header) -> Eff es (Dimensions, Header)
forall (es :: [(* -> *) -> * -> *]) a.
(Parser :> es, State ByteString :> es) =>
String -> Parser a -> Eff es a
runMega String
"Image Header" (Parser (Dimensions, Header) -> Eff es (Dimensions, Header))
-> Parser (Dimensions, Header) -> Eff es (Dimensions, Header)
forall a b. (a -> b) -> a -> b
$ do
    Dimensions
dm <- ParsecT Void ByteString Identity Dimensions
-> ParsecT Void ByteString Identity 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
MP.lookAhead ParsecT Void ByteString Identity Dimensions
MH.parseImageKeywords
    Header
hd <- Parser Header
MH.parseHeader
    (Dimensions, Header) -> Parser (Dimensions, Header)
forall a. a -> ParsecT Void ByteString Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dimensions
dm, Header
hd)
  DataArray
darr <- Dimensions -> Eff es DataArray
forall (es :: [(* -> *) -> * -> *]).
(State ByteString :> es) =>
Dimensions -> Eff es DataArray
mainData Dimensions
dm
  DataHDU -> Eff es DataHDU
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DataHDU -> Eff es DataHDU) -> DataHDU -> Eff es DataHDU
forall a b. (a -> b) -> a -> b
$ Header -> DataArray -> DataHDU
DataHDU Header
hd DataArray
darr


binTable :: (State ByteString :> es, Parser :> es) => Eff es BinTableHDU
binTable :: forall (es :: [(* -> *) -> * -> *]).
(State ByteString :> es, Parser :> es) =>
Eff es BinTableHDU
binTable = do
  (Dimensions
dm, Int
pcount, Header
hd) <- do
    String
-> Parser (Dimensions, Int, Header)
-> Eff es (Dimensions, Int, Header)
forall (es :: [(* -> *) -> * -> *]) a.
(Parser :> es, State ByteString :> es) =>
String -> Parser a -> Eff es a
runMega String
"BinTable Header" (Parser (Dimensions, Int, Header)
 -> Eff es (Dimensions, Int, Header))
-> Parser (Dimensions, Int, Header)
-> Eff es (Dimensions, Int, Header)
forall a b. (a -> b) -> a -> b
$ do
      (Dimensions
dm, Int
pcount) <- 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
lookAhead ParsecT Void ByteString Identity (Dimensions, Int)
MH.parseBinTableKeywords
      Header
hd <- Parser Header
MH.parseHeader
      (Dimensions, Int, Header) -> Parser (Dimensions, Int, Header)
forall a. a -> ParsecT Void ByteString Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dimensions
dm, Int
pcount, Header
hd)

  DataArray
darr <- Dimensions -> Eff es DataArray
forall (es :: [(* -> *) -> * -> *]).
(State ByteString :> es) =>
Dimensions -> Eff es DataArray
mainData Dimensions
dm
  ByteString
rest <- Eff es ByteString
forall s (es :: [(* -> *) -> * -> *]).
(HasCallStack, State s :> es) =>
Eff es s
get
  let heap :: ByteString
heap = Int -> ByteString -> ByteString
BS.take Int
pcount ByteString
rest
  ByteString -> Eff es ()
forall s (es :: [(* -> *) -> * -> *]).
(HasCallStack, State s :> es) =>
s -> Eff es ()
put (ByteString -> Eff es ()) -> ByteString -> Eff es ()
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> ByteString -> ByteString
BS.dropWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop Int
pcount ByteString
rest
  BinTableHDU -> Eff es BinTableHDU
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BinTableHDU -> Eff es BinTableHDU)
-> BinTableHDU -> Eff es BinTableHDU
forall a b. (a -> b) -> a -> b
$ Header -> Int -> ByteString -> DataArray -> BinTableHDU
BinTableHDU Header
hd Int
pcount ByteString
heap DataArray
darr


mainData :: (State ByteString :> es) => Dimensions -> Eff es DataArray
mainData :: forall (es :: [(* -> *) -> * -> *]).
(State ByteString :> es) =>
Dimensions -> Eff es DataArray
mainData Dimensions
dm = do
  ByteString
rest <- Eff es ByteString
forall s (es :: [(* -> *) -> * -> *]).
(HasCallStack, State s :> es) =>
Eff es s
get
  let len :: Int
len = Dimensions -> Int
dataSizeBytes Dimensions
dm
  let dat :: DataArray
dat = Dimensions -> ByteString -> DataArray
dataArray Dimensions
dm (Int -> ByteString -> ByteString
BS.take Int
len ByteString
rest)
  ByteString -> Eff es ()
forall s (es :: [(* -> *) -> * -> *]).
(HasCallStack, State s :> es) =>
s -> Eff es ()
put (ByteString -> Eff es ()) -> ByteString -> Eff es ()
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> ByteString -> ByteString
BS.dropWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop Int
len ByteString
rest
  DataArray -> Eff es DataArray
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DataArray
dat


encodePrimaryHDU :: DataHDU -> ByteString
encodePrimaryHDU :: DataHDU -> ByteString
encodePrimaryHDU DataHDU
p =
  (Checksum -> BuilderBlock) -> ByteString -> ByteString
encodeHDU (Header -> DataArray -> Checksum -> BuilderBlock
renderPrimaryHeader DataHDU
p.header DataHDU
p.dataArray) DataHDU
p.dataArray.rawData


encodeImageHDU :: DataHDU -> ByteString
encodeImageHDU :: DataHDU -> ByteString
encodeImageHDU DataHDU
p =
  (Checksum -> BuilderBlock) -> ByteString -> ByteString
encodeHDU (Header -> DataArray -> Checksum -> BuilderBlock
renderImageHeader DataHDU
p.header DataHDU
p.dataArray) DataHDU
p.dataArray.rawData


encodeExtension :: Extension -> ByteString
encodeExtension :: Extension -> ByteString
encodeExtension (Image DataHDU
hdu) = DataHDU -> ByteString
encodeImageHDU DataHDU
hdu
encodeExtension (BinTable BinTableHDU
_) = String -> ByteString
forall a. HasCallStack => String -> a
error String
"BinTableHDU rendering not supported"


-- | Encode an HDU, properly handling datasum and checksum
encodeHDU :: (Checksum -> BuilderBlock) -> ByteString -> ByteString
encodeHDU :: (Checksum -> BuilderBlock) -> ByteString -> ByteString
encodeHDU Checksum -> BuilderBlock
buildHead ByteString
rawData =
  let dsum :: Checksum
dsum = ByteString -> Checksum
checksum ByteString
rawData
   in Checksum -> ByteString
encodeHeader Checksum
dsum ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
renderDataArray ByteString
rawData
 where
  encodeHeader :: Checksum -> ByteString
  encodeHeader :: Checksum -> ByteString
encodeHeader Checksum
dsum =
    let h :: ByteString
h = ByteString -> ByteString
BS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ BuilderBlock -> ByteString
runRender (Checksum -> BuilderBlock
buildHead Checksum
dsum)
        hsum :: Checksum
hsum = ByteString -> Checksum
checksum ByteString
h -- calculate the checksum of only the header
        csum :: Checksum
csum = Checksum
hsum Checksum -> Checksum -> Checksum
forall a. Semigroup a => a -> a -> a
<> Checksum
dsum -- 1s complement add to the datasum
     in Checksum -> ByteString -> ByteString
replaceChecksum Checksum
csum ByteString
h

  replaceChecksum :: Checksum -> ByteString -> ByteString
  replaceChecksum :: Checksum -> ByteString -> ByteString
replaceChecksum Checksum
csum = ByteString -> Value -> Maybe Text -> ByteString -> ByteString
replaceKeywordLine ByteString
"CHECKSUM" (Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Checksum -> Text
encodeChecksum Checksum
csum) Maybe Text
forall a. Maybe a
Nothing


-- | Fast replace a single keyword in a raw header bytestring
replaceKeywordLine :: ByteString -> Value -> Maybe Text -> ByteString -> ByteString
replaceKeywordLine :: ByteString -> Value -> Maybe Text -> ByteString -> ByteString
replaceKeywordLine ByteString
key Value
val Maybe Text
mc ByteString
header =
  let (ByteString
start, ByteString
rest) = ByteString -> ByteString -> (ByteString, ByteString)
BS.breakSubstring ByteString
key ByteString
header
      newKeyLine :: ByteString
newKeyLine = ByteString -> ByteString
BS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ BuilderBlock -> ByteString
runRender (BuilderBlock -> ByteString) -> BuilderBlock -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> Value -> Maybe Text -> BuilderBlock
renderKeywordLine (ByteString -> Text
TE.decodeUtf8 ByteString
key) Value
val Maybe Text
mc
   in ByteString
start ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
newKeyLine ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> ByteString -> ByteString
BS.drop Int
80 ByteString
rest


-- | Parse HDUs by running MegaParsec parsers one at a time, and tracking how much of the ByteString we've consumed
runMega :: (Parser :> es, State ByteString :> es) => String -> MH.Parser a -> Eff es a
runMega :: forall (es :: [(* -> *) -> * -> *]) a.
(Parser :> es, State ByteString :> es) =>
String -> Parser a -> Eff es a
runMega String
src Parser a
parse = do
  ByteString
inp <- Eff es ByteString
forall s (es :: [(* -> *) -> * -> *]).
(HasCallStack, State s :> es) =>
Eff es s
get
  case String -> ByteString -> Parser a -> Either ParseErr (a, ByteString)
forall a.
String -> ByteString -> Parser a -> Either ParseErr (a, ByteString)
MH.runNextParser String
src ByteString
inp Parser a
parse of
    Right (a
a, ByteString
rest) -> do
      ByteString -> Eff es ()
forall s (es :: [(* -> *) -> * -> *]).
(HasCallStack, State s :> es) =>
s -> Eff es ()
put ByteString
rest
      a -> Eff es a
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
    Left ParseErr
err ->
      String -> Eff es a
forall (es :: [(* -> *) -> * -> *]) a.
(Parser :> es) =>
String -> Eff es a
parseFail (String -> Eff es a) -> String -> Eff es a
forall a b. (a -> b) -> a -> b
$ ParseErr -> String
MH.showParseError ParseErr
err