module Telescope.Fits.Encoding where

import Control.Exception (Exception)
import Control.Monad.Catch (MonadThrow, throwM)
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.ByteString.Builder
import Data.ByteString.Lazy qualified as BL
import Data.Char (toUpper)
import Data.Fits qualified as Fits
import Data.Fits.MegaParser (Parser)
import Data.Fits.MegaParser qualified as Fits
import Data.Fits.Read (FitsError (..))
import Data.String (IsString (..))
import Data.Text (Text, isPrefixOf, pack, unpack)
import Data.Text qualified as T
import Data.Text.Encoding qualified as TE
import Effectful
import Effectful.Error.Static
import Effectful.State.Static.Local
import Telescope.Fits.Checksum
import Telescope.Fits.Types
import Text.Megaparsec qualified as M
import Text.Megaparsec.State qualified as M


{- | Decode a FITS file read as 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 ByteString
inp = do
  let res :: Fits
res = Eff '[] Fits -> Fits
forall a. Eff '[] a -> a
runPureEff (Eff '[] Fits -> Fits) -> Eff '[] Fits -> Fits
forall a b. (a -> b) -> a -> b
$ ByteString -> Eff '[State ByteString] Fits -> Eff '[] Fits
forall s (es :: [(* -> *) -> * -> *]) a.
s -> Eff (State s : es) a -> Eff es a
evalState ByteString
inp Eff '[State ByteString] Fits
forall (es :: [(* -> *) -> * -> *]).
(State ByteString :> es) =>
Eff es Fits
parseFits
  Fits -> m Fits
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Fits
res


dataArray :: Fits.Dimensions -> ByteString -> DataArray
dataArray :: Dimensions -> ByteString -> DataArray
dataArray Dimensions
dim ByteString
dat =
  DataArray
    { $sel:bitpix:DataArray :: BitPix
bitpix = BitPixFormat -> BitPix
bitpix Dimensions
dim._bitpix
    , $sel:axes:DataArray :: Axes Column
axes = Axes -> Axes Column
axes Dimensions
dim._axes
    , $sel:rawData:DataArray :: ByteString
rawData = ByteString
dat
    }
 where
  bitpix :: Fits.BitPixFormat -> BitPix
  bitpix :: BitPixFormat -> BitPix
bitpix BitPixFormat
Fits.EightBitInt = BitPix
BPInt8
  bitpix BitPixFormat
Fits.SixteenBitInt = BitPix
BPInt16
  bitpix BitPixFormat
Fits.ThirtyTwoBitInt = BitPix
BPInt32
  bitpix BitPixFormat
Fits.SixtyFourBitInt = BitPix
BPInt64
  bitpix BitPixFormat
Fits.ThirtyTwoBitFloat = BitPix
BPFloat
  bitpix BitPixFormat
Fits.SixtyFourBitFloat = BitPix
BPDouble

  axes :: Fits.Axes -> Axes Column
  axes :: Axes -> Axes Column
axes = Axes -> Axes Column
forall {k} (a :: k). Axes -> Axes a
Axes


parseFits :: (State ByteString :> es) => Eff es Fits
parseFits :: forall (es :: [(* -> *) -> * -> *]).
(State ByteString :> es) =>
Eff es Fits
parseFits = do
  PrimaryHDU
p <- Eff es PrimaryHDU
forall (es :: [(* -> *) -> * -> *]).
(State ByteString :> es) =>
Eff es PrimaryHDU
primary
  [Extension]
es <- Eff es [Extension]
forall (es :: [(* -> *) -> * -> *]).
(State ByteString :> es) =>
Eff es [Extension]
extensions
  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
$ PrimaryHDU -> [Extension] -> Fits
Fits PrimaryHDU
p [Extension]
es
 where
  primary :: (State ByteString :> es) => Eff es PrimaryHDU
  primary :: forall (es :: [(* -> *) -> * -> *]).
(State ByteString :> es) =>
Eff es PrimaryHDU
primary = do
    (Dimensions
dm, Header
hd) <- String
-> Parser (Dimensions, Header) -> Eff es (Dimensions, Header)
forall (es :: [(* -> *) -> * -> *]) a.
(State ByteString :> es) =>
String -> Parser a -> Eff es a
nextParserThrow 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 <- Parser Dimensions
Fits.parsePrimaryKeywords
      Header
hd <- Parser Header
Fits.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
    PrimaryHDU -> Eff es PrimaryHDU
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrimaryHDU -> Eff es PrimaryHDU)
-> PrimaryHDU -> Eff es PrimaryHDU
forall a b. (a -> b) -> a -> b
$ Header -> DataArray -> PrimaryHDU
PrimaryHDU Header
hd DataArray
darr

  image :: (Error HDUError :> es, State ByteString :> es) => Eff es ImageHDU
  image :: forall (es :: [(* -> *) -> * -> *]).
(Error HDUError :> es, State ByteString :> es) =>
Eff es ImageHDU
image = do
    (Dimensions
dm, Header
hd) <- Eff es (Dimensions, Header)
forall (es :: [(* -> *) -> * -> *]).
(Error HDUError :> es, State ByteString :> es) =>
Eff es (Dimensions, Header)
imageHeader
    DataArray
darr <- Dimensions -> Eff es DataArray
forall (es :: [(* -> *) -> * -> *]).
(State ByteString :> es) =>
Dimensions -> Eff es DataArray
mainData Dimensions
dm
    ImageHDU -> Eff es ImageHDU
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ImageHDU -> Eff es ImageHDU) -> ImageHDU -> Eff es ImageHDU
forall a b. (a -> b) -> a -> b
$ Header -> DataArray -> ImageHDU
ImageHDU Header
hd DataArray
darr

  imageHeader :: (Error HDUError :> es, State ByteString :> es) => Eff es (Fits.Dimensions, Header)
  imageHeader :: forall (es :: [(* -> *) -> * -> *]).
