{-|
Module      : Data.Fits
Description : Types for FITS Data Units
Copyright   : (c) Zac Slade, 2023
License     : BSD2
Maintainer  : krakrjak@gmail.com
Stability   : experimental

Definitions for the data types needed to parse an HDU in a FITS block.
-}

{-# LANGUAGE
    GeneralizedNewtypeDeriving
  , OverloadedStrings
  , TemplateHaskell
#-}
module Data.Fits
    ( -- * Data payload functions
      parsePix
    , pixsUnwrapI
    , pixsUnwrapD

      -- * Main data types
    , HeaderDataUnit(..)
      -- ^ lens exports
    , dimensions
    , header
    , extension
    , mainData
    , Pix(..)

      -- ** Header Data Types
    , Header(..)
    , keywords -- ^ lens for Keyword Map in Header
    , Extension(..)
    , Data.Fits.lookup
    , Keyword(..)
    , Value(..)
    , toInt, toFloat, toText
    , LogicalConstant(..)
    , Dimensions(..)
    , axes
    , bitpix
    , Comment(..)
    , SimpleFormat(..)
    , BitPixFormat(..)
    , Axes

      -- * Utility
    , isBitPixInt
    , isBitPixFloat
    , bitPixToWordSize
    , bitPixToByteSize
    , pixDimsByCol
    , pixDimsByRow

      -- ** Constants
    , hduRecordLength
    , hduMaxRecords
    , hduBlockSize

    ) where

---- text
import qualified Data.Text as T
---- bytestring
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL
import qualified Data.Map as Map

import Data.String (IsString)

---- ghc
import GHC.TypeNats (KnownNat, Nat)

---- text
import Data.Text ( Text )
import Data.Map ( Map )
import Data.List ( intercalate )

---- bytestring
import Data.ByteString ( ByteString )

---- microlens
import Lens.Micro ((^.))
---- microlens-th
import Lens.Micro.TH ( makeLenses )


import Data.Binary
import Data.Binary.Get

-- | A single record in the HDU is an eighty byte word.
{-@ type HDURecordLength = {v:Int | v = 80} @-}
{-@ hduRecordLength :: HDURecordLength @-}
hduRecordLength :: Int
hduRecordLength :: Int
hduRecordLength = Int
80

{-| The maximum amount of eighty byte records is thirty-six per the
    standard.
-}
{-@ type HDUMaxRecords = {v:Int | v = 36} @-}
{-@ hduMaxRecords :: HDUMaxRecords @-}
hduMaxRecords :: Int
hduMaxRecords :: Int
hduMaxRecords = Int
36

{-| The size of an HDU block is fixed at thirty-six eighty byte words. In
    other words 2,880 bytes. These blocks are padded with zeros to this
    boundary.
-}
{-@ type HDUBlockSize = {v:Int | v = 2880} @-}
{-@ hduBlockSize :: HDUBlockSize @-}
hduBlockSize :: Int
hduBlockSize :: Int
hduBlockSize = Int
hduRecordLength Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
hduMaxRecords
 

{-| The standard defines two possible values for the SIMPLE keyword, T and
    F. The T refers to a 'Conformant' format while F refers to
    a 'NonConformant' format. At this time only the 'Conformant', T, format
    is supported.
-}
data SimpleFormat = Conformant | NonConformant
    deriving (SimpleFormat -> SimpleFormat -> Bool
(SimpleFormat -> SimpleFormat -> Bool)
-> (SimpleFormat -> SimpleFormat -> Bool) -> Eq SimpleFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SimpleFormat -> SimpleFormat -> Bool
== :: SimpleFormat -> SimpleFormat -> Bool
$c/= :: SimpleFormat -> SimpleFormat -> Bool
/= :: SimpleFormat -> SimpleFormat -> Bool
Eq, Int -> SimpleFormat -> ShowS
[SimpleFormat] -> ShowS
SimpleFormat -> String
(Int -> SimpleFormat -> ShowS)
-> (SimpleFormat -> String)
-> ([SimpleFormat] -> ShowS)
-> Show SimpleFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SimpleFormat -> ShowS
showsPrec :: Int -> SimpleFormat -> ShowS
$cshow :: SimpleFormat -> String
show :: SimpleFormat -> String
$cshowList :: [SimpleFormat] -> ShowS
showList :: [SimpleFormat] -> ShowS
Show)
                    -- ^ Value of SIMPLE=T in the header. /supported/
                    -- NonConformat
                    -- ^ Value of SIMPLE=F in the header. /unsupported/

{-| Direct encoding of a `Bool` for parsing `Value` -}
data LogicalConstant = T | F
    deriving (Int -> LogicalConstant -> ShowS
[LogicalConstant] -> ShowS
LogicalConstant -> String
(Int -> LogicalConstant -> ShowS)
-> (LogicalConstant -> String)
-> ([LogicalConstant] -> ShowS)
-> Show LogicalConstant
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LogicalConstant -> ShowS
showsPrec :: Int -> LogicalConstant -> ShowS
$cshow :: LogicalConstant -> String
show :: LogicalConstant -> String
$cshowList :: [LogicalConstant] -> ShowS
showList :: [LogicalConstant] -> ShowS
Show, LogicalConstant -> LogicalConstant -> Bool
(LogicalConstant -> LogicalConstant -> Bool)
-> (LogicalConstant -> LogicalConstant -> Bool)
-> Eq LogicalConstant
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LogicalConstant -> LogicalConstant -> Bool
== :: LogicalConstant -> LogicalConstant -> Bool
$c/= :: LogicalConstant -> LogicalConstant -> Bool
/= :: LogicalConstant -> LogicalConstant -> Bool
Eq)

{-| The `Text` wrapper for HDU the keyword data for lines of the form:
    KEYWORD=VALUE
-}
newtype Keyword = Keyword Text
    deriving (Int -> Keyword -> ShowS
[Keyword] -> ShowS
Keyword -> String
(Int -> Keyword -> ShowS)
-> (Keyword -> String) -> ([Keyword] -> ShowS) -> Show Keyword
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Keyword -> ShowS
showsPrec :: Int -> Keyword -> ShowS
$cshow :: Keyword -> String
show :: Keyword -> String
$cshowList :: [Keyword] -> ShowS
showList :: [Keyword] -> ShowS
Show, Keyword -> Keyword -> Bool
(Keyword -> Keyword -> Bool)
-> (Keyword -> Keyword -> Bool) -> Eq Keyword
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Keyword -> Keyword -> Bool
== :: Keyword -> Keyword -> Bool
$c/= :: Keyword -> Keyword -> Bool
/= :: Keyword -> Keyword -> Bool
Eq, Eq Keyword
Eq Keyword
-> (Keyword -> Keyword -> Ordering)
-> (Keyword -> Keyword -> Bool)
-> (Keyword -> Keyword -> Bool)
-> (Keyword -> Keyword -> Bool)
-> (Keyword -> Keyword -> Bool)
-> (Keyword -> Keyword -> Keyword)
-> (Keyword -> Keyword -> Keyword)
-> Ord Keyword
Keyword -> Keyword -> Bool
Keyword -> Keyword -> Ordering
Keyword -> Keyword -> Keyword
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Keyword -> Keyword -> Ordering
compare :: Keyword -> Keyword -> Ordering
$c< :: Keyword -> Keyword -> Bool
< :: Keyword -> Keyword -> Bool
$c<= :: Keyword -> Keyword -> Bool
<= :: Keyword -> Keyword -> Bool
$c> :: Keyword -> Keyword -> Bool
> :: Keyword -> Keyword -> Bool
$c>= :: Keyword -> Keyword -> Bool
>= :: Keyword -> Keyword -> Bool
$cmax :: Keyword -> Keyword -> Keyword
max :: Keyword -> Keyword -> Keyword
$cmin :: Keyword -> Keyword -> Keyword
min :: Keyword -> Keyword -> Keyword
Ord, String -> Keyword
(String -> Keyword) -> IsString Keyword
forall a. (String -> a) -> IsString a
$cfromString :: String -> Keyword
fromString :: String -> Keyword
IsString)

{-| `Value` datatype for discriminating valid FITS KEYWORD=VALUE types in an HDU. -}
data Value
    = Integer Int
    | Float Float
    | String Text
    | Logic LogicalConstant
    deriving (Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
(Int -> Value -> ShowS)
-> (Value -> String) -> ([Value] -> ShowS) -> Show Value
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Value -> ShowS
showsPrec :: Int -> Value -> ShowS
$cshow :: Value -> String
show :: Value -> String
$cshowList :: [Value] -> ShowS
showList :: [Value] -> ShowS
Show, Value -> Value -> Bool
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
/= :: Value -> Value -> Bool
Eq)


{-| 'Axes' represents the combination of NAXIS + NAXISn. The spec supports up to 999 axes -}
type Axes = [Int]

{-| The 'BitPixFormat' is the nitty gritty of how the 'Axis' data is layed
    out in the file. The standard recognizes six formats: unsigned 8 bit
    integer, two's complement binary integers at 16, 32, and 64 bits along
    with 32 and 64 bit IEEE floating point formats.
-}
data BitPixFormat =
      EightBitInt       -- ^ BITPIX = 8; unsigned binary integer of 8 bits
    | SixteenBitInt     -- ^ BITPIX = 16; two's complement binary integer of 16 bits
    | ThirtyTwoBitInt   -- ^ BITPIX = 32; two's complement binary integer of 32 bits
    | SixtyFourBitInt   -- ^ BITPIX = 64; two's complement binary integer of 64 bits
    | ThirtyTwoBitFloat -- ^ BITPIX = -32; IEEE single precision floating point of 32 bits
    | SixtyFourBitFloat -- ^ BITPIX = -64; IEEE double precision floating point of 64 bits
    deriving (BitPixFormat -> BitPixFormat -> Bool
(BitPixFormat -> BitPixFormat -> Bool)
-> (BitPixFormat -> BitPixFormat -> Bool) -> Eq BitPixFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BitPixFormat -> BitPixFormat -> Bool
== :: BitPixFormat -> BitPixFormat -> Bool
$c/= :: BitPixFormat -> BitPixFormat -> Bool
/= :: BitPixFormat -> BitPixFormat -> Bool
Eq)

instance Show BitPixFormat where
    show :: BitPixFormat -> String
show BitPixFormat
EightBitInt       = String
"8 bit unsigned integer"
    show BitPixFormat
SixteenBitInt     = String
"16 bit signed integer"
    show BitPixFormat
ThirtyTwoBitInt   = String
"32 bit signed integer"
    show BitPixFormat
SixtyFourBitInt   = String
"64 bit signed interger"
    show BitPixFormat
ThirtyTwoBitFloat = String
"32 bit IEEE single precision float"
    show BitPixFormat
SixtyFourBitFloat = String
"64 bit IEEE double precision float"

{-| This utility function can be used to get the word count for data in an
    HDU.
-}
bitPixToWordSize :: BitPixFormat -> Int
bitPixToWordSize :: BitPixFormat -> Int
bitPixToWordSize BitPixFormat
EightBitInt       = Int
8
bitPixToWordSize BitPixFormat
SixteenBitInt     = Int
16
bitPixToWordSize BitPixFormat
ThirtyTwoBitInt   = Int
32
bitPixToWordSize BitPixFormat
ThirtyTwoBitFloat = Int
32
bitPixToWordSize BitPixFormat
SixtyFourBitInt   = Int
64
bitPixToWordSize BitPixFormat
SixtyFourBitFloat = Int
64

{-| This utility function can be used to get the size in bytes of the
-   format.
-}
bitPixToByteSize :: BitPixFormat -> Int
bitPixToByteSize :: BitPixFormat -> Int
bitPixToByteSize BitPixFormat
EightBitInt       = Int
1
bitPixToByteSize BitPixFormat
SixteenBitInt     = Int
2
bitPixToByteSize BitPixFormat
ThirtyTwoBitInt   = Int
4
bitPixToByteSize BitPixFormat
ThirtyTwoBitFloat = Int
4
bitPixToByteSize BitPixFormat
SixtyFourBitInt   = Int
8
bitPixToByteSize BitPixFormat
SixtyFourBitFloat = Int
8

{- | This utility functions quickly lets you know if you are dealing with
     integer data.
-}
isBitPixInt :: BitPixFormat -> Bool
isBitPixInt :: BitPixFormat -> Bool
isBitPixInt BitPixFormat
EightBitInt     = Bool
True
isBitPixInt BitPixFormat
SixteenBitInt   = Bool
True
isBitPixInt BitPixFormat
ThirtyTwoBitInt = Bool
True
isBitPixInt BitPixFormat
SixtyFourBitInt = Bool
True
isBitPixInt BitPixFormat
_ = Bool
False

{- | This utility functions quickly lets you know if you are dealing with
     floating point data.
-}
isBitPixFloat :: BitPixFormat -> Bool
isBitPixFloat :: BitPixFormat -> Bool
isBitPixFloat BitPixFormat
ThirtyTwoBitFloat = Bool
True
isBitPixFloat BitPixFormat
SixtyFourBitFloat = Bool
True
isBitPixFloat BitPixFormat
_ = Bool
False

{- | Following `BitPixFormat` we have a tag for integer and floating point
     values. We box them up to ease parsing.
-}
data Pix = PB Int | PI16 Int | PI32 Int | PI64 Int | PF Double | PD Double

{- | Removes the `Pix` tag from an `Int` type within. -}
unPixI :: Pix -> Int
unPixI :: Pix -> Int
unPixI (PB Int
b)   = Int
b
unPixI (PI16 Int
i) = Int
i
unPixI (PI32 Int
i) = Int
i
unPixI (PI64 Int
i) = Int
i
unPixI Pix
_        = String -> Int
forall a. HasCallStack => String -> a
error String
"Pix are not stored as integers, invalid unpacking"

{- | Removes the `Pix` tag from a `Double` type within. -}
unPixD :: Pix -> Double
unPixD :: Pix -> Double
unPixD (PF Double
d)   = Double
d
unPixD (PD Double
d)   = Double
d
unPixD Pix
_        = String -> Double
forall a. HasCallStack => String -> a
error String
"Pix are not stored as floating point values, invalid unpacking"

{- | Remove the Pix wrapper for integer `Pix` lists.  -}
pixsUnwrapI :: BitPixFormat -> [Pix] -> [Int]
pixsUnwrapI :: BitPixFormat -> [Pix] -> [Int]
pixsUnwrapI BitPixFormat
EightBitInt       [Pix]
pxs = (Pix -> Int) -> [Pix] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Pix -> Int
unPixI [Pix]
pxs
pixsUnwrapI BitPixFormat
SixteenBitInt     [Pix]
pxs = (Pix -> Int) -> [Pix] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Pix -> Int
unPixI [Pix]
pxs
pixsUnwrapI BitPixFormat
ThirtyTwoBitInt   [Pix]
pxs = (Pix -> Int) -> [Pix] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Pix -> Int
unPixI [Pix]
pxs
pixsUnwrapI BitPixFormat
SixtyFourBitInt   [Pix]
pxs = (Pix -> Int) -> [Pix] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Pix -> Int
unPixI [Pix]
pxs
pixsUnwrapI BitPixFormat
_ [Pix]
_ = String -> [Int]
forall a. HasCallStack => String -> a
error String
"BitPixFormat is not an integer type"

{- | Remove the `Pix` wrapper for floating point `Pix` lists.  -}
pixsUnwrapD :: BitPixFormat -> [Pix] -> [Double]
pixsUnwrapD :: BitPixFormat -> [Pix] -> [Double]
pixsUnwrapD BitPixFormat
ThirtyTwoBitFloat [Pix]
pxs = (Pix -> Double) -> [Pix] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Pix -> Double
unPixD [Pix]
pxs
pixsUnwrapD BitPixFormat
SixtyFourBitFloat [Pix]
pxs = (Pix -> Double) -> [Pix] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Pix -> Double
unPixD [Pix]
pxs
pixsUnwrapD BitPixFormat
_ [Pix]
_ = String -> [Double]
forall a. HasCallStack => String -> a
error String
"BitPixFormat is not a floating point type"

getPix :: BitPixFormat -> Get Pix
getPix :: BitPixFormat -> Get Pix
getPix BitPixFormat
EightBitInt       = Int -> Pix
PB (Int -> Pix) -> (Int8 -> Int) -> Int8 -> Pix
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int8 -> Pix) -> Get Int8 -> Get Pix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int8
getInt8
getPix BitPixFormat
SixteenBitInt     = Int -> Pix
PI16 (Int -> Pix) -> (Int16 -> Int) -> Int16 -> Pix
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int16 -> Pix) -> Get Int16 -> Get Pix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
getInt16be
getPix BitPixFormat
ThirtyTwoBitInt   = Int -> Pix
PI32 (Int -> Pix) -> (Int32 -> Int) -> Int32 -> Pix
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Pix) -> Get Int32 -> Get Pix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int32
getInt32be
getPix BitPixFormat
SixtyFourBitInt   = Int -> Pix
PI64 (Int -> Pix) -> (Int64 -> Int) -> Int64 -> Pix
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Pix) -> Get Int64 -> Get Pix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int64
getInt64be
getPix BitPixFormat
ThirtyTwoBitFloat = Double -> Pix
PF (Double -> Pix) -> (Float -> Double) -> Float -> Pix
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Float -> Pix) -> Get Float -> Get Pix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Float
getFloatbe
getPix BitPixFormat
SixtyFourBitFloat = Double -> Pix
PD (Double -> Pix) -> (Double -> Double) -> Double -> Pix
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> Pix) -> Get Double -> Get Pix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Double
getDoublebe

