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

module Telescope.Asdf.GWCS where

import Data.Foldable (toList)
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 Data.Time.LocalTime (LocalTime)
import Effectful
import GHC.Generics
import Telescope.Asdf
import Telescope.Asdf.Core
import Telescope.Data.Parser
import Telescope.Data.WCS (WCSAxis (..))
import Text.Casing (quietSnake)


-- | 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])
      ]


instance (FromAsdf inp, FromAsdf out) => FromAsdf (GWCS inp out) where
  parseValue :: forall (es :: [Effect]).
(Parser :> es) =>
Value -> Eff es (GWCS inp out)
parseValue = \case
    Object Object
o -> do
      [Value]
steps :: [Value] <- Object
o Object -> Key -> Eff es [Value]
forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
Object -> Key -> Eff es a
.: Key
"steps"
      case [Value]
steps of
        [Value
inpv, Value
outv] -> do
          GWCSStep inp
inp <- Value -> Eff es (GWCSStep inp)
forall (es :: [Effect]).
(Parser :> es) =>
Value -> Eff es (GWCSStep inp)
forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
Value -> Eff es a
parseValue Value
inpv
          GWCSStep out
out <- Value -> Eff es (GWCSStep out)
forall (es :: [Effect]).
(Parser :> es) =>
Value -> Eff es (GWCSStep out)
forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
Value -> Eff es a
parseValue Value
outv
          GWCS inp out -> Eff es (GWCS inp out)
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GWCS inp out -> Eff es (GWCS inp out))
-> GWCS inp out -> Eff es (GWCS inp out)
forall a b. (a -> b) -> a -> b
$ GWCSStep inp -> GWCSStep out -> GWCS inp out
forall inp out. GWCSStep inp -> GWCSStep out -> GWCS inp out
GWCS GWCSStep inp
inp GWCSStep out
out
        [Value]
other -> String -> [Value] -> Eff es (GWCS inp out)
forall value (es :: [Effect]) a.
(Show value, Parser :> es) =>
String -> value -> Eff es a
expected String
"GWCS steps: [input,output]" [Value]
other
    Value
val -> String -> Value -> Eff es (GWCS inp out)
forall value (es :: [Effect]) a.
(Show value, Parser :> es) =>
String -> value -> Eff es a
expected String
"GWCS" Value
val


-- | 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, Int -> GWCSStep frame -> ShowS
[GWCSStep frame] -> ShowS
GWCSStep frame -> String
(Int -> GWCSStep frame -> ShowS)
-> (GWCSStep frame -> String)
-> ([GWCSStep frame] -> ShowS)
-> Show (GWCSStep frame)
forall frame. Show frame => Int -> GWCSStep frame -> ShowS
forall frame. Show frame => [GWCSStep frame] -> ShowS
forall frame. Show frame => GWCSStep frame -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall frame. Show frame => Int -> GWCSStep frame -> ShowS
showsPrec :: Int -> GWCSStep frame -> ShowS
$cshow :: forall frame. Show frame => GWCSStep frame -> String
show :: GWCSStep frame -> String
$cshowList :: forall frame. Show frame => [GWCSStep frame] -> ShowS
showList :: [GWCSStep frame] -> ShowS
Show)


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


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, (forall (es :: [Effect]).
 (Parser :> es) =>
 Value -> Eff es AxisName)
-> (forall (es :: [Effect]).
    (Parser :> es) =>
    Node -> Eff es AxisName)
-> FromAsdf AxisName
forall (es :: [Effect]). (Parser :> es) => Value -> Eff es AxisName
forall (es :: [Effect]). (Parser :> es) => Node -> Eff es AxisName
forall a.
(forall (es :: [Effect]). (Parser :> es) => Value -> Eff es a)
-> (forall (es :: [Effect]). (Parser :> es) => Node -> Eff es a)
-> FromAsdf a
$cparseValue :: forall (es :: [Effect]). (Parser :> es) => Value -> Eff es AxisName
parseValue :: forall (es :: [Effect]). (Parser :> es) => Value -> Eff es AxisName
$cparseNode :: forall (es :: [Effect]). (Parser :> es) => Node -> Eff es AxisName
parseNode :: forall (es :: [Effect]). (Parser :> es) => Node -> Eff es AxisName
FromAsdf, 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 Double
  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 Double
  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 Double
  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 = Forward -> SchemaTag
forall a. ToAsdf a => a -> SchemaTag
schema Transformation
t.forward
  toValue :: Transformation -> Value
toValue Transformation
t =
    Forward -> Value
forall a. ToAsdf a => a -> Value
toValue Transformation
t.forward
      Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> 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)
        ]


instance FromAsdf Transformation where
  parseNode :: forall (es :: [Effect]).
(Parser :> es) =>
Node -> Eff es Transformation
parseNode (Node SchemaTag
sch Maybe Anchor
_ Value
val) = do
    case Value
val of
      Object Object
