{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DefaultSignatures #-}

module Telescope.Asdf.GWCS where

import Data.Kind (Type)
import Data.List.NonEmpty (NonEmpty (..))
import Data.List.NonEmpty qualified as NE
import Data.Massiv.Array (Array, Ix2)
import Data.Massiv.Array qualified as M
import Data.String (IsString)
import Data.Text (Text, pack)
import Data.Text qualified as T
import GHC.Generics
import Telescope.Asdf
import Telescope.Asdf.Core
import Telescope.Data.WCS (WCSAxis (..))


-- | GWCS pipelines consist of an input and output 'GWCSStep'
data GWCS inp out = GWCS (GWCSStep inp) (GWCSStep out)


instance (ToAsdf inp, ToAsdf out) => ToAsdf (GWCS inp out) where
  schema :: GWCS inp out -> SchemaTag
schema GWCS inp out
_ = SchemaTag
"tag:stsci.edu:gwcs/wcs-1.2.0"
  toValue :: GWCS inp out -> Value
toValue (GWCS GWCSStep inp
inp GWCSStep out
out) =
    Object -> Value
Object
      [ (Key
"name", Value -> Node
forall a. ToAsdf a => a -> Node
toNode (Value -> Node) -> Value -> Node
forall a b. (a -> b) -> a -> b
$ Key -> Value
String Key
"")
      , (Key
"steps", Value -> Node
forall a. ToAsdf a => a -> Node
toNode (Value -> Node) -> Value -> Node
forall a b. (a -> b) -> a -> b
$ [Node] -> Value
Array [GWCSStep inp -> Node
forall a. ToAsdf a => a -> Node
toNode GWCSStep inp
inp, GWCSStep out -> Node
forall a. ToAsdf a => a -> Node
toNode GWCSStep out
out])
      ]


-- | A step contains a frame (like 'CelestialFrame') and a 'Transform a b'
data GWCSStep frame = GWCSStep
  { forall frame. GWCSStep frame -> frame
frame :: frame
  , forall frame. GWCSStep frame -> Maybe Transformation
transform :: Maybe Transformation
  }
  deriving ((forall x. GWCSStep frame -> Rep (GWCSStep frame) x)
-> (forall x. Rep (GWCSStep frame) x -> GWCSStep frame)
-> Generic (GWCSStep frame)
forall x. Rep (GWCSStep frame) x -> GWCSStep frame
forall x. GWCSStep frame -> Rep (GWCSStep frame) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall frame x. Rep (GWCSStep frame) x -> GWCSStep frame
forall frame x. GWCSStep frame -> Rep (GWCSStep frame) x
$cfrom :: forall frame x. GWCSStep frame -> Rep (GWCSStep frame) x
from :: forall x. GWCSStep frame -> Rep (GWCSStep frame) x
$cto :: forall frame x. Rep (GWCSStep frame) x -> GWCSStep frame
to :: forall x. Rep (GWCSStep frame) x -> GWCSStep frame
Generic)


instance (ToAsdf frame) => ToAsdf (GWCSStep frame) where
  schema :: GWCSStep frame -> SchemaTag
schema GWCSStep frame
_ = SchemaTag
"tag:stsci.edu:gwcs/step-1.1.0"


newtype AxisName = AxisName Text
  deriving newtype (String -> AxisName
(String -> AxisName) -> IsString AxisName
forall a. (String -> a) -> IsString a
$cfromString :: String -> AxisName
fromString :: String -> AxisName
IsString, AxisName -> Maybe Anchor
AxisName -> Value
AxisName -> Node
AxisName -> SchemaTag
(AxisName -> Value)
-> (AxisName -> SchemaTag)
-> (AxisName -> Maybe Anchor)
-> (AxisName -> Node)
-> ToAsdf AxisName
forall a.
(a -> Value)
-> (a -> SchemaTag)
-> (a -> Maybe Anchor)
-> (a -> Node)
-> ToAsdf a
$ctoValue :: AxisName -> Value
toValue :: AxisName -> Value
$cschema :: AxisName -> SchemaTag
schema :: AxisName -> SchemaTag
$canchor :: AxisName -> Maybe Anchor
anchor :: AxisName -> Maybe Anchor
$ctoNode :: AxisName -> Node
toNode :: AxisName -> Node
ToAsdf, Int -> AxisName -> ShowS
[AxisName] -> ShowS
AxisName -> String
(Int -> AxisName -> ShowS)
-> (AxisName -> String) -> ([AxisName] -> ShowS) -> Show AxisName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AxisName -> ShowS
showsPrec :: Int -> AxisName -> ShowS
$cshow :: AxisName -> String
show :: AxisName -> String
$cshowList :: [AxisName] -> ShowS
showList :: [AxisName] -> ShowS
Show, NonEmpty AxisName -> AxisName
AxisName -> AxisName -> AxisName
(AxisName -> AxisName -> AxisName)
-> (NonEmpty AxisName -> AxisName)
-> (forall b. Integral b => b -> AxisName -> AxisName)
-> Semigroup AxisName
forall b. Integral b => b -> AxisName -> AxisName
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: AxisName -> AxisName -> AxisName
<> :: AxisName -> AxisName -> AxisName
$csconcat :: NonEmpty AxisName -> AxisName
sconcat :: NonEmpty AxisName -> AxisName
$cstimes :: forall b. Integral b => b -> AxisName -> AxisName
stimes :: forall b. Integral b => b -> AxisName -> AxisName
Semigroup, AxisName -> AxisName -> Bool
(AxisName -> AxisName -> Bool)
-> (AxisName -> AxisName -> Bool) -> Eq AxisName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AxisName -> AxisName -> Bool
== :: AxisName -> AxisName -> Bool
$c/= :: AxisName -> AxisName -> Bool
/= :: AxisName -> AxisName -> Bool
Eq)


newtype AxisType = AxisType Text
  deriving newtype (String -> AxisType
(String -> AxisType) -> IsString AxisType
forall a. (String -> a) -> IsString a
$cfromString :: String -> AxisType
fromString :: String -> AxisType
IsString)
instance ToAsdf AxisType where
  toValue :: AxisType -> Value
toValue (AxisType Key
t) = Key -> Value
String Key
t


data Pix a
data Rot a


instance (ToAxes a) => ToAxes (Pix a) where
  toAxes :: [AxisName]
toAxes = forall a. ToAxes a => [AxisName]
toAxes @a
instance (ToAxes a) => ToAxes (Scale a) where
  toAxes :: [AxisName]
toAxes = (AxisName -> AxisName) -> [AxisName] -> [AxisName]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (AxisName
"*" <>) (forall a. ToAxes a => [AxisName]
toAxes @a)
instance (ToAxes a) => ToAxes (Shift a) where
  toAxes :: [AxisName]
toAxes = (AxisName -> AxisName) -> [AxisName] -> [AxisName]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (AxisName
"+" <>) (forall a. ToAxes a => [AxisName]
toAxes @a)
instance (ToAxes a) => ToAxes (Rot a) where
  toAxes :: [AxisName]
toAxes = (AxisName -> AxisName) -> [AxisName] -> [AxisName]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (AxisName
"rot_" <>) (forall a. ToAxes a => [AxisName]
toAxes @a)
instance (ToAxes a) => ToAxes (Linear a) where
  toAxes :: [AxisName]
toAxes = (AxisName -> AxisName) -> [AxisName] -> [AxisName]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (AxisName
"lin_" <>) (forall a. ToAxes a => [AxisName]
toAxes @a)


newtype Lon = Lon Float
  deriving newtype (Lon -> Maybe Anchor
Lon -> Value
Lon -> Node
Lon -> SchemaTag
(Lon -> Value)
-> (Lon -> SchemaTag)
-> (Lon -> Maybe Anchor)
-> (Lon -> Node)
-> ToAsdf Lon
forall a.
(a -> Value)
-> (a -> SchemaTag)
-> (a -> Maybe Anchor)
-> (a -> Node)
-> ToAsdf a
$ctoValue :: Lon -> Value
toValue :: Lon -> Value
$cschema :: Lon -> SchemaTag
schema :: Lon -> SchemaTag
$canchor :: Lon -> Maybe Anchor
anchor :: Lon -> Maybe Anchor
$ctoNode :: Lon -> Node
toNode :: Lon -> Node
ToAsdf)
newtype Lat = Lat Float
  deriving newtype (Lat -> Maybe Anchor
Lat -> Value
Lat -> Node
Lat -> SchemaTag
(Lat -> Value)
-> (Lat -> SchemaTag)
-> (Lat -> Maybe Anchor)
-> (Lat -> Node)
-> ToAsdf Lat
forall a.
(a -> Value)
-> (a -> SchemaTag)
-> (a -> Maybe Anchor)
-> (a -> Node)
-> ToAsdf a
$ctoValue :: Lat -> Value
toValue :: Lat -> Value
$cschema :: Lat -> SchemaTag
schema :: Lat -> SchemaTag
$canchor :: Lat -> Maybe Anchor
anchor :: Lat -> Maybe Anchor
$ctoNode :: Lat -> Node
toNode :: Lat -> Node
ToAsdf)
newtype LonPole = LonPole Float
  deriving newtype (LonPole -> Maybe Anchor
LonPole -> Value
LonPole -> Node
LonPole -> SchemaTag
(LonPole -> Value)
-> (LonPole -> SchemaTag)
-> (LonPole -> Maybe Anchor)
-> (LonPole -> Node)
-> ToAsdf LonPole
forall a.
(a -> Value)
-> (a -> SchemaTag)
-> (a -> Maybe Anchor)
-> (a -> Node)
-> ToAsdf a
$ctoValue :: LonPole -> Value
toValue :: LonPole -> Value
$cschema :: LonPole -> SchemaTag
schema :: LonPole -> SchemaTag
$canchor :: LonPole -> Maybe Anchor
anchor :: LonPole -> Maybe Anchor
$ctoNode :: LonPole -> Node
toNode :: LonPole -> Node
ToAsdf)


-- | A 'Tranform' with the types stripped, and the axes recorded
data Transformation = Transformation
  { Transformation -> [AxisName]
inputs :: [AxisName]
  , Transformation -> [AxisName]
outputs :: [AxisName]
  , Transformation -> Forward
forward :: Forward
  }
  deriving (Int -> Transformation -> ShowS
[Transformation] -> ShowS
Transformation -> String
(Int -> Transformation -> ShowS)
-> (Transformation -> String)
-> ([Transformation] -> ShowS)
-> Show Transformation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Transformation -> ShowS
showsPrec :: Int -> Transformation -> ShowS
$cshow :: Transformation -> String
show :: Transformation -> String
$cshowList :: [Transformation] -> ShowS
showList :: [Transformation] -> ShowS
Show, Transformation -> Transformation -> Bool
(Transformation -> Transformation -> Bool)
-> (Transformation -> Transformation -> Bool) -> Eq Transformation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Transformation -> Transformation -> Bool
== :: Transformation -> Transformation -> Bool
$c/= :: Transformation -> Transformation -> Bool
/= :: Transformation -> Transformation -> Bool
Eq)


instance ToAsdf Transformation where
  schema :: Transformation -> SchemaTag
schema Transformation
t =
    case Transformation
t.forward of
      Compose Transformation
_ Transformation
_ -> SchemaTag
"!transform/compose-1.2.0"
      Concat Transformation
_ Transformation
_ -> SchemaTag
"!transform/concatenate-1.2.0"
      Direct{SchemaTag
schemaTag :: SchemaTag
schemaTag :: Forward -> SchemaTag
schemaTag} -> SchemaTag
schemaTag


  toValue :: Transformation -> Value
toValue Transformation
t =
    Value
inputFields Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> case Transformation
t.forward of
      Compose Transformation
a Transformation
b -> Object -> Value
Object [(Key
"forward", [Transformation] -> Node
forall a. ToAsdf a => a -> Node
toNode [Transformation
a, Transformation
b])]
      Concat Transformation
a Transformation
b -> Object -> Value
Object [(Key
"forward", [Transformation] -> Node
forall a. ToAsdf a => a -> Node
toNode [Transformation
a, Transformation
b])]
      Direct{Value
fields :: Value
fields :: Forward -> Value
fields} -> Value
fields
   where
    inputFields :: Value
inputFields =
      Object -> Value
Object
        [ (Key
"inputs", [AxisName] -> Node
forall a. ToAsdf a => a -> Node
toNode Transformation
t.inputs)
        , (Key
"outputs", [AxisName] -> Node
forall a. ToAsdf a => a -> Node
toNode Transformation
t.outputs)
        ]


data Forward
  = Compose Transformation Transformation
  | Concat Transformation Transformation
  | Direct {Forward -> SchemaTag
schemaTag :: SchemaTag, Forward -> Value
fields :: Value}
  deriving (Int -> Forward -> ShowS
[Forward] -> ShowS
Forward -> String
(Int -> Forward -> ShowS)
-> (Forward -> String) -> ([Forward] -> ShowS) -> Show Forward
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Forward -> ShowS
showsPrec :: Int -> Forward -> ShowS
$cshow :: Forward -> String
show :: Forward -> String
$cshowList :: [Forward] -> ShowS
showList :: [Forward] -> ShowS
Show, Forward -> Forward -> Bool
(Forward -> Forward -> Bool)
-> (Forward -> Forward -> Bool) -> Eq Forward
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Forward -> Forward -> Bool
== :: Forward -> Forward -> Bool
$c/= :: Forward -> Forward -> Bool
/= :: Forward -> Forward -> Bool
Eq)


{- | A Transform specifies how we manipulate a type in a pipeline

> spatialTransform :: WCSAxis s X -> WCSAxis s Y -> Transform (Pix X, PixY) (Scale X, Scale Y)
> spatialTransform wcsx wcsy =
>   let dx = shift wcsx.crpix :: Transform (Pix X) (Shift X)
>       dy = shift wcsy.crpix :: Transform (Pix Y) (Shift Y)
>       xx = scale wcsx.cdelt :: Transform (Shift X) (Scale X)
>       xy = scale wcsy.cdelt :: Transform (Shift Y) (Scale Y)
>   in dx |> xx <&> dy |> xy
-}
data Transform b c = Transform
  { forall {k} {k} (b :: k) (c :: k). Transform b c -> Transformation
transformation :: Transformation
  }
  deriving (Int -> Transform b c -> ShowS
[Transform b c] -> ShowS
Transform b c -> String
(Int -> Transform b c -> ShowS)
-> (Transform b c -> String)
-> ([Transform b c] -> ShowS)
-> Show (Transform b c)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (b :: k) k (c :: k). Int -> Transform b c -> ShowS
forall k (b :: k) k (c :: k). [Transform b c] -> ShowS
forall k (b :: k) k (c :: k). Transform b c -> String
$cshowsPrec :: forall k (b :: k) k (c :: k). Int -> Transform b c -> ShowS
showsPrec :: Int -> Transform b c -> ShowS
$cshow :: forall k (b :: k) k (c :: k). Transform b c -> String
show :: Transform b c -> String
$cshowList :: forall k (b :: k) k (c :: k). [Transform b c] -> ShowS
showList :: [Transform b c] -> ShowS
Show)


-- | Convert a type into a 'Transform' via 'ToAsdf' and 'ToAxes'
transform :: forall a bs cs. (ToAsdf a, ToAxes bs, ToAxes cs) => a -> Transform bs cs
transform :: forall a bs cs.
(ToAsdf a, ToAxes bs, ToAxes cs) =>
a -> Transform bs cs
transform a
a =
  Transformation -> Transform bs cs
forall {k} {k} (b :: k) (c :: k). Transformation -> Transform b c
Transform
    (Transformation -> Transform bs cs)
-> Transformation -> Transform bs cs
forall a b. (a -> b) -> a -> b
$ [AxisName] -> [AxisName] -> Forward -> Transformation
Transformation
      (forall a. ToAxes a => [AxisName]
toAxes @bs)
      (forall a. ToAxes a => [AxisName]
toAxes @cs)
    (Forward -> Transformation) -> Forward -> Transformation
forall a b. (a -> b) -> a -> b
$ SchemaTag -> Value -> Forward
Direct (a -> SchemaTag
forall a. ToAsdf a => a -> SchemaTag
schema a
a) (a -> Value
forall a. ToAsdf a => a -> Value
toValue a
a)


-- | Compose two transforms
(|>) :: forall b c d. (ToAxes b, ToAxes d) => Transform b c -> Transform c d -> Transform b d
(Transform Transformation
s) |> :: forall {k} b (c :: k) d.
(ToAxes b, ToAxes d) =>
Transform b c -> Transform c d -> Transform b d
|> (Transform Transformation
t) =
  Transformation -> Transform b d
forall {k} {k} (b :: k) (c :: k). Transformation -> Transform b c
Transform
    (Transformation -> Transform b d)
-> Transformation -> Transform b d
forall a b. (a -> b) -> a -> b
$ [AxisName] -> [AxisName] -> Forward -> Transformation
Transformation
      (forall a. ToAxes a => [AxisName]
toAxes @b)
      (forall a. ToAxes a => [AxisName]
toAxes @d)
    (Forward -> Transformation) -> Forward -> Transformation
forall a b. (a -> b) -> a -> b
$ Transformation -> Transformation -> Forward
Compose Transformation
s Transformation
t


infixr 5 |>


-- | Concatent two transforms
(<&>)
  :: forall (a :: Type) (b :: Type) (cs :: Type) (ds :: Type)
   . (ToAxes (TConcat a cs), ToAxes (TConcat b ds))
  => Transform a b
  -> Transform cs ds
  -> Transform (TConcat a cs) (TConcat b ds)
Transform Transformation
s <&> :: forall a b cs ds.
(ToAxes (TConcat a cs), ToAxes (TConcat b ds)) =>
Transform a b
-> Transform cs ds -> Transform (TConcat a cs) (TConcat b ds)
<&> Transform Transformation
t =
  Transformation -> Transform (TConcat a cs) (TConcat b ds)
forall {k} {k} (b :: k) (c :: k). Transformation -> Transform b c
Transform
    (Transformation -> Transform (TConcat a cs) (TConcat b ds))
-> Transformation -> Transform (TConcat a cs) (TConcat b ds)
forall a b. (a -> b) -> a -> b
$ [AxisName] -> [AxisName] -> Forward -> Transformation
Transformation
      (forall a. ToAxes a => [AxisName]
toAxes @(TConcat a cs))
      (forall a. ToAxes a => [AxisName]
toAxes @(TConcat b ds))
    (Forward -> Transformation) -> Forward -> Transformation
forall a b. (a -> b) -> a -> b
$ Transformation -> Transformation -> Forward
Concat Transformation
s Transformation
t


infixr 4 <&>


data Direction
  = Pix2Sky
  | Native2Celestial
  deriving (Int -> Direction -> ShowS
[Direction] -> ShowS
Direction -> String
(Int -> Direction -> ShowS)
-> (Direction -> String)
-> ([Direction] -> ShowS)
-> Show Direction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Direction -> ShowS
showsPrec :: Int -> Direction -> ShowS
$cshow :: Direction -> String
show :: Direction -> String
$cshowList :: [Direction] -> ShowS
showList :: [Direction] -> ShowS
Show)


instance ToAsdf Direction where
  toValue :: Direction -> Value
toValue = Key -> Value
String (Key -> Value) -> (Direction -> Key) -> Direction -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Key
T.toLower (Key -> Key) -> (Direction -> Key) -> Direction -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Key
pack (String -> Key) -> (Direction -> String) -> Direction -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Direction -> String
forall a. Show a => a -> String
show


data Shift a = Shift Float deriving (Int -> Shift a -> ShowS
[Shift a] -> ShowS
Shift a -> String
(Int -> Shift a -> ShowS)
-> (Shift a -> String) -> ([Shift a] -> ShowS) -> Show (Shift a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (a :: k). Int -> Shift a -> ShowS
forall k (a :: k). [Shift a] -> ShowS
forall k (a :: k). Shift a -> String
$cshowsPrec :: forall k (a :: k). Int -> Shift a -> ShowS
showsPrec :: Int -> Shift a -> ShowS
$cshow :: forall k (a :: k). Shift a -> String
show :: Shift a -> String
$cshowList :: forall k (a :: k). [Shift a] -> ShowS
showList :: [Shift a] -> ShowS
Show, Shift a -> Shift a -> Bool
(Shift a -> Shift a -> Bool)
-> (Shift a -> Shift a -> Bool) -> Eq (Shift a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (a :: k). Shift a -> Shift a -> Bool
$c== :: forall k (a :: k). Shift a -> Shift a -> Bool
== :: Shift a -> Shift a -> Bool
$c/= :: forall k (a :: k). Shift a -> Shift a -> Bool
/= :: Shift a -> Shift a -> Bool
Eq)
data Scale a = Scale Float deriving (Int -> Scale a -> ShowS
[Scale a] -> ShowS
Scale a -> String
(Int -> Scale a -> ShowS)
-> (Scale a -> String) -> ([Scale a] -> ShowS) -> Show (Scale a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (a :: k). Int -> Scale a -> ShowS
forall k (a :: k). [Scale a] -> ShowS
forall k (a :: k). Scale a -> String
$cshowsPrec :: forall k (a :: k). Int -> Scale a -> ShowS
showsPrec :: Int -> Scale a -> ShowS
$cshow :: forall k (a :: k). Scale a -> String
show :: Scale a -> String
$cshowList :: forall k (a :: k). [Scale a] -> ShowS
showList :: [Scale a] -> ShowS
Show, Scale a -> Scale a -> Bool
(Scale a -> Scale a -> Bool)
-> (Scale a -> Scale a -> Bool) -> Eq (Scale a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (a :: k). Scale a -> Scale a -> Bool
$c== :: forall k (a :: k). Scale a -> Scale a -> Bool
== :: Scale a -> Scale a -> Bool
$c/= :: forall k (a :: k). Scale a -> Scale a -> Bool
/= :: Scale a -> Scale a -> Bool
Eq)
data Identity = Identity deriving (Int -> Identity -> ShowS
[Identity] -> ShowS
Identity -> String
(Int -> Identity -> ShowS)
-> (Identity -> String) -> ([Identity] -> ShowS) -> Show Identity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Identity -> ShowS
showsPrec :: Int -> Identity -> ShowS
$cshow :: Identity -> String
show :: Identity -> String
$cshowList :: [Identity] -> ShowS
showList :: [Identity] -> ShowS
Show, Identity -> Identity -> Bool
(Identity -> Identity -> Bool)
-> (Identity -> Identity -> Bool) -> Eq Identity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Identity -> Identity -> Bool
== :: Identity -> Identity -> Bool
$c/= :: Identity -> Identity -> Bool
/= :: Identity -> Identity -> Bool
Eq)
data Intercept = Intercept Float deriving (Int -> Intercept -> ShowS
[Intercept] -> ShowS
Intercept -> String
(Int -> Intercept -> ShowS)
-> (Intercept -> String)
-> ([Intercept] -> ShowS)
-> Show Intercept
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Intercept -> ShowS
showsPrec :: Int -> Intercept -> ShowS
$cshow :: Intercept -> String
show :: Intercept -> String
$cshowList :: [Intercept] -> ShowS
showList :: [Intercept] -> ShowS
Show, Intercept -> Intercept -> Bool
(Intercept -> Intercept -> Bool)
-> (Intercept -> Intercept -> Bool) -> Eq Intercept
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Intercept -> Intercept -> Bool
== :: Intercept -> Intercept -> Bool
$c/= :: Intercept -> Intercept -> Bool
/= :: Intercept -> Intercept -> Bool
Eq)
data Affine = Affine {Affine -> Array D Ix2 Float
matrix :: Array M.D Ix2 Float, Affine -> (Float, Float)
translation :: (Float, Float)}
data Projection = Projection Direction
data Rotate3d = Rotate3d {Rotate3d -> Direction
direction :: Direction, Rotate3d -> Lon
phi :: Lon, Rotate3d -> Lat
theta :: Lat, Rotate3d -> LonPole
psi :: LonPole}
  deriving ((forall x. Rotate3d -> Rep Rotate3d x)
-> (forall x. Rep Rotate3d x -> Rotate3d) -> Generic Rotate3d
forall x. Rep Rotate3d x -> Rotate3d
forall x. Rotate3d -> Rep Rotate3d x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Rotate3d -> Rep Rotate3d x
from :: forall x. Rotate3d -> Rep Rotate3d x
$cto :: forall x. Rep Rotate3d x -> Rotate3d
to :: forall x. Rep Rotate3d x -> Rotate3d
Generic)
data Linear a = Linear1d {forall {k} (a :: k). Linear a -> Float
intercept :: Float, forall {k} (a :: k). Linear a -> Float
slope :: Float}
  deriving ((forall x. Linear a -> Rep (Linear a) x)
-> (forall x. Rep (Linear a) x -> Linear a) -> Generic (Linear a)
forall x. Rep (Linear a) x -> Linear a
forall x. Linear a -> Rep (Linear a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (a :: k) x. Rep (Linear a) x -> Linear a
forall k (a :: k) x. Linear a -> Rep (Linear a) x
$cfrom :: forall k (a :: k) x. Linear a -> Rep (Linear a) x
from :: forall x. Linear a -> Rep (Linear a) x
$cto :: forall k (a :: k) x. Rep (Linear a) x -> Linear a
to :: forall x. Rep (Linear a) x -> Linear a
Generic)


instance ToAsdf Identity where
  schema :: Identity -> SchemaTag
schema Identity
_ = SchemaTag
"!transform/identity-1.2.0"
  toValue :: Identity -> Value
toValue Identity
_ = Object -> Value
Object []


instance ToAsdf (Linear a) where
  schema :: Linear a -> SchemaTag
schema Linear a
_ = SchemaTag
"!transform/linear1d-1.0.0"


instance ToAsdf (Shift a) where
  schema :: Shift a -> SchemaTag
schema Shift a
_ = SchemaTag
"!transform/shift-1.2.0"
  toValue :: Shift a -> Value
toValue (Shift Float
d) =
    Object -> Value
Object [(Key
"offset", Float -> Node
forall a. ToAsdf a => a -> Node
toNode Float
d)]


instance ToAsdf (Scale a) where
  schema :: Scale a -> SchemaTag
schema Scale a
_ = SchemaTag
"!transform/scale-1.2.0"
  toValue :: Scale a -> Value
toValue (Scale Float
d) =
    Object -> Value
Object [(Key
"factor", Float -> Node
forall a. ToAsdf a => a -> Node
toNode Float
d)]


instance ToAsdf Projection where
  schema :: Projection -> SchemaTag
schema Projection
_ = SchemaTag
"!transform/gnomonic-1.2.0"
  toValue :: Projection -> Value
toValue (Projection Direction
d) =
    Object -> Value
Object [(Key
"direction", Direction -> Node
forall a. ToAsdf a => a -> Node
toNode Direction
d)]


instance ToAsdf Rotate3d where
  schema :: Rotate3d -> SchemaTag
schema Rotate3d
_ = SchemaTag
"!transform/rotate3d-1.3.0"


instance ToAsdf Affine where
  schema :: Affine -> SchemaTag
schema Affine
_ = SchemaTag
"!transform/affine-1.3.0"
  toValue :: Affine -> Value
toValue Affine
a =
    let (Float
tx, Float
ty) = Affine
a.translation
     in Object -> Value
Object
          [ (Key
"matrix", [ListItem Ix2 Float] -> Node
forall a. ToAsdf a => a -> Node
toNode ([ListItem Ix2 Float] -> Node) -> [ListItem Ix2 Float] -> Node
forall a b. (a -> b) -> a -> b
$ Array D Ix2 Float -> [ListItem Ix2 Float]
forall ix e r.
(Ragged L ix e, Shape r ix, Source r e) =>
Array r ix e -> [ListItem ix e]
M.toLists Affine
a.matrix)
          , (Key
"translation", [Float] -> Node
forall a. ToAsdf a => a -> Node
toNode [Float
tx, Float
ty])
          ]


-- Frames -----------------------------------------------

data CoordinateFrame = CoordinateFrame
  { CoordinateFrame -> Key
name :: Text
  , CoordinateFrame -> NonEmpty FrameAxis
axes :: NonEmpty FrameAxis
  }
instance ToAsdf CoordinateFrame where
  schema :: CoordinateFrame -> SchemaTag
schema CoordinateFrame
_ = SchemaTag
"tag:stsci.edu:gwcs/frame-1.0.0"
  toValue :: CoordinateFrame -> Value
toValue CoordinateFrame
f =
    Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$
      [ (Key
"name", Key -> Node
forall a. ToAsdf a => a -> Node
toNode CoordinateFrame
f.name)
      , (Key
"axes_type", NonEmpty AxisType -> Node
forall a. ToAsdf a => a -> Node
toNode (NonEmpty AxisType -> Node) -> NonEmpty AxisType -> Node
forall a b. (a -> b) -> a -> b
$ (FrameAxis -> AxisType) -> NonEmpty FrameAxis -> NonEmpty AxisType
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (.axisType) CoordinateFrame
f.axes)
      ]
        Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> NonEmpty FrameAxis -> Object
frameAxesObject CoordinateFrame
f.axes


data StokesFrame = StokesFrame
  { StokesFrame -> Key
name :: Text
  , StokesFrame -> Int
axisOrder :: Int
  }
instance ToAsdf StokesFrame where
  schema :: StokesFrame -> SchemaTag
schema StokesFrame
_ = SchemaTag
"tag:stsci.edu:gwcs/stokes_frame-1.0.0"
  toValue :: StokesFrame -> Value
toValue StokesFrame
f =
    Object -> Value
Object
      [ (Key
"name", Key -> Node
forall a. ToAsdf a => a -> Node
toNode StokesFrame
f.name)
      , (Key
"axes_order", [Int] -> Node
forall a. ToAsdf a => a -> Node
toNode [StokesFrame
f.axisOrder])
      ]


data SpectralFrame = SpectralFrame
  { SpectralFrame -> Key
name :: Text
  , SpectralFrame -> Int
axisOrder :: Int
  }
instance ToAsdf SpectralFrame where
  schema :: SpectralFrame -> SchemaTag
schema SpectralFrame
_ = SchemaTag
"tag:stsci.edu:gwcs/spectral_frame-1.0.0"
  toValue :: SpectralFrame -> Value
toValue SpectralFrame
f =
    Object -> Value
Object
      [ (Key
"name", Key -> Node
forall a. ToAsdf a => a -> Node
toNode SpectralFrame
f.name)
      , (Key
"axes_names", [Value] -> Node
forall a. ToAsdf a => a -> Node
toNode [Key -> Value
String Key
"wavelength"])
      , (Key
"axes_order", [Int] -> Node
forall a. ToAsdf a => a -> Node
toNode [SpectralFrame
f.axisOrder])
      , (Key
"axis_physical_types", [Value] -> Node
forall a. ToAsdf a => a -> Node
toNode [Key -> Value
String Key
"em.wl"])
      , (Key
"unit", [Unit] -> Node
forall a. ToAsdf a => a -> Node
toNode [Unit
Nanometers])
      ]


data CelestialFrame = CelestialFrame
  { CelestialFrame -> Key
name :: Text
  , CelestialFrame -> NonEmpty FrameAxis
axes :: NonEmpty FrameAxis
  , CelestialFrame -> ICRSFrame
referenceFrame :: ICRSFrame
  }
instance ToAsdf CelestialFrame where
  schema :: CelestialFrame -> SchemaTag
schema CelestialFrame
_ = SchemaTag
"tag:stsci.edu:gwcs/celestial_frame-1.0.0"
  toValue :: CelestialFrame -> Value
toValue CelestialFrame
f =
    Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$
      [ (Key
"name", Key -> Node
forall a. ToAsdf a => a -> Node
toNode CelestialFrame
f.name)
      , (Key
"reference_frame", ICRSFrame -> Node
forall a. ToAsdf a => a -> Node
toNode CelestialFrame
f.referenceFrame)
      ]
        Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> NonEmpty FrameAxis -> Object
frameAxesObject CelestialFrame
f.axes


frameAxesObject :: NonEmpty FrameAxis -> Object
frameAxesObject :: NonEmpty FrameAxis -> Object
frameAxesObject NonEmpty FrameAxis
as =
  -- doesn't include axes_type, only on CoorindateFrame
  [ (Key
"naxes", Int -> Node
forall a. ToAsdf a => a -> Node
toNode (Int -> Node) -> Int -> Node
forall a b. (a -> b) -> a -> b
$ NonEmpty FrameAxis -> Int
forall a. NonEmpty a -> Int
NE.length NonEmpty FrameAxis
as)
  , (Key
"axes_names", NonEmpty AxisName -> Node
forall a. ToAsdf a => a -> Node
toNode NonEmpty AxisName
axesNames)
  , (Key
"axes_order", NonEmpty Int -> Node
forall a. ToAsdf a => a -> Node
toNode NonEmpty Int
axesOrders)
  , (Key
"axes_physical_types", NonEmpty Value -> Node
forall a. ToAsdf a => a -> Node
toNode NonEmpty Value
axesPhysicalTypes)
  , (Key
"unit", NonEmpty Unit -> Node
forall a. ToAsdf a => a -> Node
toNode NonEmpty Unit
units)
  ]
 where
  axesNames :: NonEmpty AxisName
axesNames = (FrameAxis -> AxisName) -> NonEmpty FrameAxis -> NonEmpty AxisName
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (.axisName) NonEmpty FrameAxis
as
  axesOrders :: NonEmpty Int
axesOrders = (FrameAxis -> Int) -> NonEmpty FrameAxis -> NonEmpty Int
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (.axisOrder) NonEmpty FrameAxis
as
  axesPhysicalTypes :: NonEmpty Value
axesPhysicalTypes = (FrameAxis -> Value) -> NonEmpty FrameAxis -> NonEmpty Value
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (AxisType -> Value
forall a. ToAsdf a => a -> Value
physicalType (AxisType -> Value)
-> (FrameAxis -> AxisType) -> FrameAxis -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.axisType)) NonEmpty FrameAxis
as
  units :: NonEmpty Unit
units = (FrameAxis -> Unit) -> NonEmpty FrameAxis -> NonEmpty Unit
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (.unit) NonEmpty FrameAxis
as
  physicalType :: a -> Value
physicalType a
t = Key -> Value
String Key
"custom:" Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> a -> Value
forall a. ToAsdf a => a -> Value
toValue a
t


-- numAxes = NE.length as

data ICRSFrame = ICRSFrame
instance ToAsdf ICRSFrame where
  schema :: ICRSFrame -> SchemaTag
schema ICRSFrame
_ = SchemaTag
"tag:astropy.org:astropy/coordinates/frames/icrs-1.1.0"
  toValue :: ICRSFrame -> Value
toValue ICRSFrame
_ = Object -> Value
Object [(Key
"frame_attributes", Value -> Node
forall a. ToAsdf a => a -> Node
toNode (Value -> Node) -> Value -> Node
forall a b. (a -> b) -> a -> b
$ Object -> Value
Object Object
forall a. Monoid a => a
mempty)]


data FrameAxis = FrameAxis
  { FrameAxis -> Int
axisOrder :: Int
  , FrameAxis -> AxisName
axisName :: AxisName
  , FrameAxis -> AxisType
axisType :: AxisType
  , FrameAxis -> Unit
unit :: Unit
  }


data CompositeFrame as = CompositeFrame as
instance (ToAsdf as) => ToAsdf (CompositeFrame as) where
  schema :: CompositeFrame as -> SchemaTag
schema CompositeFrame as
_ = SchemaTag
"tag:stsci.edu:gwcs/composite_frame-1.0.0"
  toValue :: CompositeFrame as -> Value
toValue (CompositeFrame as
as) =
    Object -> Value
Object
      [ (Key
"name", Value -> Node
forall a. ToAsdf a => a -> Node
toNode (Value -> Node) -> Value -> Node
forall a b. (a -> b) -> a -> b
$ Key -> Value
String Key
"CompositeFrame")
      , (Key
"frames", as -> Node
forall a. ToAsdf a => a -> Node
toNode as
as)
      ]


-- ToAxes -----------------------------------------------

{- | Convert a type to named axes

> data X deriving (Generic, ToAxes)
> data Y
> instance ToAxes Y where
>   toAxes = ["y"]
-}
class ToAxes (as :: Type) where
  toAxes :: [AxisName]
  default toAxes :: (Generic as, GTypeName (Rep as)) => [AxisName]
  toAxes = [Key -> AxisName
AxisName (Key -> AxisName) -> Key -> AxisName
forall a b. (a -> b) -> a -> b
$ String -> Key
pack (String -> Key) -> String -> Key
forall a b. (a -> b) -> a -> b
$ Rep as Any -> String
forall p. Rep as p -> String
forall {k} (f :: k -> *) (p :: k). GTypeName f => f p -> String
gtypeName (as -> Rep as Any
forall x. as -> Rep as x
forall a x. Generic a => a -> Rep a x
from (as
forall a. HasCallStack => a
undefined :: as))]


instance ToAxes () where
  toAxes :: [AxisName]
toAxes = []
instance (ToAxes a, ToAxes b) => ToAxes (a, b) where
  toAxes :: [AxisName]
toAxes = [[AxisName]] -> [AxisName]
forall a. Monoid a => [a] -> a
mconcat [forall a. ToAxes a => [AxisName]
toAxes @a, forall a. ToAxes a => [AxisName]
toAxes @b]
instance (ToAxes a, ToAxes b, ToAxes c) => ToAxes (a, b, c) where
  toAxes :: [AxisName]
toAxes = [[AxisName]] -> [AxisName]
forall a. Monoid a => [a] -> a
mconcat [forall a. ToAxes a => [AxisName]
toAxes @a, forall a. ToAxes a => [AxisName]
toAxes @b, forall a. ToAxes a => [AxisName]
toAxes @c]
instance (ToAxes a, ToAxes b, ToAxes c, ToAxes d) => ToAxes (a, b, c, d) where
  toAxes :: [AxisName]
toAxes = [[AxisName]] -> [AxisName]
forall a. Monoid a => [a] -> a
mconcat [forall a. ToAxes a => [AxisName]
toAxes @a, forall a. ToAxes a => [AxisName]
toAxes @b, forall a. ToAxes a => [AxisName]
toAxes @c, forall a. ToAxes a => [AxisName]
toAxes @d]


-- Transforms -----------------------------------------------

shift :: forall a f. (ToAxes (f a), ToAxes (Shift a)) => Float -> Transform (f a) (Shift a)
shift :: forall {k} (a :: k) (f :: k -> *).
(ToAxes (f a), ToAxes (Shift a)) =>
Float -> Transform (f a) (Shift a)
shift Float
d = Shift Any -> Transform (f a) (Shift a)
forall a bs cs.
(ToAsdf a, ToAxes bs, ToAxes cs) =>
a -> Transform bs cs
transform (Shift Any -> Transform (f a) (Shift a))
-> Shift Any -> Transform (f a) (Shift a)
forall a b. (a -> b) -> a -> b
$ Float -> Shift Any
forall {k} (a :: k). Float -> Shift a
Shift Float
d


scale :: forall a f. (ToAxes (f a), ToAxes (Scale a)) => Float -> Transform (f a) (Scale a)
scale :: forall {k} (a :: k) (f :: k -> *).
(ToAxes (f a), ToAxes (Scale a)) =>
Float -> Transform (f a) (Scale a)
scale Float
d = Scale Any -> Transform (f a) (Scale a)
forall a bs cs.
(ToAsdf a, ToAxes bs, ToAxes cs) =>
a -> Transform bs cs
transform (Scale Any -> Transform (f a) (Scale a))
-> Scale Any -> Transform (f a) (Scale a)
forall a b. (a -> b) -> a -> b
$ Float -> Scale Any
forall {k} (a :: k). Float -> Scale a
Scale Float
d


linear :: forall a. (ToAxes a) => Intercept -> Scale a -> Transform (Pix a) (Linear a)
linear :: forall a.
ToAxes a =>
Intercept -> Scale a -> Transform (Pix a) (Linear a)
linear (Intercept Float
dlt) (Scale Float
scl) = Linear Any -> Transform (Pix a) (Linear a)
forall a bs cs.
(ToAsdf a, ToAxes bs, ToAxes cs) =>
a -> Transform bs cs
transform (Linear Any -> Transform (Pix a) (Linear a))
-> Linear Any -> Transform (Pix a) (Linear a)
forall a b. (a -> b) -> a -> b
$ Linear1d{intercept :: Float
intercept = Float
dlt, slope :: Float
slope = Float
scl}


rotate :: (ToAxes x, ToAxes y) => Array M.D Ix2 Float -> Transform (Linear x, Linear y) (Rot (x, y))
rotate :: forall x y.
(ToAxes x, ToAxes y) =>
Array D Ix2 Float -> Transform (Linear x, Linear y) (Rot (x, y))
rotate Array D Ix2 Float
arr =
  Affine -> Transform (Linear x, Linear y) (Rot (x, y))
forall a bs cs.
(ToAsdf a, ToAxes bs, ToAxes cs) =>
a -> Transform bs cs
transform (Affine -> Transform (Linear x, Linear y) (Rot (x, y)))
-> Affine -> Transform (Linear x, Linear y) (Rot (x, y))
forall a b. (a -> b) -> a -> b
$ Array D Ix2 Float -> (Float, Float) -> Affine
Affine Array D Ix2 Float
arr (Float
0, Float
0)


project :: (ToAxes x, ToAxes y) => Direction -> Transform (Rot (x, y)) (Phi, Theta)
project :: forall x y.
(ToAxes x, ToAxes y) =>
Direction -> Transform (Rot (x, y)) (Phi, Theta)
project Direction
dir =
  Projection -> Transform (Rot (x, y)) (Phi, Theta)
forall a bs cs.
(ToAsdf a, ToAxes bs, ToAxes cs) =>
a -> Transform bs cs
transform (Projection -> Transform (Rot (x, y)) (Phi, Theta))
-> Projection -> Transform (Rot (x, y)) (Phi, Theta)
forall a b. (a -> b) -> a -> b
$ Direction -> Projection
Projection Direction
dir


celestial :: Lat -> Lon -> LonPole -> Transform (Phi, Theta) (Alpha, Delta)
celestial :: Lat -> Lon -> LonPole -> Transform (Phi, Theta) (Alpha, Delta)
celestial Lat
lat Lon
lon LonPole
pole =
  Rotate3d -> Transform (Phi, Theta) (Alpha, Delta)
forall a bs cs.
(ToAsdf a, ToAxes bs, ToAxes cs) =>
a -> Transform bs cs
transform (Rotate3d -> Transform (Phi, Theta) (Alpha, Delta))
-> Rotate3d -> Transform (Phi, Theta) (Alpha, Delta)
forall a b. (a -> b) -> a -> b
$ Rotate3d{direction :: Direction
direction = Direction
Native2Celestial, theta :: Lat
theta = Lat
lat, phi :: Lon
phi = Lon
lon, psi :: LonPole
psi = LonPole
pole}


data Phi deriving ((forall x. Phi -> Rep Phi x)
-> (forall x. Rep Phi x -> Phi) -> Generic Phi
forall x. Rep Phi x -> Phi
forall x. Phi -> Rep Phi x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Phi -> Rep Phi x
from :: forall x. Phi -> Rep Phi x
$cto :: forall x. Rep Phi x -> Phi
to :: forall x. Rep Phi x -> Phi
Generic, [AxisName]
[AxisName] -> ToAxes Phi
forall as. [AxisName] -> ToAxes as
$ctoAxes :: [AxisName]
toAxes :: [AxisName]
ToAxes)
data Theta deriving ((forall x. Theta -> Rep Theta x)
-> (forall x. Rep Theta x -> Theta) -> Generic Theta
forall x. Rep Theta x -> Theta
forall x. Theta -> Rep Theta x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Theta -> Rep Theta x
from :: forall x. Theta -> Rep Theta x
$cto :: forall x. Rep Theta x -> Theta
to :: forall x. Rep Theta x -> Theta
Generic, [AxisName]
[AxisName] -> ToAxes Theta
forall as. [AxisName] -> ToAxes as
$ctoAxes :: [AxisName]
toAxes :: [AxisName]
ToAxes)
data Alpha deriving ((forall x. Alpha -> Rep Alpha x)
-> (forall x. Rep Alpha x -> Alpha) -> Generic Alpha
forall x. Rep Alpha x -> Alpha
forall x. Alpha -> Rep Alpha x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Alpha -> Rep Alpha x
from :: forall x. Alpha -> Rep Alpha x
$cto :: forall x. Rep Alpha x -> Alpha
to :: forall x. Rep Alpha x -> Alpha
Generic, [AxisName]
[AxisName] -> ToAxes Alpha
forall as. [AxisName] -> ToAxes as
$ctoAxes :: [AxisName]
toAxes :: [AxisName]
ToAxes)
data Delta deriving ((forall x. Delta -> Rep Delta x)
-> (forall x. Rep Delta x -> Delta) -> Generic Delta
forall x. Rep Delta x -> Delta
forall x. Delta -> Rep Delta x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Delta -> Rep Delta x
from :: forall x. Delta -> Rep Delta x
$cto :: forall x. Rep Delta x -> Delta
to :: forall x. Rep Delta x -> Delta
Generic, [AxisName]
[AxisName] -> ToAxes Delta
forall as. [AxisName] -> ToAxes as
$ctoAxes :: [AxisName]
toAxes :: [AxisName]
ToAxes)


identity :: (ToAxes bs, ToAxes cs) => Transform bs cs
identity :: forall bs cs. (ToAxes bs, ToAxes cs) => Transform bs cs
identity = Identity -> Transform bs cs
forall a bs cs.
(ToAsdf a, ToAxes bs, ToAxes cs) =>
a -> Transform bs cs
transform Identity
Identity


-- WCS Transforms ---------------------------------------------------------

wcsLinear :: (ToAxes axis) => WCSAxis alt axis -> Transform (Pix axis) (Linear axis)
wcsLinear :: forall axis (alt :: WCSAlt).
ToAxes axis =>
WCSAxis alt axis -> Transform (Pix axis) (Linear axis)
wcsLinear WCSAxis alt axis
wcs = Intercept -> Scale axis -> Transform (Pix axis) (Linear axis)
forall a.
ToAxes a =>
Intercept -> Scale a -> Transform (Pix a) (Linear a)
linear (WCSAxis alt axis -> Intercept
forall {k} (alt :: WCSAlt) (axis :: k).
WCSAxis alt axis -> Intercept
wcsIntercept WCSAxis alt axis
wcs) (Float -> Scale axis
forall {k} (a :: k). Float -> Scale a
Scale WCSAxis alt axis
wcs.cdelt)


-- the Y intercept
wcsIntercept :: WCSAxis alt axis -> Intercept
wcsIntercept :: forall {k} (alt :: WCSAlt) (axis :: k).
WCSAxis alt axis -> Intercept
wcsIntercept WCSAxis alt axis
w =
  -- crpix is 1-indexed, need to switch to zero
  Float -> Intercept
Intercept (Float -> Intercept) -> Float -> Intercept
forall a b. (a -> b) -> a -> b
$ WCSAxis alt axis
w.crval Float -> Float -> Float
forall a. Num a => a -> a -> a
- WCSAxis alt axis
w.cdelt Float -> Float -> Float
forall a. Num a => a -> a -> a
* (WCSAxis alt axis
w.crpix Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
1)


-- | Generic NodeName
class GTypeName f where
  gtypeName :: f p -> String


instance (Datatype d) => GTypeName (D1 d f) where
  gtypeName :: forall (p :: k). D1 d f p -> String
gtypeName = M1 D d f p -> String
forall {k} (d :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Datatype d =>
t d f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t d f a -> String
datatypeName


type family TConcat a b where
  TConcat (a, b, c) d = (a, b, c, d)
  TConcat a (b, c, d) = (a, b, c, d)
  TConcat (a, b) (c, d) = (a, b, c, d)
  TConcat (a, b) c = (a, b, c)
  TConcat a (b, c) = (a, b, c)
  TConcat a b = (a, b)