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 (ByteString)
import Data.ByteString qualified as BS
import Data.Fits (Header (..), HeaderRecord (..), KeywordRecord (..), LogicalConstant (..), Value (..), getKeywords, hduBlockSize)
import Data.List qualified as L
data PrimaryHDU = PrimaryHDU
{ :: Header
, PrimaryHDU -> DataArray
dataArray :: DataArray
}
instance Show PrimaryHDU where
show :: PrimaryHDU -> String
show PrimaryHDU
p = String -> Header -> DataArray -> String
showHDU String
"PrimaryHDU" PrimaryHDU
p.header PrimaryHDU
p.dataArray
data ImageHDU = ImageHDU
{ :: Header
, ImageHDU -> DataArray
dataArray :: DataArray
}
instance Show ImageHDU where
show :: ImageHDU -> String
show ImageHDU
p = String -> Header -> DataArray -> String
showHDU String
"ImageHDU" ImageHDU
p.header ImageHDU
p.dataArray
data BinTableHDU = BinTableHDU
{ :: Header
, BinTableHDU -> Int
pCount :: Int
, BinTableHDU -> ByteString
heap :: 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
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
" 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
]
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
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]
getKeywords Header
h)
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 Extension
= Image ImageHDU
| BinTable BinTableHDU
instance Show Extension where
show :: Extension -> String
show (Image ImageHDU
i) = ImageHDU -> String
forall a. Show a => a -> String
show ImageHDU
i
show (BinTable BinTableHDU
b) = BinTableHDU -> String
forall a. Show a => a -> String
show BinTableHDU
b
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]
}
instance Show Fits where
show :: Fits -> String
show Fits
f =
PrimaryHDU -> 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 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