o -> do
        [AxisName]
inps <- Object
o Object -> Key -> Eff es [AxisName]
forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
Object -> Key -> Eff es a
.: Key
"inputs"
        [AxisName]
outs <- Object
o Object -> Key -> Eff es [AxisName]
forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
Object -> Key -> Eff es a
.: Key
"outputs"
        Forward
frwd <- Node -> Eff es Forward
forall (es :: [Effect]). (Parser :> es) => Node -> Eff es Forward
forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
Node -> Eff es a
parseNode (SchemaTag -> Maybe Anchor -> Value -> Node
Node SchemaTag
sch Maybe Anchor
forall a. Maybe a
Nothing (Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ ((Key, Node) -> Bool) -> Object -> Object
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ((Key, Node) -> Bool) -> (Key, Node) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key, Node) -> Bool
forall {a} {b}. (Eq a, IsString a) => (a, b) -> Bool
isDirectKey) Object
o))
        Transformation -> Eff es Transformation
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Transformation -> Eff es Transformation)
-> Transformation -> Eff es Transformation
forall a b. (a -> b) -> a -> b
$ [AxisName] -> [AxisName] -> Forward -> Transformation
Transformation [AxisName]
inps [AxisName]
outs Forward
frwd
      Value
other -> String -> Value -> Eff es Transformation
forall value (es :: [Effect]) a.
(Show value, Parser :> es) =>
String -> value -> Eff es a
expected String
"Transformation" Value
other
   where
    isDirectKey :: (a, b) -> Bool
isDirectKey (a
k, b
_) =
      a
k a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"inputs" Bool -> Bool -> Bool
|| a
k a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"outputs"


  -- parse a direct forward transformation using the logic defined in parseNode
  parseValue :: forall (es :: [Effect]).
(Parser :> es) =>
Value -> Eff es Transformation
parseValue Value
val = Node -> Eff es Transformation
forall (es :: [Effect]).
(Parser :> es) =>
Node -> Eff es Transformation
forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
Node -> Eff es a
parseNode (SchemaTag -> Maybe Anchor -> Value -> Node
Node SchemaTag
forall a. Monoid a => a
mempty Maybe Anchor
forall a. Maybe a
Nothing Value
val)


data Forward
  = Compose Transformation Transformation
  | Concat Transformation Transformation
  | Direct Node
  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)


instance ToAsdf Forward where
  schema :: Forward -> SchemaTag
schema (Compose Transformation
_ Transformation
_) = SchemaTag
"!transform/compose-1.2.0"
  schema (Concat Transformation
_ Transformation
_) = SchemaTag
"!transform/concatenate-1.2.0"
  schema (Direct Node
node) = Node
node.schema


  toValue :: Forward -> Value
toValue = \case
    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 Node
node -> Node
node.value


instance FromAsdf Forward where
  parseNode :: forall (es :: [Effect]). (Parser :> es) => Node -> Eff es Forward
parseNode (Node SchemaTag
sch Maybe Anchor
_ Value
val) = do
    case SchemaTag
sch of
      SchemaTag
"!transform/compose-1.2.0" -> Value -> Eff es Forward
forall (es :: [Effect]). (Parser :> es) => Value -> Eff es Forward
parseCompose Value
val
      SchemaTag
"!transform/concatenate-1.2.0" -> Value -> Eff es Forward
forall (es :: [Effect]). (Parser :> es) => Value -> Eff es Forward
parseConcat Value
val
      SchemaTag
_ -> SchemaTag -> Value -> Eff es Forward
forall (es :: [Effect]).
(Parser :> es) =>
SchemaTag -> Value -> Eff es Forward
parseDirect SchemaTag
sch Value
val


  parseValue :: forall (es :: [Effect]). (Parser :> es) => Value -> Eff es Forward
parseValue Value
v =
    -- parse it blindly: compose and concat might match the same one!
    Eff es Forward -> Eff (NonDet : es) Forward -> Eff es Forward
forall (es :: [Effect]) a.
(Parser :> es) =>
Eff es a -> Eff (NonDet : es) a -> Eff es a
runParserAlts (String -> Value -> Eff es Forward
forall value (es :: [Effect]) a.
(Show value, Parser :> es) =>
String -> value -> Eff es a
expected String
"Forward" Value
v) (Eff (NonDet : es) Forward -> Eff es Forward)
-> Eff (NonDet : es) Forward -> Eff es Forward
forall a b. (a -> b) -> a -> b
$ do
      Eff (Parser : Error ParseError : NonDet : es) Forward