getPixs :: Int -> BitPixFormat -> Get [Pix]
getPixs :: Int -> BitPixFormat -> Get [Pix]
getPixs Int
c BitPixFormat
bpf = do
    Bool
empty <- Get Bool
isEmpty
    if Bool
empty
      then [Pix] -> Get [Pix]
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return []
      else do
        Pix
p <- BitPixFormat -> Get Pix
getPix BitPixFormat
bpf
        [Pix]
ps <- Int -> BitPixFormat -> Get [Pix]
getPixs (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) BitPixFormat
bpf
        [Pix] -> Get [Pix]
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pix
pPix -> [Pix] -> [Pix]
forall a. a -> [a] -> [a]
:[Pix]
ps)

{- | This is the main low-level function which parses the data portion of an
     HDU. You need and element count, a format and a bytestring. The resulting
     list is produced in column-row major order as specified in the standard.
-}
parsePix :: Int -> BitPixFormat -> BL.ByteString -> IO [Pix]
parsePix :: Int -> BitPixFormat -> ByteString -> IO [Pix]
parsePix Int
c BitPixFormat
bpf ByteString
bs = [Pix] -> IO [Pix]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Pix] -> IO [Pix]) -> [Pix] -> IO [Pix]
forall a b. (a -> b) -> a -> b
$ Get [Pix] -> ByteString -> [Pix]
forall a. Get a -> ByteString -> a
runGet (Int -> BitPixFormat -> Get [Pix]
getPixs Int
c BitPixFormat
bpf) ByteString
bs

