module Telescope.Fits.HDU where

import Data.ByteString qualified as BS
import Data.List qualified as L
import Telescope.Data.Axes
import Telescope.Fits.BitPix
import Telescope.Fits.DataArray
import Telescope.Fits.Header.Header


data Fits = Fits
  { Fits -> DataHDU
primaryHDU :: DataHDU
  , Fits -> [Extension]
extensions :: [Extension]
  }


instance Show Fits where
  show :: Fits -> String
show Fits
f =
    DataHDU -> String
forall a. Show a => a -> String
show Fits
f.primaryHDU
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n"
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate String
"\n" ((Extension -> String) -> [Extension] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Extension -> String
forall a. Show a => a -> String
show Fits
f.extensions)


data DataHDU = DataHDU
  { DataHDU -> Header
header :: Header
  , DataHDU -> DataArray
dataArray :: DataArray
  }


instance Show DataHDU where
  show :: DataHDU -> String
show DataHDU
p = String -> Header -> DataArray -> String
showHDU String
"DataHDU" DataHDU
p.header DataHDU
p.dataArray


data BinTableHDU = BinTableHDU
  { BinTableHDU -> Header
header :: Header
  , BinTableHDU -> Int
pCount :: Int
  , BinTableHDU -> ByteString
heap :: BS.ByteString
  , BinTableHDU -> DataArray
dataArray :: DataArray
  }


instance Show BinTableHDU where
  show :: BinTableHDU -> String
show BinTableHDU
p = String -> Header -> DataArray -> String
showHDU String
"BinTableHDU" BinTableHDU
p.header BinTableHDU
p.dataArray


showHDU :: String -> Header -> DataArray -> String
showHDU :: String -> Header -> DataArray -> String
showHDU String
name Header
h DataArray
d =
  String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate
    String
"\n"
    [ String
name
    , Header -> String
showHeader Header
h
    , DataArray -> String
forall a. Show a => a -> String
show DataArray
d
    ]


showHeader :: Header -> String
showHeader :: Header -> String
showHeader Header
h =
  String
"  Header: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show ([KeywordRecord] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([KeywordRecord] -> Int) -> [KeywordRecord] -> Int
forall a b. (a -> b) -> a -> b
$ Header -> [KeywordRecord]
keywords Header
h) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" records"


emptyDataArray :: DataArray
emptyDataArray :: DataArray
emptyDataArray = BitPix -> Axes 'Column -> ByteString -> DataArray
DataArray BitPix
BPInt8 ([Int] -> Axes 'Column
forall (a :: Major). [Int] -> Axes a
Axes []) ByteString
""


data Extension
  = Image DataHDU
  | BinTable BinTableHDU


instance Show Extension where
  show :: Extension -> String
show (Image DataHDU
i) = String
"\nImage: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> DataHDU -> String
forall a. Show a => a -> String
show DataHDU
i
  show (BinTable BinTableHDU
b) = String
"\nBinTable: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> BinTableHDU -> String
forall a. Show a => a -> String
show BinTableHDU
b