{-# LANGUAGE AllowAmbiguousTypes #-}

module Telescope.Data.WCS where

import Data.Text
import GHC.Generics (Generic)
import Telescope.Data.Axes (AxisOrder (..))
import Telescope.Data.KnownText


newtype CUnit = CUnit Text deriving (CUnit -> CUnit -> Bool
(CUnit -> CUnit -> Bool) -> (CUnit -> CUnit -> Bool) -> Eq CUnit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CUnit -> CUnit -> Bool
== :: CUnit -> CUnit -> Bool
$c/= :: CUnit -> CUnit -> Bool
/= :: CUnit -> CUnit -> Bool
Eq, Int -> CUnit -> ShowS
[CUnit] -> ShowS
CUnit -> String
(Int -> CUnit -> ShowS)
-> (CUnit -> String) -> ([CUnit] -> ShowS) -> Show CUnit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CUnit -> ShowS
showsPrec :: Int -> CUnit -> ShowS
$cshow :: CUnit -> String
show :: CUnit -> String
$cshowList :: [CUnit] -> ShowS
showList :: [CUnit] -> ShowS
Show)
newtype CType = CType Text deriving (CType -> CType -> Bool
(CType -> CType -> Bool) -> (CType -> CType -> Bool) -> Eq CType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CType -> CType -> Bool
== :: CType -> CType -> Bool
$c/= :: CType -> CType -> Bool
/= :: CType -> CType -> Bool
Eq, Int -> CType -> ShowS
[CType] -> ShowS
CType -> String
(Int -> CType -> ShowS)
-> (CType -> String) -> ([CType] -> ShowS) -> Show CType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CType -> ShowS
showsPrec :: Int -> CType -> ShowS
$cshow :: CType -> String
show :: CType -> String
$cshowList :: [CType] -> ShowS
showList :: [CType] -> ShowS
Show)


{- | Typed WCS Axes

> data X
> data Y
>
> myFunction :: WCSAxis 'WCSMain X -> WCSAxis 'WCSMain Y -> Header
> myFunction wcsx wcsy =
>   toHeader wcsx <> toHeader wcsy
-}
data WCSAxis (alt :: WCSAlt) axis = WCSAxis
  { forall {k} (alt :: WCSAlt) (axis :: k). WCSAxis alt axis -> CType
ctype :: CType
  , forall {k} (alt :: WCSAlt) (axis :: k). WCSAxis alt axis -> CUnit
cunit :: CUnit
  , forall {k} (alt :: WCSAlt) (axis :: k). WCSAxis alt axis -> Float
crpix :: Float
  , forall {k} (alt :: WCSAlt) (axis :: k). WCSAxis alt axis -> Float
crval :: Float
  , forall {k} (alt :: WCSAlt) (axis :: k). WCSAxis alt axis -> Float
cdelt :: Float
  }
  deriving ((forall x. WCSAxis alt axis -> Rep (WCSAxis alt axis) x)
-> (forall x. Rep (WCSAxis alt axis) x -> WCSAxis alt axis)
-> Generic (WCSAxis alt axis)
forall x. Rep (WCSAxis alt axis) x -> WCSAxis alt axis
forall x. WCSAxis alt axis -> Rep (WCSAxis alt axis) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (alt :: WCSAlt) k (axis :: k) x.
Rep (WCSAxis alt axis) x -> WCSAxis alt axis
forall (alt :: WCSAlt) k (axis :: k) x.
WCSAxis alt axis -> Rep (WCSAxis alt axis) x
$cfrom :: forall (alt :: WCSAlt) k (axis :: k) x.
WCSAxis alt axis -> Rep (WCSAxis alt axis) x
from :: forall x. WCSAxis alt axis -> Rep (WCSAxis alt axis) x
$cto :: forall (alt :: WCSAlt) k (axis :: k) x.
Rep (WCSAxis alt axis) x -> WCSAxis alt axis
to :: forall x. Rep (WCSAxis alt axis) x -> WCSAxis alt axis
Generic, WCSAxis alt axis -> WCSAxis alt axis -> Bool
(WCSAxis alt axis -> WCSAxis alt axis -> Bool)
-> (WCSAxis alt axis -> WCSAxis alt axis -> Bool)
-> Eq (WCSAxis alt axis)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (alt :: WCSAlt) k (axis :: k).
WCSAxis alt axis -> WCSAxis alt axis -> Bool
$c== :: forall (alt :: WCSAlt) k (axis :: k).
WCSAxis alt axis -> WCSAxis alt axis -> Bool
== :: WCSAxis alt axis -> WCSAxis alt axis -> Bool
$c/= :: forall (alt :: WCSAlt) k (axis :: k).
WCSAxis alt axis -> WCSAxis alt axis -> Bool
/= :: WCSAxis alt axis -> WCSAxis alt axis -> Bool
Eq, Int -> WCSAxis alt axis -> ShowS
[WCSAxis alt axis] -> ShowS
WCSAxis alt axis -> String
(Int -> WCSAxis alt axis -> ShowS)
-> (WCSAxis alt axis -> String)
-> ([WCSAxis alt axis] -> ShowS)
-> Show (WCSAxis alt axis)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (alt :: WCSAlt) k (axis :: k).
Int -> WCSAxis alt axis -> ShowS
forall (alt :: WCSAlt) k (axis :: k). [WCSAxis alt axis] -> ShowS
forall (alt :: WCSAlt) k (axis :: k). WCSAxis alt axis -> String
$cshowsPrec :: forall (alt :: WCSAlt) k (axis :: k).
Int -> WCSAxis alt axis -> ShowS
showsPrec :: Int -> WCSAxis alt axis -> ShowS
$cshow :: forall (alt :: WCSAlt) k (axis :: k). WCSAxis alt axis -> String
show :: WCSAxis alt axis -> String
$cshowList :: forall (alt :: WCSAlt) k (axis :: k). [WCSAxis alt axis] -> ShowS
showList :: [WCSAxis alt axis] -> ShowS
Show)


-- | WCSAlt options
data WCSAlt
  = WCSMain
  | A
  | B


instance KnownText WCSMain where
  knownText :: Text
knownText = Text
""
instance KnownText A where
  knownText :: Text
knownText = Text
"A"
instance KnownText B where
  knownText :: Text
knownText = Text
"B"


-- | Converts a wcs keyword like "ctype" to "CTYPE1A" for header parsing
toWCSAxisKey :: forall alt ax. (KnownText alt, AxisOrder ax) => Text -> Text
toWCSAxisKey :: forall {k} {k} (alt :: k) (ax :: k).
(KnownText alt, AxisOrder ax) =>
Text -> Text
toWCSAxisKey = Text -> Text
addAlt (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
addAxisN
 where
  addAxisN :: Text -> Text
addAxisN Text
k = Text
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (Natural -> String
forall a. Show a => a -> String
show (forall (ax :: k). AxisOrder ax => Natural
forall {k} (ax :: k). AxisOrder ax => Natural
axisN @ax))
  addAlt :: Text -> Text
addAlt Text
k = Text
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (forall (a :: k). KnownText a => Text
forall {k} (a :: k). KnownText a => Text
knownText @alt)