(Error HDUError :> es, State ByteString :> es) =>
Eff es (Dimensions, Header)
imageHeader = do
    String
-> Parser (Dimensions, Header) -> Eff es (Dimensions, Header)
forall (es :: [(* -> *) -> * -> *]) a.
(Error HDUError :> es, State ByteString :> es) =>
String -> Parser a -> Eff es a
nextParser 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 <- Parser Dimensions
Fits.parseImageKeywords
      Header
hd <- Parser Header
Fits.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)

  extension :: (State ByteString :> es) => Eff es Extension
  extension :: forall (es :: [(* -> *) -> * -> *]).
(State ByteString :> es) =>
Eff es Extension
extension = do
    -- this consumes input!
    Either HDUError ImageHDU
resImg <- forall e (es :: [(* -> *) -> * -> *]) a.
Eff (Error e : es) a -> Eff es (Either e a)
runErrorNoCallStack @HDUError Eff (Error HDUError : es) ImageHDU
forall (es :: [(* -> *) -> * -> *]).
(Error HDUError :> es, State ByteString :> es) =>
Eff es ImageHDU
image
    Either HDUError BinTableHDU
resTbl <- forall e (es :: [(* -> *) -> * -> *]) a.
Eff (Error e : es) a -> Eff es (Either e a)
runErrorNoCallStack @HDUError Eff (Error HDUError : es) BinTableHDU
forall (es :: [(* -> *) -> * -> *]).
(Error HDUError :> es, State ByteString :> es) =>
Eff es BinTableHDU
binTable
    case (Either HDUError ImageHDU
resImg, Either HDUError BinTableHDU
resTbl) of
      (Right ImageHDU
i, Either HDUError 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
$ ImageHDU -> Extension
Image ImageHDU
i
      (Either HDUError ImageHDU
_, 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
      -- should report the current extenion
      (Either HDUError ImageHDU
_, Left HDUError
be) -> HDUError -> Eff es Extension
forall e a. Exception e => e -> Eff es a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM HDUError
be

  extensions :: (State ByteString :> es) => Eff es [Extension]
  extensions :: forall (es :: [(* -> *) -> * -> *]).
(State ByteString :> es) =>
Eff es [Extension]
extensions = do
    ByteString
inp <- forall s (es :: [(* -> *) -> * -> *]). (State s :> es) => Eff es s
get @ByteString
    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 <- Eff es Extension
forall (es :: [(* -> *) -> * -> *]).
(State ByteString :> es) =>
Eff es Extension
extension
        [Extension]
es <- Eff es [Extension]
forall (es :: [(* -> *) -> * -> *]).
(State ByteString :> es) =>
Eff es [Extension]
extensions
        [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)

  binTable :: (Error HDUError :> es, State ByteString :> es) => Eff es BinTableHDU
  binTable :: forall (es :: [(* -> *) -> * -> *]).
(Error HDUError :> es, State ByteString :> es) =>
Eff es BinTableHDU
binTable = do
    (Dimensions
dm, Int
pcount, Header
hd) <- Eff es (Dimensions, Int, Header)
forall (es :: [(* -> *) -> * -> *]).
(Error HDUError :> es, State ByteString :> es) =>
Eff es (Dimensions, Int, Header)
binTableHeader
    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 :: [(* -> *) -> * -> *]). (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 :: [(* -> *) -> * -> *]).
(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

  binTableHeader :: (Error HDUError :> es, State ByteString :> es) => Eff es (Fits.Dimensions, Int, Header)
  binTableHeader :: forall (es :: [(* -> *) -> * -> *]).
(Error HDUError :> es, State ByteString :> es) =>
Eff es (Dimensions, Int, Header)
binTableHeader = do
    String
-> Parser (Dimensions, Int, Header)
-> Eff es (Dimensions, Int, Header)
forall (es :: [(* -> *) -> * -> *]) a.
(Error HDUError :> es, State ByteString :> es) =>
String -> Parser a -> Eff es a
nextParser 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) <- Parser (Dimensions, Int)
Fits.parseBinTableKeywords
      Header
hd <- Parser Header
Fits.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)