-> Eff (NonDet : es) Forward
forall (es :: [Effect]) a.
(NonDet :> es, Parser :> es) =>
Eff (Parser : Error ParseError : es) a -> Eff es a
tryParserEmpty (Value -> Eff (Parser : Error ParseError : NonDet : es) Forward
forall (es :: [Effect]). (Parser :> es) => Value -> Eff es Forward
parseCompose Value
v) Eff (NonDet : es) Forward
-> Eff (NonDet : es) Forward -> Eff (NonDet : es) Forward
forall a.
Eff (NonDet : es) a -> Eff (NonDet : es) a -> Eff (NonDet : es) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Eff (Parser : Error ParseError : NonDet : es) Forward
-> Eff (NonDet : es) Forward
forall (es :: [Effect]) a.
(NonDet :> es, Parser :> es) =>
Eff (Parser : Error ParseError : es) a -> Eff es a
tryParserEmpty (Value -> Eff (Parser : Error ParseError : NonDet : es) Forward
forall (es :: [Effect]). (Parser :> es) => Value -> Eff es Forward
parseConcat Value
v) Eff (NonDet : es) Forward
-> Eff (NonDet : es) Forward -> Eff (NonDet : es) Forward
forall a.
Eff (NonDet : es) a -> Eff (NonDet : es) a -> Eff (NonDet : es) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Eff (Parser : Error ParseError : NonDet : es) Forward
-> Eff (NonDet : es) Forward
forall (es :: [Effect]) a.
(NonDet :> es, Parser :> es) =>
Eff (Parser : Error ParseError : es) a -> Eff es a
tryParserEmpty (SchemaTag
-> Value -> Eff (Parser : Error ParseError : NonDet : es) Forward
forall (es :: [Effect]).
(Parser :> es) =>
SchemaTag -> Value -> Eff es Forward
parseDirect SchemaTag
"..." Value
v)


parseCompose :: (Parser :> es) => Value -> Eff es Forward
parseCompose :: forall (es :: [Effect]). (Parser :> es) => Value -> Eff es Forward
parseCompose = \case
  Object Object
o -> do
    [Transformation]
res <- Object
o Object -> Key -> Eff es [Transformation]
forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
Object -> Key -> Eff es a
.: Key
"forward"
    case [Transformation]
res of
      [Transformation
a, Transformation
b] -> Forward -> Eff es Forward
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Forward -> Eff es Forward) -> Forward -> Eff es Forward
forall a b. (a -> b) -> a -> b
$ Transformation -> Transformation -> Forward
Compose Transformation
a Transformation
b
      [Transformation]
fwd -> String -> [Transformation] -> Eff es Forward
forall value (es :: [Effect]) a.
(Show value, Parser :> es) =>
String -> value -> Eff es a
expected String
"Compose a b" [Transformation]
fwd
  Value
val -> String -> Value -> Eff es Forward
forall value (es :: [Effect]) a.
(Show value, Parser :> es) =>
String -> value -> Eff es a
expected String
"Compose a b" Value
val


parseConcat :: (Parser :> es) => Value -> Eff es Forward
parseConcat :: forall (es :: [Effect]). (Parser :> es) => Value -> Eff es Forward
parseConcat = \case
  Object Object
o -> do
    [Transformation]
res <- Object
o Object -> Key -> Eff es [Transformation]
forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
Object -> Key -> Eff es a
.: Key
"forward"
    case [Transformation]
res of
      [Transformation
a, Transformation
b] -> Forward -> Eff es Forward
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Forward -> Eff es Forward) -> Forward -> Eff es Forward
forall a b. (a -> b) -> a -> b
$ Transformation -> Transformation -> Forward
Concat Transformation
a Transformation
b
      [Transformation]
fwd -> String -> [Transformation] -> Eff es Forward
forall value (es :: [Effect]) a.
(Show value, Parser :> es) =>
String -> value -> Eff es a
expected String
"Concat a b" [Transformation]
fwd
  Value
val -> String -> Value -> Eff es Forward
forall value (es :: [Effect]) a.
(Show value, Parser :> es) =>
String -> value -> Eff es a
expected String
"Concat a b" Value
val


parseDirect :: (Parser :> es) => SchemaTag -> Value -> Eff es Forward
parseDirect :: forall (es :: [Effect]).
(Parser :> es) =>
SchemaTag -> Value -> Eff es Forward
parseDirect SchemaTag
sch Value
val = Forward -> Eff es Forward
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Forward -> Eff es Forward) -> Forward -> Eff es Forward
forall a b. (a -> b) -> a -> b
$ Node -> Forward
Direct (Node -> Forward) -> Node -> Forward
forall a b. (a -> b) -> a -> b
$ SchemaTag -> Maybe Anchor -> Value -> Node
Node SchemaTag
sch Maybe Anchor
forall a. Maybe a
Nothing Value
val


{- | 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
$ Node -> Forward
Direct (a -> Node
forall a. ToAsdf a => a -> Node
toNode 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 Double 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 Double 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 Double 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 Double
matrix :: Array M.D Ix2 Double, Affine -> (Double, Double)
translation :: (Double, Double)}
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)


-- TODO: this should be a quantity!
data Linear a = Linear1d {forall {k} (a :: k). Linear a -> Double
intercept :: Double, forall {k} (a :: k). Linear a -> Double
slope :: Double}
  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)
