module Telescope.Fits.Header.Header where

import Data.List qualified as L
import Data.Maybe (mapMaybe)
import Data.Text (Text)
import Telescope.Fits.Header.Keyword
import Telescope.Fits.Header.Value


{- | 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 -> [HeaderRecord]
records :: [HeaderRecord]}
  deriving newtype (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, NonEmpty Header -> Header
Header -> Header -> Header
(Header -> Header -> Header)
-> (NonEmpty Header -> Header)
-> (forall b. Integral b => b -> Header -> Header)
-> Semigroup Header
forall b. Integral b => b -> Header -> Header
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Header -> Header -> Header
<> :: Header -> Header -> Header
$csconcat :: NonEmpty Header -> Header
sconcat :: NonEmpty Header -> Header
$cstimes :: forall b. Integral b => b -> Header -> Header
stimes :: forall b. Integral b => b -> Header -> Header
Semigroup, Semigroup Header
Header
Semigroup Header =>
Header
-> (Header -> Header -> Header)
-> ([Header] -> Header)
-> Monoid Header
[Header] -> Header
Header -> Header -> Header
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: Header
mempty :: Header
$cmappend :: Header -> Header -> Header
mappend :: Header -> Header -> Header
$cmconcat :: [Header] -> Header
mconcat :: [Header] -> Header
Monoid)




{- | Headers contain lines that are any of the following

 > KEYWORD = VALUE / inline comment
 > COMMENT full line comment
 > (blank)
-}
data HeaderRecord
  = Keyword KeywordRecord
  | Comment Text
  | History Text
  | BlankLine
  deriving (Int -> HeaderRecord -> ShowS
[HeaderRecord] -> ShowS
HeaderRecord -> String
(Int -> HeaderRecord -> ShowS)
-> (HeaderRecord -> String)
-> ([HeaderRecord] -> ShowS)
-> Show HeaderRecord
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HeaderRecord -> ShowS
showsPrec :: Int -> HeaderRecord -> ShowS
$cshow :: HeaderRecord -> String
show :: HeaderRecord -> String
$cshowList :: [HeaderRecord] -> ShowS
showList :: [HeaderRecord] -> ShowS
Show, HeaderRecord -> HeaderRecord -> Bool
(HeaderRecord -> HeaderRecord -> Bool)
-> (HeaderRecord -> HeaderRecord -> Bool) -> Eq HeaderRecord
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HeaderRecord -> HeaderRecord -> Bool
== :: HeaderRecord -> HeaderRecord -> Bool
$c/= :: HeaderRecord -> HeaderRecord -> Bool
/= :: HeaderRecord -> HeaderRecord -> Bool
Eq)


-- | Manually look up a keyword from the header
lookupKeyword :: Text -> Header -> Maybe Value
lookupKeyword :: Text -> Header -> Maybe Value
lookupKeyword Text
k = (KeywordRecord -> Bool) -> Header -> Maybe Value
findKeyword (Text -> KeywordRecord -> Bool
isKeyword Text
k)


findKeyword :: (KeywordRecord -> Bool) -> Header -> Maybe Value
findKeyword :: (KeywordRecord -> Bool) -> Header -> Maybe Value
findKeyword KeywordRecord -> Bool
p Header
h = do
  KeywordRecord
kr <- (KeywordRecord -> Bool) -> [KeywordRecord] -> Maybe KeywordRecord
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find KeywordRecord -> Bool
p (Header -> [KeywordRecord]
keywords Header
h)
  Value -> Maybe Value
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure KeywordRecord
kr.value


-- | Return all 'KeywordRecord's from the header, filtering out full-line comments and blanks
keywords :: Header -> [KeywordRecord]
keywords :: Header -> [KeywordRecord]
keywords Header
h = (HeaderRecord -> Maybe KeywordRecord)
-> [HeaderRecord] -> [KeywordRecord]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe HeaderRecord -> Maybe KeywordRecord
toKeyword Header
h.records
 where
  toKeyword :: HeaderRecord -> Maybe KeywordRecord
toKeyword (Keyword KeywordRecord
k) = KeywordRecord -> Maybe KeywordRecord
forall a. a -> Maybe a
Just KeywordRecord
k
  toKeyword HeaderRecord
_ = Maybe KeywordRecord
forall a. Maybe a
Nothing


-- | Construct a keyword HeaderRecord
keyword :: Text -> Value -> Maybe Text -> HeaderRecord
keyword :: Text -> Value -> Maybe Text -> HeaderRecord
keyword Text
k Value
v Maybe Text
mc = KeywordRecord -> HeaderRecord
Keyword (KeywordRecord -> HeaderRecord) -> KeywordRecord -> HeaderRecord
forall a b. (a -> b) -> a -> b
$ Text -> Value -> Maybe Text -> KeywordRecord
KeywordRecord Text
k Value
v Maybe Text
mc