{- `pixDimsByCol` takes a list of Axis and gives a column-row major list of
    axes dimensions.
-}
pixDimsByCol :: Axes -> [Int]
pixDimsByCol :: [Int] -> [Int]
pixDimsByCol = [Int] -> [Int]
forall a. a -> a
id

{- `pixDimsByRow` takes a list of Axis and gives a row-column major list of
    axes dimensions.
-}
pixDimsByRow :: Axes -> [Int]
pixDimsByRow :: [Int] -> [Int]
pixDimsByRow = [Int] -> [Int]
forall a. [a] -> [a]
reverse ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int]
pixDimsByCol

{-| The header part of the HDU is vital carrying not only authorship
    metadata, but also specifying how to make sense of the binary payload
    that starts 2,880 bytes after the start of the 'HeaderData'.
-}
newtype Header = Header { Header -> Map Keyword Value
_keywords :: Map Keyword Value }
    deriving (Header -> Header -> Bool
(Header -> Header -> Bool)
-> (Header -> Header -> Bool) -> Eq Header
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Header -> Header -> Bool
== :: Header -> Header -> Bool
$c/= :: Header -> Header -> Bool
/= :: Header -> Header -> Bool
Eq)
$(makeLenses ''Header)

instance Show Header where
  show :: Header -> String