data Mapping = Mapping {Mapping -> [Int]
mapping :: [Int]}
data Const1D = Const1D Quantity


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 Double
d) =
    Object -> Value
Object [(Key
"offset", Double -> Node
forall a. ToAsdf a => a -> Node
toNode Double
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 Double
d) =
    Object -> Value
Object [(Key
"factor", Double -> Node
forall a. ToAsdf a => a -> Node
toNode Double
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 (Double
tx, Double
ty) = Affine
a.translation
     in Object -> Value
Object
          [ (Key
"matrix", [ListItem Ix2 Double] -> Node
forall a. ToAsdf a => a -> Node
toNode ([ListItem Ix2 Double] -> Node) -> [ListItem Ix2 Double] -> Node
forall a b. (a -> b) -> a -> b
$ Array D Ix2 Double -> [ListItem Ix2 Double]
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", [Double] -> Node
forall a. ToAsdf a => a -> Node
toNode [Double
tx, Double
ty])
          ]


instance ToAsdf Mapping where
  schema :: Mapping -> SchemaTag
schema Mapping
_ = SchemaTag
"!transform/remap_axes-1.3.0"
  toValue :: Mapping -> Value
toValue Mapping
m =
    Object -> Value
Object [(Key
"mapping", [Int] -> Node
forall a. ToAsdf a => a -> Node
toNode ([Int] -> Node) -> [Int] -> Node
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int]
forall a. [a] -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Mapping
m.mapping)]


instance ToAsdf Const1D where
  schema :: Const1D -> SchemaTag
schema Const1D
_ = SchemaTag
"!transform/constant-1.2.0"
  toValue :: Const1D -> Value
toValue (Const1D Quantity
q) =
    Object -> Value
Object
      [ (Key
"dimensions", Value -> Node
forall a. ToAsdf a => a -> Node
toNode (Value -> Node) -> Value -> Node
forall a b. (a -> b) -> a -> b
$ Integer -> Value
Integer Integer
1)
      , (Key
"value", Quantity -> Node
forall a. ToAsdf a => a -> Node
toNode Quantity
q)
      ]
instance FromAsdf Const1D where
  parseValue :: forall (es :: [Effect]). (Parser :> es) => Value -> Eff es Const1D
parseValue Value
val = do
    Object
o <- forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
Value -> Eff es a
parseValue @Object Value
val
    Quantity -> Const1D
Const1D (Quantity -> Const1D) -> Eff es Quantity -> Eff es Const1D
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Eff es Quantity
forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
Object -> Key -> Eff es a
.: Key
"value"


-- 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 TemporalFrame = TemporalFrame
  { TemporalFrame -> Key
name :: Text
  , TemporalFrame -> LocalTime
time :: LocalTime
  , TemporalFrame -> Int
axisOrder :: Int
  }
instance ToAsdf TemporalFrame where
  schema :: TemporalFrame -> SchemaTag
schema TemporalFrame
_ = SchemaTag
"tag:stsci.edu:gwcs/temporal_frame-1.0.0"
  toValue :: TemporalFrame -> Value
toValue TemporalFrame
f =
    Object -> Value
Object
      [ (Key
"name", Key -> Node
forall a. ToAsdf a => a -> Node
toNode TemporalFrame
f.name)
      , (Key
"axis_names", [Value] -> Node
forall a. ToAsdf a => a -> Node
toNode [Key -> Value
String Key
"time"])
      , (Key
"axes_order", [Int] -> Node
forall a. ToAsdf a => a -> Node
toNode [TemporalFrame
f.axisOrder])
      , (Key
"axis_physical_types", [Value] -> Node
forall a. ToAsdf a => a -> Node
toNode [Key -> Value
String Key
"time"])
      , (Key
"reference_frame", LocalTime -> Node
forall a. ToAsdf a => a -> Node
toNode TemporalFrame
f.time)
      , (Key
"unit", [Unit] -> Node
forall a. ToAsdf a => a -> Node
toNode [Unit
Seconds])
      ]


data CelestialFrame ref = CelestialFrame
  { forall ref. CelestialFrame ref -> Key
name :: Text
  , forall ref. CelestialFrame ref -> NonEmpty FrameAxis
axes :: NonEmpty FrameAxis
  , forall ref. CelestialFrame ref -> ref
referenceFrame :: ref
  }
instance (ToAsdf ref) => ToAsdf (CelestialFrame ref) where
  schema :: CelestialFrame ref -> SchemaTag
schema CelestialFrame ref
_ = SchemaTag
"tag:stsci.edu:gwcs/celestial_frame-1.0.0"
  toValue :: CelestialFrame ref -> Value
toValue CelestialFrame ref
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 ref
f.name)
      , (Key
"reference_frame", ref -> Node
forall a. ToAsdf a => a -> Node
toNode CelestialFrame ref
f.referenceFrame)
      ]
        Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> NonEmpty FrameAxis -> Object