mainData :: (State ByteString :> es) => Fits.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 :: [(* -> *) -> * -> *]). (State s :> es) => Eff es s
get
  let len :: Int
len = Dimensions -> Int
Fits.dataSize 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 :: [(* -> *) -> * -> *]).
(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


nextParserThrow :: (State ByteString :> es) => String -> Parser a -> Eff es a
nextParserThrow :: forall (es :: [(* -> *) -> * -> *]) a.
(State ByteString :> es) =>
String -> Parser a -> Eff es a
nextParserThrow String
src Parser a
parse = do
  Either HDUError a
res <- forall e (es :: [(* -> *) -> * -> *]) a.
Eff (Error e : es) a -> Eff es (Either e a)
runErrorNoCallStack @HDUError (String -> Parser a -> Eff (Error HDUError : es) a
forall (es :: [(* -> *) -> * -> *]) a.
(Error HDUError :> es, State ByteString :> es) =>
String -> Parser a -> Eff es a
nextParser String
src Parser a
parse)
  case Either HDUError a
res of
    Right a
a -> a -> Eff es a
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
    Left HDUError
e -> HDUError -> Eff es a
forall e a. Exception e => e -> Eff es a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM HDUError
e


nextParser :: (Error HDUError :> es, State ByteString :> es) => String -> Parser a -> Eff es a
nextParser :: forall (es :: [(* -> *) -> * -> *]) a.
(Error HDUError :> es, State ByteString :> es) =>
String -> Parser a -> Eff es a
nextParser String
src Parser a
parse = do
  ByteString
bs <- Eff es ByteString
forall s (es :: [(* -> *) -> * -> *]). (State s :> es) => Eff es s
get
  let st1 :: State ByteString Void
st1 = String -> ByteString -> State ByteString Void
forall s e. String -> s -> State s e
M.initialState String
src ByteString
bs
  case Parser a
-> State ByteString Void
-> (State ByteString Void,
    Either (ParseErrorBundle ByteString Void) 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
      ByteString -> Eff es ()
forall s (es :: [(* -> *) -> * -> *]).
(State s :> es) =>
s -> Eff es ()
put (ByteString -> Eff es ()) -> ByteString -> Eff es ()
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop State ByteString Void
st2.stateOffset ByteString
bs
      a -> Eff es a
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
    (State ByteString Void
_, Left ParseErrorBundle ByteString Void
err) -> HDUError -> Eff es a
forall e (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, Error e :> es) =>
e -> Eff es a
throwError (HDUError -> Eff es a) -> HDUError -> Eff es a
forall a b. (a -> b) -> a -> b
$ FitsError -> HDUError
FormatError (FitsError -> HDUError) -> FitsError -> HDUError
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle ByteString Void -> FitsError
ParseError ParseErrorBundle ByteString Void
err


data HDUError
  = InvalidExtension String
  | MissingPrimary
  | FormatError FitsError
  deriving (Int -> HDUError -> ShowS
[HDUError] -> ShowS
HDUError -> String
(Int -> HDUError -> ShowS)
-> (HDUError -> String) -> ([HDUError] -> ShowS) -> Show HDUError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HDUError -> ShowS
showsPrec :: Int -> HDUError -> ShowS
$cshow :: HDUError -> String
show :: HDUError -> String
$cshowList :: [HDUError] -> ShowS
showList :: [HDUError] -> ShowS
Show, Show HDUError
Typeable HDUError
Typeable HDUError
-> Show HDUError
-> (HDUError -> SomeException)
-> (SomeException -> Maybe HDUError)
-> (HDUError -> String)
-> Exception HDUError
SomeException -> Maybe HDUError
HDUError -> String
HDUError -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
$ctoException :: HDUError -> SomeException
toException :: HDUError -> SomeException
$cfromException :: SomeException -> Maybe HDUError
fromException :: SomeException -> Maybe HDUError
$cdisplayException :: HDUError -> String
displayException :: HDUError -> String
Exception)


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

> BS.writeFile $ encdoe fits
-}
encode :: Fits -> ByteString
encode :: Fits -> ByteString
encode Fits
f =
  let primary :: ByteString
primary = PrimaryHDU -> 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
primary ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
exts


-- | Execute a BuilderBlock and create a bytestring
runRender :: BuilderBlock -> BL.ByteString
runRender :: BuilderBlock -> ByteString
runRender BuilderBlock
bb = Builder -> ByteString
toLazyByteString BuilderBlock
bb.builder


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


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


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


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 BuilderBlock -> Checksum -> ByteString
encodeHeader (Checksum -> BuilderBlock
buildHead Checksum
dsum) Checksum
dsum ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
encodeDataArray ByteString
rawData


encodeHeader :: BuilderBlock -> Checksum -> ByteString
encodeHeader :: BuilderBlock -> Checksum -> ByteString
encodeHeader BuilderBlock
buildHead Checksum
dsum =
  let h :: ByteString
h = ByteString -> ByteString
BS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ BuilderBlock -> ByteString
runRender BuilderBlock
buildHead
      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


encodeDataArray :: ByteString -> ByteString
encodeDataArray :: ByteString -> ByteString
encodeDataArray ByteString
dat = 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
$ ByteString -> BuilderBlock
renderData ByteString
dat


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


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


-- renderPrimaryHDU :: PrimaryHDU -> BuilderBlock
-- renderPrimaryHDU hdu =
--   let dsum = checksum hdu.dataArray.rawData
--    in mconcat
--         [ renderPrimaryHeader hdu.header hdu.dataArray dsum
--         , renderData hdu.dataArray.rawData
--         ]

-- renderExtensionHDU :: Extension -> BuilderBlock
-- renderExtensionHDU (Image hdu) = renderImageHDU hdu
-- renderExtensionHDU (BinTable _) = error "BinTableHDU rendering not supported"

-- renderImageHDU :: ImageHDU -> BuilderBlock
-- renderImageHDU hdu =
--   let dsum = checksum hdu.dataArray.rawData
--    in mconcat
--         [ renderImageHeader hdu.header hdu.dataArray dsum
--         , renderData hdu.dataArray.rawData
--         ]

renderData :: ByteString -> BuilderBlock
renderData :: ByteString -> BuilderBlock
renderData ByteString
s = (Int -> BuilderBlock) -> BuilderBlock -> BuilderBlock
fillBlock Int -> BuilderBlock
zeros (BuilderBlock -> BuilderBlock) -> BuilderBlock -> BuilderBlock
forall a b. (a -> b) -> a -> b
$ Int -> Builder -> BuilderBlock
BuilderBlock (ByteString -> Int
BS.length ByteString
s) (Builder -> BuilderBlock) -> Builder -> BuilderBlock
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
byteString ByteString
s


renderImageHeader :: Header -> DataArray -> Checksum -> BuilderBlock
renderImageHeader :: Header -> DataArray -> Checksum -> BuilderBlock
renderImageHeader Header
h DataArray
d Checksum
dsum =
  (Int -> BuilderBlock) -> BuilderBlock -> BuilderBlock
fillBlock Int -> BuilderBlock
spaces (BuilderBlock -> BuilderBlock) -> BuilderBlock -> BuilderBlock
forall a b. (a -> b) -> a -> b
$
    [BuilderBlock] -> BuilderBlock
forall a. Monoid a => [a] -> a
mconcat
      [ Text -> Value -> Maybe Text -> BuilderBlock
renderKeywordLine Text
"XTENSION" (Text -> Value
String Text
"IMAGE") (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Image Extension")
      , BitPix -> Axes Column -> BuilderBlock
renderDataKeywords DataArray
d.bitpix DataArray
d.axes
      , Text -> Value -> Maybe Text -> BuilderBlock
renderKeywordLine Text
"PCOUNT" (Int -> Value
Integer Int
0) Maybe Text
forall a. Maybe a
Nothing
      , Text -> Value -> Maybe Text -> BuilderBlock
renderKeywordLine Text
"GCOUNT" (Int -> Value
Integer Int
1) Maybe Text
forall a. Maybe a
Nothing
      , Checksum -> BuilderBlock
renderDatasum Checksum
dsum
      , Header -> BuilderBlock
renderOtherKeywords Header
h
      , BuilderBlock
renderEnd
      ]


renderPrimaryHeader :: Header -> DataArray -> Checksum -> BuilderBlock
renderPrimaryHeader :: Header -> DataArray -> Checksum -> BuilderBlock
renderPrimaryHeader Header
h DataArray
d Checksum
dsum =
  (Int -> BuilderBlock) -> BuilderBlock -> BuilderBlock
fillBlock Int -> BuilderBlock
spaces (BuilderBlock -> BuilderBlock) -> BuilderBlock -> BuilderBlock
forall a b. (a -> b) -> a -> b
$
    [BuilderBlock] -> BuilderBlock
forall a. Monoid a => [a] -> a
mconcat
      [ Text -> Value -> Maybe Text -> BuilderBlock
renderKeywordLine Text
"SIMPLE" (LogicalConstant -> Value
Logic LogicalConstant
T) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Conforms to the FITS standard")
      , BitPix -> Axes Column -> BuilderBlock
renderDataKeywords DataArray
d.bitpix DataArray
d.axes
      , Text -> Value -> Maybe Text -> BuilderBlock
renderKeywordLine Text
"EXTEND" (LogicalConstant -> Value
Logic LogicalConstant
T) Maybe Text
forall a. Maybe a
Nothing
      , Checksum -> BuilderBlock
renderDatasum Checksum
dsum
      , Header -> BuilderBlock
renderOtherKeywords Header
h
      , BuilderBlock
renderEnd
      ]


renderDatasum :: Checksum -> BuilderBlock
renderDatasum :: Checksum -> BuilderBlock
renderDatasum Checksum
dsum =
  [BuilderBlock] -> BuilderBlock
forall a. Monoid a => [a] -> a
mconcat
    [ Text -> Value -> Maybe Text -> BuilderBlock
renderKeywordLine Text
"DATASUM" (Checksum -> Value
checksumValue Checksum
dsum) Maybe Text
forall a. Maybe a
Nothing
    , -- encode the CHECKSUM as zeros, replace later in 'runRenderHDU'
      Text -> Value -> Maybe Text -> BuilderBlock
renderKeywordLine Text
"CHECKSUM" (Text -> Value
String (Int -> Text -> Text
T.replicate Int
16 Text
"0")) Maybe Text
forall a. Maybe a
Nothing
    ]


renderEnd :: BuilderBlock
renderEnd :: BuilderBlock
renderEnd = Int -> BuilderBlock -> BuilderBlock
pad Int
80 BuilderBlock
"END"


-- | Render required keywords for a data array
renderDataKeywords :: BitPix -> Axes Column -> BuilderBlock
renderDataKeywords :: BitPix -> Axes Column -> BuilderBlock
renderDataKeywords BitPix
bp (Axes Axes
as) =
  [BuilderBlock] -> BuilderBlock
forall a. Monoid a => [a] -> a
mconcat
    [ BuilderBlock
bitpix
    , BuilderBlock
naxis_
    , BuilderBlock
naxes
    ]
 where
  bitpix :: BuilderBlock
bitpix = Text -> Value -> Maybe Text -> BuilderBlock
renderKeywordLine Text
"BITPIX" (Int -> Value
Integer (Int -> Value) -> Int -> Value
forall a b. (a -> b) -> a -> b
$ BitPix -> Int
bitPixCode BitPix
bp) (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BitPix -> Text
bitPixType BitPix
bp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") array data type")
  naxis_ :: BuilderBlock
naxis_ = Text -> Value -> Maybe Text -> BuilderBlock
renderKeywordLine Text
"NAXIS" (Int -> Value
Integer (Int -> Value) -> Int -> Value
forall a b. (a -> b) -> a -> b
$ Axes -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Axes
as) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"number of axes in data array")
  naxes :: BuilderBlock
naxes = [BuilderBlock] -> BuilderBlock
forall a. Monoid a => [a] -> a
mconcat ([BuilderBlock] -> BuilderBlock) -> [BuilderBlock] -> BuilderBlock
forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith @Int Int -> Int -> BuilderBlock
forall {a}. Show a => a -> Int -> BuilderBlock
naxisN [Int
1 ..] Axes
as
  naxisN :: a -> Int -> BuilderBlock
naxisN a
n Int
a =
    let nt :: Text
nt = String -> Text
pack (a -> String
forall a. Show a => a -> String
show a
n)
     in Text -> Value -> Maybe Text -> BuilderBlock
renderKeywordLine (Text
"NAXIS" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nt) (Int -> Value
Integer Int
a) (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
"axis " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" length")
  bitPixType :: BitPix -> Text
bitPixType = String -> Text
pack (String -> Text) -> (BitPix -> String) -> BitPix -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
2 ShowS -> (BitPix -> String) -> BitPix -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BitPix -> String
forall a. Show a => a -> String
show


-- | 'Header' contains all other keywords. Filter out any that match system keywords so they aren't rendered twice
renderOtherKeywords :: Header -> BuilderBlock
renderOtherKeywords :: Header -> BuilderBlock
renderOtherKeywords (Header [HeaderRecord]
ks) =
  [BuilderBlock] -> BuilderBlock
forall a. Monoid a => [a] -> a
mconcat ([BuilderBlock] -> BuilderBlock) -> [BuilderBlock] -> BuilderBlock
forall a b. (a -> b) -> a -> b
$ (HeaderRecord -> BuilderBlock) -> [HeaderRecord] -> [BuilderBlock]
forall a b. (a -> b) -> [a] -> [b]
map HeaderRecord -> BuilderBlock
toLine ([HeaderRecord] -> [BuilderBlock])
-> [HeaderRecord] -> [BuilderBlock]
forall a b. (a -> b) -> a -> b
$ (HeaderRecord -> Bool) -> [HeaderRecord] -> [HeaderRecord]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (HeaderRecord -> Bool) -> HeaderRecord -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderRecord -> Bool
isSystemKeyword) [HeaderRecord]
ks
 where
  toLine :: HeaderRecord -> BuilderBlock