show Header
h =
    let kvs :: [(Keyword, Value)]
kvs = Map Keyword Value -> [(Keyword, Value)]
forall k a. Map k a -> [(k, a)]
Map.toList (Header
h Header
-> Getting (Map Keyword Value) Header (Map Keyword Value)
-> Map Keyword Value
forall s a. s -> Getting a s a -> a
^. Getting (Map Keyword Value) Header (Map Keyword Value)
Lens' Header (Map Keyword Value)
keywords) :: [(Keyword, Value)]
    in Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ((Keyword, Value) -> Text) -> [(Keyword, Value)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Keyword, Value) -> Text
line [(Keyword, Value)]
kvs
    where
      --
      -- init :: [Text]
      -- init = map T.pack
      --   [ "BITPIX =" <> show h.size.bitpix
      --   , "NAXES  =" <> show h.size.naxes
      --   ]

      line :: (Keyword, Value) -> Text
      line :: (Keyword, Value) -> Text
line (Keyword Text
k, Value
v) =
        Int -> Char -> Text -> Text
T.justifyLeft Int
8 Char
' ' Text
k
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"="
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> Text -> Text
T.justifyLeft (Int
hduRecordLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
10) Char
' ' (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Value -> String
val Value
v)

      val :: Value -> String
val (Integer Int
n) = Int -> String
forall a. Show a => a -> String
show Int
n
      val (Float Float
f) = Float -> String
forall a. Show a => a -> String
show Float
f
      val (Logic LogicalConstant
T) = String
"              T"
      val (String Text
t) = Text -> String
T.unpack Text
t