frameAxesObject CelestialFrame ref
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
"axis_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
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 :: AxisType -> Value
physicalType = AxisType -> Value
forall a. ToAsdf a => a -> Value
toValue


-- 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 HelioprojectiveFrame = HelioprojectiveFrame
  { HelioprojectiveFrame -> Cartesian3D
coordinates :: Cartesian3D
  , HelioprojectiveFrame -> HelioObservation
observation :: HelioObservation
  }
instance ToAsdf HelioprojectiveFrame where
  schema :: HelioprojectiveFrame -> SchemaTag
schema HelioprojectiveFrame
_ = SchemaTag
"tag:sunpy.org:sunpy/coordinates/frames/helioprojective-1.0.0"
  toValue :: HelioprojectiveFrame -> Value
toValue HelioprojectiveFrame
frame =
    Object -> Value
Object
      [(Key
"frame_attributes", Value -> Node
fromValue Value
attributes)]
   where
    observer :: HelioObserver
observer = CartesianRepresentation Cartesian3D
-> HelioObservation -> HelioObserver
HelioObserver (Cartesian3D -> CartesianRepresentation Cartesian3D
forall dims. dims -> CartesianRepresentation dims
CartesianRepresentation HelioprojectiveFrame
frame.coordinates) HelioprojectiveFrame
frame.observation
    attributes :: Value
attributes =
      Object -> Value
Object [(Key
"observer", HelioObserver -> Node
forall a. ToAsdf a => a -> Node
toNode HelioObserver
observer)] Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> HelioObservation -> Value
forall a. ToAsdf a => a -> Value
toValue HelioprojectiveFrame
frame.observation
instance FromAsdf HelioprojectiveFrame where
  parseValue :: forall (es :: [Effect]).
(Parser :> es) =>
Value -> Eff es HelioprojectiveFrame
parseValue = \case
    Object Object
o -> do
      Object
atts :: Object <- Object
o Object -> Key -> Eff es Object
forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
Object -> Key -> Eff es a
.: Key
"frame_attributes"
      HelioObserver
observer :: HelioObserver <- Object
atts Object -> Key -> Eff es HelioObserver
forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
Object -> Key -> Eff es a
.: Key
"observer"
      HelioObservation
observation <- Value -> Eff es HelioObservation
forall (es :: [Effect]).
(Parser :> es) =>
Value -> Eff es HelioObservation
forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
Value -> Eff es a
parseValue (Object -> Value
Object Object
atts)
      let CartesianRepresentation Cartesian3D
coords = HelioObserver
observer.coordinates
      HelioprojectiveFrame -> Eff es HelioprojectiveFrame
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HelioprojectiveFrame -> Eff es HelioprojectiveFrame)
-> HelioprojectiveFrame -> Eff es HelioprojectiveFrame
forall a b. (a -> b) -> a -> b
$ Cartesian3D -> HelioObservation -> HelioprojectiveFrame
HelioprojectiveFrame Cartesian3D
coords HelioObservation
observation
    Value
other -> String -> Value -> Eff es HelioprojectiveFrame
forall value (es :: [Effect]) a.
(Show value, Parser :> es) =>
String -> value -> Eff es a
expected String
"helioprojective frame" Value
other


-- reference_frame: !<tag:sunpy.org:sunpy/coordinates/frames/helioprojective-1.0.0>
--   frame_attributes:
--     observer: !<tag:sunpy.org:sunpy/coordinates/frames/heliographic_stonyhurst-1.1.0>
--       data: !<tag:astropy.org:astropy/coordinates/representation-1.0.0>
--         components:
--           x: !unit/quantity-1.1.0 {unit: !unit/unit-1.0.0 m, value: 151741639088.53842}
--           y: !unit/quantity-1.1.0 {unit: !unit/unit-1.0.0 m, value: 5050819.209579468}
--           z: !unit/quantity-1.1.0 {unit: !unit/unit-1.0.0 m, value: -968701275.8656464}
--         type: CartesianRepresentation
--       frame_attributes:
--         obstime: !time/time-1.1.0 2022-06-03T17:52:20.031
--         rsun: !unit/quantity-1.1.0 {unit: !unit/unit-1.0.0 km, value: 695700.0}
--     obstime: !time/time-1.1.0 2022-06-03T17:52:20.031
--     rsun: !unit/quantity-1.1.0 {unit: !unit/unit-1.0.0 km, value: 695700.0}

data HelioObserver = HelioObserver
  { HelioObserver -> CartesianRepresentation Cartesian3D
coordinates :: CartesianRepresentation Cartesian3D
  , HelioObserver -> HelioObservation
observation :: HelioObservation
  }