toLine (Keyword KeywordRecord
kr) = Text -> Value -> Maybe Text -> BuilderBlock
renderKeywordLine KeywordRecord
kr._keyword KeywordRecord
kr._value KeywordRecord
kr._comment
  toLine (Comment Text
c) = Int -> BuilderBlock -> BuilderBlock
pad Int
80 (BuilderBlock -> BuilderBlock) -> BuilderBlock -> BuilderBlock
forall a b. (a -> b) -> a -> b
$ String -> BuilderBlock
string (String -> BuilderBlock) -> String -> BuilderBlock
forall a b. (a -> b) -> a -> b
$ String
"COMMENT " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack Text
c
  toLine HeaderRecord
BlankLine = Int -> BuilderBlock -> BuilderBlock
pad Int
80 BuilderBlock
""
  isSystemKeyword :: HeaderRecord -> Bool
isSystemKeyword (Keyword KeywordRecord
kr) =
    let k :: Text
k = KeywordRecord
kr._keyword
     in Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"BITPIX"
          Bool -> Bool -> Bool
|| Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"EXTEND"
          Bool -> Bool -> Bool
|| Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"DATASUM"
          Bool -> Bool -> Bool
|| Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"CHECKSUM"
          Bool -> Bool -> Bool
|| Text
"NAXIS" Text -> Text -> Bool
`isPrefixOf` Text
k
  isSystemKeyword HeaderRecord