lookup :: Keyword -> Header -> Maybe Value
lookup :: Keyword -> Header -> Maybe Value
lookup Keyword
k Header
h = Keyword -> Map Keyword Value -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Keyword
k (Header
h Header
-> Getting (Map Keyword Value) Header (Map Keyword Value)
-> Map Keyword Value
forall s a. s -> Getting a s a -> a
^. Getting (Map Keyword Value) Header (Map Keyword Value)
Lens' Header (Map Keyword Value)
keywords)


data Extension
    -- | Any header data unit can use the primary format. The first MUST be
    -- Primary. This is equivalent to having no extension
    = Primary

    -- | An encoded image. PCOUNT and GCOUNT are required but irrelevant
    | Image

    -- | A Binary table. PCOUNT is the number of bytes that follow the data
    -- in the 'heap'
    | BinTable { Extension -> Int
pCount :: Int, Extension -> ByteString
heap :: ByteString }
    deriving (Extension -> Extension -> Bool
(Extension -> Extension -> Bool)
-> (Extension -> Extension -> Bool) -> Eq Extension
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Extension -> Extension -> Bool
== :: Extension -> Extension -> Bool
$c/= :: Extension -> Extension -> Bool
/= :: Extension -> Extension -> Bool
Eq)

instance Show Extension where
    show :: Extension -> String