instance ToAsdf HelioObserver where
  --     observer: !<tag:sunpy.org:sunpy/coordinates/frames/heliographic_stonyhurst-1.1.0>
  --       data: !<tag:astropy.org:astropy/coordinates/representation-1.0.0>
  --         components:
  --           x: !unit/quantity-1.1.0 {unit: !unit/unit-1.0.0 m, value: 151741639088.53842}
  --           y: !unit/quantity-1.1.0 {unit: !unit/unit-1.0.0 m, value: 5050819.209579468}
  --           z: !unit/quantity-1.1.0 {unit: !unit/unit-1.0.0 m, value: -968701275.8656464}
  --         type: CartesianRepresentation
  --       frame_attributes:
  --         obstime: !time/time-1.1.0 2022-06-03T17:52:20.031
  --         rsun: !unit/quantity-1.1.0 {unit: !unit/unit-1.0.0 km, value: 695700.0}
  schema :: HelioObserver -> SchemaTag
schema HelioObserver
_ = SchemaTag
"tag:sunpy.org:sunpy/coordinates/frames/heliographic_stonyhurst-1.1.0"
  toValue :: HelioObserver -> Value
toValue HelioObserver
obs =
    Object -> Value
Object
      [ (Key
"data", CartesianRepresentation Cartesian3D -> Node
forall a. ToAsdf a => a -> Node
toNode HelioObserver
obs.coordinates)
      , (Key
"frame_attributes", HelioObservation -> Node
forall a. ToAsdf a => a -> Node
toNode HelioObserver
obs.observation)
      ]
instance FromAsdf HelioObserver where
  parseValue :: forall (es :: [Effect]).
(Parser :> es) =>
Value -> Eff es HelioObserver
parseValue = \case
    Object Object
o -> do
      CartesianRepresentation Cartesian3D
d <- Object
o Object -> Key -> Eff es (CartesianRepresentation Cartesian3D)
forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
Object -> Key -> Eff es a
.: Key
"data"
      HelioObservation
atts <- Object
o Object -> Key -> Eff es HelioObservation
forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
Object -> Key -> Eff es a
.: Key
"frame_attributes"
      HelioObserver -> Eff es HelioObserver
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HelioObserver -> Eff es HelioObserver)
-> HelioObserver -> Eff es HelioObserver
forall a b. (a -> b) -> a -> b
$ CartesianRepresentation Cartesian3D
-> HelioObservation -> HelioObserver
HelioObserver CartesianRepresentation Cartesian3D
d HelioObservation
atts
    Value
other -> String -> Value -> Eff es HelioObserver
forall value (es :: [Effect]) a.
(Show value, Parser :> es) =>
String -> value -> Eff es a
expected String
"Helioobserver" Value
other


data HelioObservation = HelioObservation
  { HelioObservation -> LocalTime
obstime :: LocalTime
  , HelioObservation -> Quantity
rsun :: Quantity
  }
  deriving ((forall x. HelioObservation -> Rep HelioObservation x)
-> (forall x. Rep HelioObservation x -> HelioObservation)
-> Generic HelioObservation
forall x. Rep HelioObservation x -> HelioObservation
forall x. HelioObservation -> Rep HelioObservation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HelioObservation -> Rep HelioObservation x
from :: forall x. HelioObservation -> Rep HelioObservation x
$cto :: forall x. Rep HelioObservation x -> HelioObservation
to :: forall x. Rep HelioObservation x -> HelioObservation
Generic, HelioObservation -> Maybe Anchor
HelioObservation -> Value
HelioObservation -> Node
HelioObservation -> SchemaTag
(HelioObservation -> Value)
-> (HelioObservation -> SchemaTag)
-> (HelioObservation -> Maybe Anchor)
-> (HelioObservation -> Node)
-> ToAsdf HelioObservation
forall a.
(a -> Value)
-> (a -> SchemaTag)
-> (a -> Maybe Anchor)
-> (a -> Node)
-> ToAsdf a
$ctoValue :: HelioObservation -> Value
toValue :: HelioObservation -> Value
$cschema :: HelioObservation -> SchemaTag
schema :: HelioObservation -> SchemaTag
$canchor :: HelioObservation -> Maybe Anchor
anchor :: HelioObservation -> Maybe Anchor
$ctoNode :: HelioObservation -> Node
toNode :: HelioObservation -> Node
ToAsdf, (forall (es :: [Effect]).
 (Parser :> es) =>
 Value -> Eff es HelioObservation)
-> (forall (es :: [Effect]).
    (Parser :> es) =>
    Node -> Eff es HelioObservation)
-> FromAsdf HelioObservation
forall (es :: [Effect]).
(Parser :> es) =>
Value -> Eff es HelioObservation
forall (es :: [Effect]).
(Parser :> es) =>
Node -> Eff es HelioObservation
forall a.
(forall (es :: [Effect]). (Parser :> es) => Value -> Eff es a)
-> (forall (es :: [Effect]). (Parser :> es) => Node -> Eff es a)
-> FromAsdf a
$cparseValue :: forall (es :: [Effect]).
(Parser :> es) =>
Value -> Eff es HelioObservation
parseValue :: forall (es :: [Effect]).
(Parser :> es) =>
Value -> Eff es HelioObservation
$cparseNode :: forall (es :: [Effect]).
(Parser :> es) =>
Node -> Eff es HelioObservation
parseNode :: forall (es :: [Effect]).
(Parser :> es) =>
Node -> Eff es HelioObservation
FromAsdf)