_ = Bool
False


-- | Fill out the header or data block to the nearest 2880 bytes
fillBlock :: (Int -> BuilderBlock) -> BuilderBlock -> BuilderBlock
fillBlock :: (Int -> BuilderBlock) -> BuilderBlock -> BuilderBlock
fillBlock Int -> BuilderBlock
fill BuilderBlock
b =
  let rm :: Int
rm = Int
hduBlockSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- BuilderBlock
b.length Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
hduBlockSize
   in BuilderBlock
b BuilderBlock -> BuilderBlock -> BuilderBlock
forall a. Semigroup a => a -> a -> a
<> Int -> BuilderBlock
extraSpaces Int
rm
 where
  extraSpaces :: Int -> BuilderBlock
extraSpaces Int
n
    | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
hduBlockSize = BuilderBlock
forall a. Monoid a => a
mempty
    | Bool
otherwise = Int -> BuilderBlock
fill Int
n


bitPixCode :: BitPix -> Int
bitPixCode :: BitPix -> Int
bitPixCode BitPix
BPInt8 = Int
8
bitPixCode BitPix
BPInt16 = Int
16
bitPixCode BitPix
BPInt32 = Int
32
bitPixCode BitPix
BPInt64 = Int
64
bitPixCode BitPix
BPFloat = -Int
32
bitPixCode BitPix
BPDouble = -Int
64