show Extension
Primary = String
"Primary"
    show Extension
Image = String
"Image"
    show (BinTable Int
p ByteString
_) = String
"BinTable: heap = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" Bytes"


toInt :: Value -> Maybe Int
toInt :: Value -> Maybe Int
toInt (Integer Int
i) = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i
toInt Value
_ = Maybe Int
forall a. Maybe a
Nothing

toFloat :: Value -> Maybe Float
toFloat :: Value -> Maybe Float
toFloat (Float Float
n) = Float -> Maybe Float
forall a. a -> Maybe a
Just Float
n
toFloat Value
_ = Maybe Float
forall a. Maybe a
Nothing

toText :: Value -> Maybe Text
toText :: Value -> Maybe Text
toText (String Text
s) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
s
toText Value
_ = Maybe Text
forall a. Maybe a
Nothing

{-| When we load a header, we parse the BITPIX and NAXIS(N) keywords so we
 -  can know how long the data array is
-}
data Dimensions = Dimensions
    { Dimensions -> BitPixFormat
_bitpix :: BitPixFormat
    , Dimensions -> [Int]
_axes :: Axes
    } deriving (Int -> Dimensions -> ShowS
[Dimensions] -> ShowS
Dimensions -> String
(Int -> Dimensions -> ShowS)
-> (Dimensions -> String)
-> ([Dimensions] -> ShowS)
-> Show Dimensions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Dimensions -> ShowS
showsPrec :: Int -> Dimensions -> ShowS
$cshow :: Dimensions -> String
show :: Dimensions -> String
$cshowList :: [Dimensions] -> ShowS
showList :: [Dimensions] -> ShowS
Show, Dimensions -> Dimensions -> Bool
(Dimensions -> Dimensions -> Bool)
-> (Dimensions -> Dimensions -> Bool) -> Eq Dimensions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Dimensions -> Dimensions -> Bool
== :: Dimensions -> Dimensions -> Bool
$c/= :: Dimensions -> Dimensions -> Bool
/= :: Dimensions -> Dimensions -> Bool
Eq)
$(makeLenses ''Dimensions)