data Cartesian3D = Cartesian3D
  { Cartesian3D -> Quantity
x :: Quantity
  , Cartesian3D -> Quantity
y :: Quantity
  , Cartesian3D -> Quantity
z :: Quantity
  }
  deriving ((forall x. Cartesian3D -> Rep Cartesian3D x)
-> (forall x. Rep Cartesian3D x -> Cartesian3D)
-> Generic Cartesian3D
forall x. Rep Cartesian3D x -> Cartesian3D
forall x. Cartesian3D -> Rep Cartesian3D x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Cartesian3D -> Rep Cartesian3D x
from :: forall x. Cartesian3D -> Rep Cartesian3D x
$cto :: forall x. Rep Cartesian3D x -> Cartesian3D
to :: forall x. Rep Cartesian3D x -> Cartesian3D
Generic, Cartesian3D -> Maybe Anchor
Cartesian3D -> Value
Cartesian3D -> Node
Cartesian3D -> SchemaTag
(Cartesian3D -> Value)
-> (Cartesian3D -> SchemaTag)
-> (Cartesian3D -> Maybe Anchor)
-> (Cartesian3D -> Node)
-> ToAsdf Cartesian3D
forall a.
(a -> Value)
-> (a -> SchemaTag)
-> (a -> Maybe Anchor)
-> (a -> Node)
-> ToAsdf a
$ctoValue :: Cartesian3D -> Value
toValue :: Cartesian3D -> Value
$cschema :: Cartesian3D -> SchemaTag
schema :: Cartesian3D -> SchemaTag
$canchor :: Cartesian3D -> Maybe Anchor
anchor :: Cartesian3D -> Maybe Anchor
$ctoNode :: Cartesian3D -> Node
toNode :: Cartesian3D -> Node
ToAsdf, (forall (es :: [Effect]).
 (Parser :> es) =>
 Value -> Eff es Cartesian3D)
-> (forall (es :: [Effect]).
    (Parser :> es) =>
    Node -> Eff es Cartesian3D)
-> FromAsdf Cartesian3D
forall (es :: [Effect]).
(Parser :> es) =>
Value -> Eff es Cartesian3D
forall (es :: [Effect]).
(Parser :> es) =>
Node -> Eff es Cartesian3D
forall a.
(forall (es :: [Effect]). (Parser :> es) => Value -> Eff es a)
-> (forall (es :: [Effect]). (Parser :> es) => Node -> Eff es a)
-> FromAsdf a
$cparseValue :: forall (es :: [Effect]).
(Parser :> es) =>
Value -> Eff es Cartesian3D
parseValue :: forall (es :: [Effect]).
(Parser :> es) =>
Value -> Eff es Cartesian3D
$cparseNode :: forall (es :: [Effect]).
(Parser :> es) =>
Node -> Eff es Cartesian3D
parseNode :: forall (es :: [Effect]).
(Parser :> es) =>
Node -> Eff es Cartesian3D
FromAsdf)


data CartesianRepresentation dims = CartesianRepresentation dims
instance (ToAsdf dims) => ToAsdf (CartesianRepresentation dims) where
  -- data: !<tag:astropy.org:astropy/coordinates/representation-1.0.0>
  --   components:
  --     x: !unit/quantity-1.1.0 {unit: !unit/unit-1.0.0 m, value: 151741639088.53842}
  --     y: !unit/quantity-1.1.0 {unit: !unit/unit-1.0.0 m, value: 5050819.209579468}
  --     z: !unit/quantity-1.1.0 {unit: !unit/unit-1.0.0 m, value: -968701275.8656464}
  --   type: CartesianRepresentation
  schema :: CartesianRepresentation dims -> SchemaTag
schema CartesianRepresentation dims
_ = SchemaTag
"tag:astropy.org:astropy/coordinates/representation-1.0.0"
  toValue :: CartesianRepresentation dims -> Value
toValue (CartesianRepresentation dims
dims) =
    Object -> Value
Object [(Key
"components", dims -> Node
forall a. ToAsdf a => a -> Node
toNode dims
dims), (Key
"type", Node
"CartesianRepresentation")]
instance (FromAsdf dims) => FromAsdf (CartesianRepresentation dims) where
  parseValue :: forall (es :: [Effect]).
(Parser :> es) =>
Value -> Eff es (CartesianRepresentation dims)
parseValue = \case
    Object Object
o -> do
      dims -> CartesianRepresentation dims
forall dims. dims -> CartesianRepresentation dims
CartesianRepresentation (dims -> CartesianRepresentation dims)
-> Eff es dims -> Eff es (CartesianRepresentation dims)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Eff es dims
forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
Object -> Key -> Eff es a
.: Key
"components"
    Value