-- Keyword Lines -----------------------------------------------------

renderKeywordLine :: Text -> Value -> Maybe Text -> BuilderBlock
renderKeywordLine :: Text -> Value -> Maybe Text -> BuilderBlock
renderKeywordLine Text
k Value
v Maybe Text
mc =
  let kv :: BuilderBlock
kv = Text -> Value -> BuilderBlock
renderKeywordValue Text
k Value
v
   in Int -> BuilderBlock -> BuilderBlock
pad Int
80 (BuilderBlock -> BuilderBlock) -> BuilderBlock -> BuilderBlock
forall a b. (a -> b) -> a -> b
$ BuilderBlock -> Maybe Text -> BuilderBlock
addComment BuilderBlock
kv Maybe Text
mc
 where
  addComment :: BuilderBlock -> Maybe Text -> BuilderBlock
addComment BuilderBlock
kv Maybe Text
Nothing = BuilderBlock
kv
  addComment BuilderBlock
kv (Just Text
c) =
    let mx :: Int
mx = Int
80 Int -> Int -> Int
forall a. Num a => a -> a -> a
- BuilderBlock
kv.length
     in BuilderBlock
kv BuilderBlock -> BuilderBlock -> BuilderBlock
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> BuilderBlock
renderComment Int
mx Text
c