newtype Comment = Comment Text
    deriving (Int -> Comment -> ShowS
[Comment] -> ShowS
Comment -> String
(Int -> Comment -> ShowS)
-> (Comment -> String) -> ([Comment] -> ShowS) -> Show Comment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Comment -> ShowS
showsPrec :: Int -> Comment -> ShowS
$cshow :: Comment -> String
show :: Comment -> String
$cshowList :: [Comment] -> ShowS
showList :: [Comment] -> ShowS
Show, Comment -> Comment -> Bool
(Comment -> Comment -> Bool)
-> (Comment -> Comment -> Bool) -> Eq Comment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Comment -> Comment -> Bool
== :: Comment -> Comment -> Bool
$c/= :: Comment -> Comment -> Bool
/= :: Comment -> Comment -> Bool
Eq, Eq Comment
Eq Comment
-> (Comment -> Comment -> Ordering)
-> (Comment -> Comment -> Bool)
-> (Comment -> Comment -> Bool)
-> (Comment -> Comment -> Bool)
-> (Comment -> Comment -> Bool)
-> (Comment -> Comment -> Comment)
-> (Comment -> Comment -> Comment)
-> Ord Comment
Comment -> Comment -> Bool
Comment -> Comment -> Ordering
Comment -> Comment -> Comment
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Comment -> Comment -> Ordering
compare :: Comment -> Comment -> Ordering
$c< :: Comment -> Comment -> Bool
< :: Comment -> Comment -> Bool
$c<= :: Comment -> Comment -> Bool
<= :: Comment -> Comment -> Bool
$c> :: Comment -> Comment -> Bool
> :: Comment -> Comment -> Bool
$c>= :: Comment -> Comment -> Bool
>= :: Comment -> Comment -> Bool
$cmax :: Comment -> Comment -> Comment
max :: Comment -> Comment -> Comment
$cmin :: Comment -> Comment -> Comment
min :: Comment -> Comment -> Comment
Ord, String -> Comment
(String -> Comment) -> IsString Comment
forall a. (String -> a) -> IsString a
$cfromString :: String -> Comment
fromString :: String -> Comment
IsString)


{-| The 'HeaderDataUnit' is the full HDU. Both the header information is
    encoded alongside the data payload.
-}
data HeaderDataUnit = HeaderDataUnit
    { HeaderDataUnit -> Header
_header :: Header         -- ^ The heeader contains metadata about the payload
    , HeaderDataUnit -> Dimensions
_dimensions :: Dimensions -- ^ This dimensions of the main data array
    , HeaderDataUnit -> Extension
_extension :: Extension   -- ^ Extensions may vary the data format
    , HeaderDataUnit -> ByteString
_mainData :: ByteString   -- ^ The main data array
    }
    
$(makeLenses ''HeaderDataUnit)

instance Show HeaderDataUnit where
    show :: HeaderDataUnit -> String
show HeaderDataUnit
hdu = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" 
      [ String
"HeaderDataUnit:"
      , String
"  headers = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Map Keyword Value -> Int
forall k a. Map k a -> Int
Map.size (HeaderDataUnit
hdu HeaderDataUnit
-> Getting (Map Keyword Value) HeaderDataUnit (Map Keyword Value)
-> Map Keyword Value
forall s a. s -> Getting a s a -> a
^. (Header -> Const (Map Keyword Value) Header)
-> HeaderDataUnit -> Const (Map Keyword Value) HeaderDataUnit
Lens' HeaderDataUnit Header
header ((Header -> Const (Map Keyword Value) Header)
 -> HeaderDataUnit -> Const (Map Keyword Value) HeaderDataUnit)
-> Getting (Map Keyword Value) Header (Map Keyword Value)
-> Getting (Map Keyword Value) HeaderDataUnit (Map Keyword Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Map Keyword Value) Header (Map Keyword Value)
Lens' Header (Map Keyword Value)
keywords))
      , String
"  extension = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Extension -> String
forall a. Show a => a -> String
show (HeaderDataUnit
hdu HeaderDataUnit
-> Getting Extension HeaderDataUnit Extension -> Extension
forall s a. s -> Getting a s a -> a
^. Getting Extension HeaderDataUnit Extension
Lens' HeaderDataUnit Extension
extension)
      , String
"  mainData = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (ByteString -> Int
BS.length (HeaderDataUnit
hdu HeaderDataUnit
-> Getting ByteString HeaderDataUnit ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString HeaderDataUnit ByteString
Lens' HeaderDataUnit ByteString
mainData)) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" Bytes"
      ]