other -> String -> Value -> Eff es (CartesianRepresentation dims)
forall value (es :: [Effect]) a.
(Show value, Parser :> es) =>
String -> value -> Eff es a
expected String
"CartesianRepresentation" Value
other


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


data CompositeFrame as = CompositeFrame {forall as. CompositeFrame as -> as
frames :: 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)
      ]
instance (FromAsdf as) => FromAsdf (CompositeFrame as) where
  parseValue :: forall (es :: [Effect]).
(Parser :> es) =>
Value -> Eff es (CompositeFrame as)
parseValue = \case
    Object Object
o -> do
      as -> CompositeFrame as
forall as. as -> CompositeFrame as
CompositeFrame (as -> CompositeFrame as)
-> Eff es as -> Eff es (CompositeFrame as)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Eff es as
forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
Object -> Key -> Eff es a
.: Key
"name"
    Value
other -> String -> Value -> Eff es (CompositeFrame as)
forall value (es :: [Effect]) a.
(Show value, Parser :> es) =>
String -> value -> Eff es a
expected String
"CompositeFrame" Value
other


-- 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
$ ShowS
quietSnake ShowS -> ShowS
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]
instance (ToAxes a, ToAxes b, ToAxes c, ToAxes d, ToAxes e) => ToAxes (a, b, c, d, e) 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, forall a. ToAxes a => [AxisName]
toAxes @e]
instance (ToAxes a, ToAxes b, ToAxes c, ToAxes d, ToAxes e, ToAxes f) => ToAxes (a, b, c, d, e, f) 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, forall a. ToAxes a => [AxisName]
toAxes @e, forall a. ToAxes a => [AxisName]
toAxes @f]


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

shift :: forall a f. (ToAxes (f a), ToAxes (Shift a)) => Double -> Transform (f a) (Shift a)
shift :: forall {k} (a :: k) (f :: k -> *).
(ToAxes (f a), ToAxes (Shift a)) =>
Double -> Transform (f a) (Shift a)
shift Double
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
$ Double -> Shift Any
forall {k} (a :: k). Double -> Shift a
Shift Double
d


scale :: forall a f. (ToAxes (f a), ToAxes (Scale a)) => Double -> Transform (f a) (Scale a)
scale :: forall {k} (a :: k) (f :: k -> *).
(ToAxes (f a), ToAxes (Scale a)) =>
Double -> Transform (f a) (Scale a)
scale Double
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
$ Double -> Scale Any
forall {k} (a :: k). Double -> Scale a
Scale Double
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 Double
dlt) (Scale Double
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{$sel:intercept:Linear1d :: Double
intercept = Double
dlt, $sel:slope:Linear1d :: Double
slope = Double
scl}


rotate :: (ToAxes x, ToAxes y) => Array M.D Ix2 Double -> Transform (Linear x, Linear y) (Rot (x, y))
rotate :: forall x y.
(ToAxes x, ToAxes y) =>
Array D Ix2 Double -> Transform (Linear x, Linear y) (Rot (x, y))
rotate Array D Ix2 Double
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 Double -> (Double, Double) -> Affine
Affine Array D Ix2 Double
arr (Double
0, Double
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{$sel:direction:Rotate3d :: Direction
direction = Direction
Native2Celestial, $sel:theta:Rotate3d :: Lat
theta = Lat
lat, $sel:phi:Rotate3d :: Lon
phi = Lon
lon, $sel:psi:Rotate3d :: 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 a) => Transform a a
identity :: forall a. ToAxes a => Transform a a
identity = Identity -> Transform a a
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) (Double -> Scale axis
forall {k} (a :: k). Double -> 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
  Double -> Intercept
Intercept (Double -> Intercept) -> Double -> Intercept
forall a b. (a -> b) -> a -> b
$ WCSAxis alt axis
w.crval Double -> Double -> Double
forall a. Num a => a -> a -> a
- WCSAxis alt axis
w.cdelt Double -> Double -> Double
forall a. Num a => a -> a -> a
* (WCSAxis alt axis
w.crpix Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
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, e, f) = (a, b, c, d, e, f)
  TConcat (a, b) (c, d, e, f) = (a, b, c, d, e, f)
  TConcat (a, b, c) (d, e, f) = (a, b, c, d, e, f)
  TConcat (a, b, c, d) (e, f) = (a, b, c, d, e, f)
  TConcat (a, b, c, d, e) f = (a, b, c, d, e, f)
  TConcat a (b, c, d, e) = (a, b, c, d, e)
  TConcat (a, b) (c, d, e) = (a, b, c, d, e)
  TConcat (a, b, c) (d, e) = (a, b, c, d, e)
  TConcat (a, b, c, d) e = (a, b, c, d, e)
  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 () = a
  TConcat () b = b
  TConcat a b = (a, b)