renderKeywordValue :: Text -> Value -> BuilderBlock
renderKeywordValue :: Text -> Value -> BuilderBlock
renderKeywordValue Text
k Value
v =
  [BuilderBlock] -> BuilderBlock
forall a. Monoid a => [a] -> a
mconcat
    [ Text -> BuilderBlock
renderKeyword Text
k
    , String -> BuilderBlock
string String
"= "
    , Int -> BuilderBlock -> BuilderBlock
pad Int
20 (BuilderBlock -> BuilderBlock) -> BuilderBlock -> BuilderBlock
forall a b. (a -> b) -> a -> b
$ Value -> BuilderBlock
renderValue Value
v
    ]


renderKeyword :: Text -> BuilderBlock
renderKeyword :: Text -> BuilderBlock
renderKeyword Text
k = Int -> BuilderBlock -> BuilderBlock
pad Int
8 (BuilderBlock -> BuilderBlock) -> BuilderBlock -> BuilderBlock
forall a b. (a -> b) -> a -> b
$ String -> BuilderBlock
string (String -> BuilderBlock) -> String -> BuilderBlock
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
8 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
k


renderComment :: Int -> Text -> BuilderBlock
renderComment :: Int -> Text -> BuilderBlock
renderComment Int
mx Text
c = String -> BuilderBlock
string (String -> BuilderBlock) -> String -> BuilderBlock
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
mx ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
" / " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack Text
c


