module Telescope.Fits.Types
  ( Fits (..)
  , PrimaryHDU (..)
  , ImageHDU (..)
  , BinTableHDU (..)
  , DataArray (..)
  , Extension (..)
  , Axis
  , Axes (..)
  , Row
  , Column
  , rowMajor
  , columnMajor
  , BitPix (..)
  , bitPixBits
  , Header (..)
  , getKeywords
  , HeaderRecord (..)
  , KeywordRecord (..)
  , Value (..)
  , LogicalConstant (..)
  , hduBlockSize
  , emptyDataArray
  ) where

import Data.ByteString as BS
import Data.Fits (Header (..), HeaderRecord (..), KeywordRecord (..), LogicalConstant (..), Value (..), getKeywords, hduBlockSize)
import Data.List qualified as L


-- we know the first one is an image
data PrimaryHDU = PrimaryHDU
  { PrimaryHDU -> Header
header :: Header
  , PrimaryHDU -> DataArray
dataArray :: DataArray
  }


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


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


data DataArray = DataArray
  { DataArray -> BitPix
bitpix :: BitPix
  , DataArray -> Axes Column
axes :: Axes Column
  , DataArray -> ByteString
rawData :: BS.ByteString
  }


instance Show DataArray where
  show :: DataArray -> String
show DataArray
d =
    String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate
      String
"\n"
      [ String
"DataArray:"
      , String
"  data: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (ByteString -> Int
BS.length DataArray
d.rawData) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" bytes"
      , String
"  dimensions: "
      , String
"    format: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> ShowS
forall a. Int -> [a] -> [a]
L.drop Int
2 (BitPix -> String
forall a. Show a => a -> String
show DataArray
d.bitpix)
      , String
"    axes: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Int] -> String
forall a. Show a => a -> String
show DataArray
d.axes.axes
      ]


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


-- data BinaryTable = BinaryTable
--   { pCount :: Int
--   , heap :: ByteString
--   }

data Extension
  = Image ImageHDU
  | BinTable BinTableHDU


type Axis = Int
newtype Axes a = Axes {forall {k} (a :: k). Axes a -> [Int]
axes :: [Axis]}
  deriving (Int -> Axes a -> ShowS
[Axes a] -> ShowS
Axes a -> String
(Int -> Axes a -> ShowS)
-> (Axes a -> String) -> ([Axes a] -> ShowS) -> Show (Axes a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (a :: k). Int -> Axes a -> ShowS
forall k (a :: k). [Axes a] -> ShowS
forall k (a :: k). Axes a -> String
$cshowsPrec :: forall k (a :: k). Int -> Axes a -> ShowS
showsPrec :: Int -> Axes a -> ShowS
$cshow :: forall k (a :: k). Axes a -> String
show :: Axes a -> String
$cshowList :: forall k (a :: k). [Axes a] -> ShowS
showList :: [Axes a] -> ShowS
Show, Axes a -> Axes a -> Bool
(Axes a -> Axes a -> Bool)
-> (Axes a -> Axes a -> Bool) -> Eq (Axes a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (a :: k). Axes a -> Axes a -> Bool
$c== :: forall k (a :: k). Axes a -> Axes a -> Bool
== :: Axes a -> Axes a -> Bool
$c/= :: forall k (a :: k). Axes a -> Axes a -> Bool
/= :: Axes a -> Axes a -> Bool
Eq)
data Row
data Column


rowMajor :: Axes Column -> Axes Row
rowMajor :: Axes Column -> Axes Row
rowMajor (Axes [Int]
as) = [Int] -> Axes Row
forall {k} (a :: k). [Int] -> Axes a
Axes ([Int] -> [Int]
forall a. [a] -> [a]
L.reverse [Int]
as)


columnMajor :: Axes Row -> Axes Column
columnMajor :: Axes Row -> Axes Column
columnMajor (Axes [Int]
as) = [Int] -> Axes Column
forall {k} (a :: k). [Int] -> Axes a
Axes ([Int] -> [Int]
forall a. [a] -> [a]
L.reverse [Int]
as)


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


data BitPix
  = BPInt8
  | BPInt16
  | BPInt32
  | BPInt64
  | BPFloat
  | BPDouble
  deriving (Int -> BitPix -> ShowS
[BitPix] -> ShowS
BitPix -> String
(Int -> BitPix -> ShowS)
-> (BitPix -> String) -> ([BitPix] -> ShowS) -> Show BitPix
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BitPix -> ShowS
showsPrec :: Int -> BitPix -> ShowS
$cshow :: BitPix -> String
show :: BitPix -> String
$cshowList :: [BitPix] -> ShowS
showList :: [BitPix] -> ShowS
Show, BitPix -> BitPix -> Bool
(BitPix -> BitPix -> Bool)
-> (BitPix -> BitPix -> Bool) -> Eq BitPix
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BitPix -> BitPix -> Bool
== :: BitPix -> BitPix -> Bool
$c/= :: BitPix -> BitPix -> Bool
/= :: BitPix -> BitPix -> Bool
Eq)


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