Safe Haskell | None |
---|---|
Language | GHC2021 |
Synopsis
- data GWCS inp out = GWCS (GWCSStep inp) (GWCSStep out)
- data GWCSStep frame = GWCSStep {
- frame :: frame
- transform :: Maybe Transformation
- newtype AxisName = AxisName Text
- newtype AxisType = AxisType Text
- data Pix (a :: k)
- data Rot (a :: k)
- newtype Lon = Lon Float
- newtype Lat = Lat Float
- newtype LonPole = LonPole Float
- data Transformation = Transformation {}
- data Forward
- data Transform (b :: k) (c :: k1) = Transform {}
- transform :: (ToAsdf a, ToAxes bs, ToAxes cs) => a -> Transform bs cs
- (|>) :: forall {k} b (c :: k) d. (ToAxes b, ToAxes d) => Transform b c -> Transform c d -> Transform b d
- (<&>) :: 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)
- data Direction
- data Shift (a :: k) = Shift Float
- data Scale (a :: k) = Scale Float
- data Identity = Identity
- data Intercept = Intercept Float
- data Affine = Affine {}
- data Projection = Projection Direction
- data Rotate3d = Rotate3d {}
- data Linear (a :: k) = Linear1d {}
- data CoordinateFrame = CoordinateFrame {}
- data StokesFrame = StokesFrame {}
- data SpectralFrame = SpectralFrame {}
- data CelestialFrame = CelestialFrame {}
- frameAxesObject :: NonEmpty FrameAxis -> Object
- data ICRSFrame = ICRSFrame
- data FrameAxis = FrameAxis {}
- data CompositeFrame as = CompositeFrame as
- class ToAxes as where
- shift :: forall {k} (a :: k) f. (ToAxes (f a), ToAxes (Shift a)) => Float -> Transform (f a) (Shift a)
- scale :: forall {k} (a :: k) f. (ToAxes (f a), ToAxes (Scale a)) => Float -> Transform (f a) (Scale a)
- linear :: ToAxes a => Intercept -> Scale a -> Transform (Pix a) (Linear a)
- rotate :: (ToAxes x, ToAxes y) => Array D Ix2 Float -> Transform (Linear x, Linear y) (Rot (x, y))
- project :: (ToAxes x, ToAxes y) => Direction -> Transform (Rot (x, y)) (Phi, Theta)
- celestial :: Lat -> Lon -> LonPole -> Transform (Phi, Theta) (Alpha, Delta)
- data Phi
- data Theta
- data Alpha
- data Delta
- identity :: (ToAxes bs, ToAxes cs) => Transform bs cs
- wcsLinear :: forall axis (alt :: WCSAlt). ToAxes axis => WCSAxis alt axis -> Transform (Pix axis) (Linear axis)
- wcsIntercept :: forall {k} (alt :: WCSAlt) (axis :: k). WCSAxis alt axis -> Intercept
- class GTypeName (f :: k -> Type) where
- type family TConcat a b where ...
Documentation
GWCS pipelines consist of an input and output GWCSStep
A step contains a frame (like CelestialFrame
) and a 'Transform a b'
GWCSStep | |
|
Instances
Generic (GWCSStep frame) Source # | |||||
Defined in Telescope.Asdf.GWCS
| |||||
ToAsdf frame => ToAsdf (GWCSStep frame) Source # | |||||
type Rep (GWCSStep frame) Source # | |||||
Defined in Telescope.Asdf.GWCS type Rep (GWCSStep frame) = D1 ('MetaData "GWCSStep" "Telescope.Asdf.GWCS" "telescope-0.2.0-inplace" 'False) (C1 ('MetaCons "GWCSStep" 'PrefixI 'True) (S1 ('MetaSel ('Just "frame") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 frame) :*: S1 ('MetaSel ('Just "transform") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Maybe Transformation)))) |
data Transformation Source #
A Tranform
with the types stripped, and the axes recorded
Instances
Show Transformation Source # | |
Defined in Telescope.Asdf.GWCS showsPrec :: Int -> Transformation -> ShowS # show :: Transformation -> String # showList :: [Transformation] -> ShowS # | |
Eq Transformation Source # | |
Defined in Telescope.Asdf.GWCS (==) :: Transformation -> Transformation -> Bool # (/=) :: Transformation -> Transformation -> Bool # | |
ToAsdf Transformation Source # | |
Defined in Telescope.Asdf.GWCS |
data Transform (b :: k) (c :: k1) Source #
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
(|>) :: forall {k} b (c :: k) d. (ToAxes b, ToAxes d) => Transform b c -> Transform c d -> Transform b d infixr 5 Source #
Compose two transforms
(<&>) :: 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) infixr 4 Source #
Concatent two transforms
Instances
data Projection Source #
Instances
ToAsdf Projection Source # | |
Defined in Telescope.Asdf.GWCS |
Instances
Instances
Generic (Linear a) Source # | |||||
Defined in Telescope.Asdf.GWCS
| |||||
ToAsdf (Linear a) Source # | |||||
ToAxes a => ToAxes (Linear a) Source # | |||||
Defined in Telescope.Asdf.GWCS | |||||
type Rep (Linear a) Source # | |||||
Defined in Telescope.Asdf.GWCS type Rep (Linear a) = D1 ('MetaData "Linear" "Telescope.Asdf.GWCS" "telescope-0.2.0-inplace" 'False) (C1 ('MetaCons "Linear1d" 'PrefixI 'True) (S1 ('MetaSel ('Just "intercept") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Float) :*: S1 ('MetaSel ('Just "slope") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Float))) |
data CoordinateFrame Source #
Instances
ToAsdf CoordinateFrame Source # | |
Defined in Telescope.Asdf.GWCS |
data StokesFrame Source #
Instances
ToAsdf StokesFrame Source # | |
Defined in Telescope.Asdf.GWCS |
data SpectralFrame Source #
Instances
ToAsdf SpectralFrame Source # | |
Defined in Telescope.Asdf.GWCS |
data CelestialFrame Source #
Instances
ToAsdf CelestialFrame Source # | |
Defined in Telescope.Asdf.GWCS |
data CompositeFrame as Source #
Instances
ToAsdf as => ToAsdf (CompositeFrame as) Source # | |
Defined in Telescope.Asdf.GWCS |
class ToAxes as where Source #
Convert a type to named axes
data X deriving (Generic, ToAxes) data Y instance ToAxes Y where toAxes = ["y"]
Nothing
Instances
ToAxes Alpha Source # | |
Defined in Telescope.Asdf.GWCS | |
ToAxes Delta Source # | |
Defined in Telescope.Asdf.GWCS | |
ToAxes Phi Source # | |
Defined in Telescope.Asdf.GWCS | |
ToAxes Theta Source # | |
Defined in Telescope.Asdf.GWCS | |
ToAxes () Source # | |
Defined in Telescope.Asdf.GWCS | |
ToAxes a => ToAxes (Linear a) Source # | |
Defined in Telescope.Asdf.GWCS | |
ToAxes a => ToAxes (Pix a) Source # | |
Defined in Telescope.Asdf.GWCS | |
ToAxes a => ToAxes (Rot a) Source # | |
Defined in Telescope.Asdf.GWCS | |
ToAxes a => ToAxes (Scale a) Source # | |
Defined in Telescope.Asdf.GWCS | |
ToAxes a => ToAxes (Shift a) Source # | |
Defined in Telescope.Asdf.GWCS | |
(ToAxes a, ToAxes b) => ToAxes (a, b) Source # | |
Defined in Telescope.Asdf.GWCS | |
(ToAxes a, ToAxes b, ToAxes c) => ToAxes (a, b, c) Source # | |
Defined in Telescope.Asdf.GWCS | |
(ToAxes a, ToAxes b, ToAxes c, ToAxes d) => ToAxes (a, b, c, d) Source # | |
Defined in Telescope.Asdf.GWCS |
shift :: forall {k} (a :: k) f. (ToAxes (f a), ToAxes (Shift a)) => Float -> Transform (f a) (Shift a) Source #
scale :: forall {k} (a :: k) f. (ToAxes (f a), ToAxes (Scale a)) => Float -> Transform (f a) (Scale a) Source #
rotate :: (ToAxes x, ToAxes y) => Array D Ix2 Float -> Transform (Linear x, Linear y) (Rot (x, y)) Source #
wcsLinear :: forall axis (alt :: WCSAlt). ToAxes axis => WCSAxis alt axis -> Transform (Pix axis) (Linear axis) Source #