renderValue :: Value -> BuilderBlock
renderValue :: Value -> BuilderBlock
renderValue (Logic LogicalConstant
T) = Int -> BuilderBlock -> BuilderBlock
justify Int
20 BuilderBlock
"T"
renderValue (Logic LogicalConstant
F) = Int -> BuilderBlock -> BuilderBlock
justify Int
20 BuilderBlock
"F"
renderValue (Float Float
f) = Int -> BuilderBlock -> BuilderBlock
justify Int
20 (BuilderBlock -> BuilderBlock) -> BuilderBlock -> BuilderBlock
forall a b. (a -> b) -> a -> b
$ String -> BuilderBlock
string (String -> BuilderBlock) -> String -> BuilderBlock
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Float -> String
forall a. Show a => a -> String
show Float
f
renderValue (Integer Int
n) = Int -> BuilderBlock -> BuilderBlock
justify Int
20 (BuilderBlock -> BuilderBlock) -> BuilderBlock -> BuilderBlock
forall a b. (a -> b) -> a -> b
$ String -> BuilderBlock
string (String -> BuilderBlock) -> String -> BuilderBlock
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
n
renderValue (String Text
s) = String -> BuilderBlock
string (String -> BuilderBlock) -> String -> BuilderBlock
forall a b. (a -> b) -> a -> b
$ String
"'" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack Text
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"'"


-- Builder Block ---------------------------------------------------------

-- | We need a builder that keeps track of its length so we can pad things
data BuilderBlock = BuilderBlock {BuilderBlock -> Int
length :: Int, BuilderBlock -> Builder
builder :: Builder}


-- | Smart constructor, don't allow negative lengths
builderBlock :: Int -> Builder -> BuilderBlock
builderBlock :: Int -> Builder -> BuilderBlock
builderBlock Int
n = Int -> Builder -> BuilderBlock
BuilderBlock (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
n Int
0)


instance IsString BuilderBlock where
  fromString :: String -> BuilderBlock
fromString = String -> BuilderBlock
string


instance Semigroup BuilderBlock where
  BuilderBlock Int
l Builder
b <> :: BuilderBlock -> BuilderBlock -> BuilderBlock
<> BuilderBlock Int
l2 Builder
b2 = Int -> Builder -> BuilderBlock
BuilderBlock (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l2) (Builder
b Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
b2)


instance Monoid BuilderBlock where
  mempty :: BuilderBlock
mempty = Int -> Builder -> BuilderBlock
BuilderBlock Int
0 Builder
forall a. Monoid a => a
mempty


justify :: Int -> BuilderBlock -> BuilderBlock
justify :: Int -> BuilderBlock -> BuilderBlock
justify Int
n BuilderBlock
b = Int -> BuilderBlock
spaces (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- BuilderBlock
b.length) BuilderBlock -> BuilderBlock -> BuilderBlock
forall a. Semigroup a => a -> a -> a
<> BuilderBlock
b


pad :: Int -> BuilderBlock -> BuilderBlock
pad :: Int -> BuilderBlock -> BuilderBlock
pad Int
n BuilderBlock
b = BuilderBlock
b BuilderBlock -> BuilderBlock -> BuilderBlock
forall a. Semigroup a => a -> a -> a
<> Int -> BuilderBlock
spaces (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- BuilderBlock
b.length)


spaces :: Int -> BuilderBlock
spaces :: Int -> BuilderBlock
spaces = Builder -> Int -> BuilderBlock
padding (Char -> Builder
charUtf8 Char
' ')


zeros :: Int -> BuilderBlock
zeros :: Int -> BuilderBlock
zeros = Builder -> Int -> BuilderBlock
padding (Word8 -> Builder
word8 Word8
0)


padding :: Builder -> Int -> BuilderBlock
padding :: Builder -> Int -> BuilderBlock
padding Builder
b Int
n = Int -> Builder -> BuilderBlock
builderBlock Int
n (Builder -> BuilderBlock)
-> (Builder -> Builder) -> Builder -> BuilderBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> (Builder -> [Builder]) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Builder -> [Builder]
forall a. Int -> a -> [a]
replicate Int
n (Builder -> BuilderBlock) -> Builder -> BuilderBlock
forall a b. (a -> b) -> a -> b
$ Builder
b


string :: String -> BuilderBlock
string :: String -> BuilderBlock
string String
s = Int -> Builder -> BuilderBlock
builderBlock (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) (String -> Builder
stringUtf8 String
s)