{-# language QuasiQuotes #-}

module Data.Metrology.Extra where

import           Control.Applicative
import           Data.Coerce                    ( coerce )
import           Data.Constants.Mechanics.Extra ( )
import qualified Data.Fixed                    as F
                                                ( div'
                                                , divMod'
                                                , mod'
                                                )
import           Data.Metrology
import           Data.Metrology.Unsafe          ( Qu(..) )
import           Data.Units.SI.Parser
import           Linear.Metric
import           Linear.V3
import           Linear.Vector
import           Physics.Orbit.Metrology

mod' :: forall a u l . Real a => Qu u l a -> Qu u l a -> Qu u l a
mod' :: Qu u l a -> Qu u l a -> Qu u l a
mod' = (a -> a -> a) -> Qu u l a -> Qu u l a -> Qu u l a
forall a b. Coercible a b => a -> b
coerce (a -> a -> a
forall a. Real a => a -> a -> a
F.mod' :: a -> a -> a)

div'
  :: forall a b u v l
   . (Real a, Integral b)
  => Qu u l a
  -> Qu v l a
  -> Qu (Normalize (u @- v)) l b
div' :: Qu u l a -> Qu v l a -> Qu (Normalize (u @- v)) l b
div' = (a -> a -> b)
-> Qu u l a -> Qu v l a -> Qu (Normalize (u @- v)) l b
forall a b. Coercible a b => a -> b
coerce (a -> a -> b
forall a b. (Real a, Integral b) => a -> a -> b
F.div' :: a -> a -> b)

divMod'
  :: forall a b u l
   . (Real a, Integral b)
  => Qu u l a
  -> Qu u l a
  -> (Qu '[] l b, Qu u l a)
divMod' :: Qu u l a -> Qu u l a -> (Qu '[] l b, Qu u l a)
divMod' = (a -> a -> (b, a))
-> Qu u l a -> Qu u l a -> (Qu '[] l b, Qu u l a)
forall a b. Coercible a b => a -> b
coerce (a -> a -> (b, a)
forall a b. (Real a, Integral b) => a -> a -> (b, a)
F.divMod' :: a -> a -> (b, a))

rad :: Fractional a => a -> Angle a
rad :: a -> Angle a
rad = (a -> Radian -> Qu '[ 'F PlaneAngle One] 'DefaultLCSU a
forall (dim :: [Factor *]) unit n.
(ValidDLU dim 'DefaultLCSU unit, Fractional n) =>
n -> unit -> Qu dim 'DefaultLCSU n
% [si|rad|])

rdh :: Fractional a => a -> AngleH a
rdh :: a -> AngleH a
rdh = (a
-> RadianHyperbolic
-> Qu '[ 'F PlaneAngleHyperbolic One] 'DefaultLCSU a
forall (dim :: [Factor *]) unit n.
(ValidDLU dim 'DefaultLCSU unit, Fractional n) =>
n -> unit -> Qu dim 'DefaultLCSU n
% RadianHyperbolic
RadianHyperbolic)

qCos :: Floating a => Angle a -> Unitless a
qCos :: Angle a -> Unitless a
qCos θ :: Angle a
θ = a -> Unitless a
forall n (l :: LCSU *). n -> Qu '[] l n
quantity (a -> Unitless a) -> a -> Unitless a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. Floating a => a -> a
cos (Qu '[ 'F PlaneAngle One] 'DefaultLCSU a
Angle a
θ Qu '[ 'F PlaneAngle One] 'DefaultLCSU a -> Radian -> a
forall (dim :: [Factor *]) unit n.
(ValidDLU dim 'DefaultLCSU unit, Fractional n) =>
Qu dim 'DefaultLCSU n -> unit -> n
# [si|rad|])

qSin :: Floating a => Angle a -> Unitless a
qSin :: Angle a -> Unitless a
qSin θ :: Angle a
θ = a -> Unitless a
forall n (l :: LCSU *). n -> Qu '[] l n
quantity (a -> Unitless a) -> a -> Unitless a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. Floating a => a -> a
sin (Qu '[ 'F PlaneAngle One] 'DefaultLCSU a
Angle a
θ Qu '[ 'F PlaneAngle One] 'DefaultLCSU a -> Radian -> a
forall (dim :: [Factor *]) unit n.
(ValidDLU dim 'DefaultLCSU unit, Fractional n) =>
Qu dim 'DefaultLCSU n -> unit -> n
# [si|rad|])

qTan :: Floating a => Angle a -> Unitless a
qTan :: Angle a -> Unitless a
qTan θ :: Angle a
θ = a -> Unitless a
forall n (l :: LCSU *). n -> Qu '[] l n
quantity (a -> Unitless a) -> a -> Unitless a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. Floating a => a -> a
tan (Qu '[ 'F PlaneAngle One] 'DefaultLCSU a
Angle a
θ Qu '[ 'F PlaneAngle One] 'DefaultLCSU a -> Radian -> a
forall (dim :: [Factor *]) unit n.
(ValidDLU dim 'DefaultLCSU unit, Fractional n) =>
Qu dim 'DefaultLCSU n -> unit -> n
# [si|rad|])

qArcTan :: Floating a => Unitless a -> Angle a
qArcTan :: Unitless a -> Angle a
qArcTan = a -> Qu '[ 'F PlaneAngle One] 'DefaultLCSU a
forall a. Fractional a => a -> Angle a
rad (a -> Qu '[ 'F PlaneAngle One] 'DefaultLCSU a)
-> (Qu '[] 'DefaultLCSU a -> a)
-> Qu '[] 'DefaultLCSU a
-> Qu '[ 'F PlaneAngle One] 'DefaultLCSU a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. Floating a => a -> a
atan (a -> a)
-> (Qu '[] 'DefaultLCSU a -> a) -> Qu '[] 'DefaultLCSU a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Qu '[] 'DefaultLCSU a -> Number -> a
forall (dim :: [Factor *]) unit n.
(ValidDLU dim 'DefaultLCSU unit, Fractional n) =>
Qu dim 'DefaultLCSU n -> unit -> n
# [si||])

qArcTan2 :: RealFloat a => Unitless a -> Unitless a -> Angle a
qArcTan2 :: Unitless a -> Unitless a -> Angle a
qArcTan2 x :: Unitless a
x y :: Unitless a
y = a -> Angle a
forall a. Fractional a => a -> Angle a
rad (a -> a -> a
forall a. RealFloat a => a -> a -> a
atan2 (Qu '[] 'DefaultLCSU a
Unitless a
x Qu '[] 'DefaultLCSU a -> Number -> a
forall (dim :: [Factor *]) unit n.
(ValidDLU dim 'DefaultLCSU unit, Fractional n) =>
Qu dim 'DefaultLCSU n -> unit -> n
# [si||]) (Qu '[] 'DefaultLCSU a
Unitless a
y Qu '[] 'DefaultLCSU a -> Number -> a
forall (dim :: [Factor *]) unit n.
(ValidDLU dim 'DefaultLCSU unit, Fractional n) =>
Qu dim 'DefaultLCSU n -> unit -> n
# [si||]))

qArcCos :: Floating a => Unitless a -> Angle a
qArcCos :: Unitless a -> Angle a
qArcCos = a -> Qu '[ 'F PlaneAngle One] 'DefaultLCSU a
forall a. Fractional a => a -> Angle a
rad (a -> Qu '[ 'F PlaneAngle One] 'DefaultLCSU a)
-> (Qu '[] 'DefaultLCSU a -> a)
-> Qu '[] 'DefaultLCSU a
-> Qu '[ 'F PlaneAngle One] 'DefaultLCSU a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. Floating a => a -> a
acos (a -> a)
-> (Qu '[] 'DefaultLCSU a -> a) -> Qu '[] 'DefaultLCSU a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Qu '[] 'DefaultLCSU a -> Number -> a
forall (dim :: [Factor *]) unit n.
(ValidDLU dim 'DefaultLCSU unit, Fractional n) =>
Qu dim 'DefaultLCSU n -> unit -> n
# [si||])

qRecip
  :: forall u l a . Fractional a => Qu u l a -> Qu (Normalize ('[] @- u)) l a
qRecip :: Qu u l a -> Qu (Normalize ('[] @- u)) l a
qRecip = (a -> a) -> Qu u l a -> Qu (Normalize ('[] @- u)) l a
forall a b. Coercible a b => a -> b
coerce (Fractional a => a -> a
forall a. Fractional a => a -> a
recip @a)

qTanh :: Floating a => AngleH a -> Unitless a
qTanh :: AngleH a -> Unitless a
qTanh = a -> Qu '[] 'DefaultLCSU a
forall n (l :: LCSU *). n -> Qu '[] l n
quantity (a -> Qu '[] 'DefaultLCSU a)
-> (Qu '[ 'F PlaneAngleHyperbolic One] 'DefaultLCSU a -> a)
-> Qu '[ 'F PlaneAngleHyperbolic One] 'DefaultLCSU a
-> Qu '[] 'DefaultLCSU a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. Floating a => a -> a
tanh (a -> a)
-> (Qu '[ 'F PlaneAngleHyperbolic One] 'DefaultLCSU a -> a)
-> Qu '[ 'F PlaneAngleHyperbolic One] 'DefaultLCSU a
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Qu '[ 'F PlaneAngleHyperbolic One] 'DefaultLCSU a
-> RadianHyperbolic -> a
forall (dim :: [Factor *]) unit n.
(ValidDLU dim 'DefaultLCSU unit, Fractional n) =>
Qu dim 'DefaultLCSU n -> unit -> n
# RadianHyperbolic
RadianHyperbolic)

qSinh :: Floating a => AngleH a -> Unitless a
qSinh :: AngleH a -> Unitless a
qSinh = a -> Qu '[] 'DefaultLCSU a
forall n (l :: LCSU *). n -> Qu '[] l n
quantity (a -> Qu '[] 'DefaultLCSU a)
-> (Qu '[ 'F PlaneAngleHyperbolic One] 'DefaultLCSU a -> a)
-> Qu '[ 'F PlaneAngleHyperbolic One] 'DefaultLCSU a
-> Qu '[] 'DefaultLCSU a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. Floating a => a -> a
sinh (a -> a)
-> (Qu '[ 'F PlaneAngleHyperbolic One] 'DefaultLCSU a -> a)
-> Qu '[ 'F PlaneAngleHyperbolic One] 'DefaultLCSU a
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Qu '[ 'F PlaneAngleHyperbolic One] 'DefaultLCSU a
-> RadianHyperbolic -> a
forall (dim :: [Factor *]) unit n.
(ValidDLU dim 'DefaultLCSU unit, Fractional n) =>
Qu dim 'DefaultLCSU n -> unit -> n
# RadianHyperbolic
RadianHyperbolic)

qCosh :: Floating a => AngleH a -> Unitless a
qCosh :: AngleH a -> Unitless a
qCosh = a -> Qu '[] 'DefaultLCSU a
forall n (l :: LCSU *). n -> Qu '[] l n
quantity (a -> Qu '[] 'DefaultLCSU a)
-> (Qu '[ 'F PlaneAngleHyperbolic One] 'DefaultLCSU a -> a)
-> Qu '[ 'F PlaneAngleHyperbolic One] 'DefaultLCSU a
-> Qu '[] 'DefaultLCSU a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. Floating a => a -> a
cosh (a -> a)
-> (Qu '[ 'F PlaneAngleHyperbolic One] 'DefaultLCSU a -> a)
-> Qu '[ 'F PlaneAngleHyperbolic One] 'DefaultLCSU a
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Qu '[ 'F PlaneAngleHyperbolic One] 'DefaultLCSU a
-> RadianHyperbolic -> a
forall (dim :: [Factor *]) unit n.
(ValidDLU dim 'DefaultLCSU unit, Fractional n) =>
Qu dim 'DefaultLCSU n -> unit -> n
# RadianHyperbolic
RadianHyperbolic)

qArcCosh :: Floating a => Unitless a -> AngleH a
qArcCosh :: Unitless a -> AngleH a
qArcCosh = a -> Qu '[ 'F PlaneAngleHyperbolic One] 'DefaultLCSU a
forall a. Fractional a => a -> AngleH a
rdh (a -> Qu '[ 'F PlaneAngleHyperbolic One] 'DefaultLCSU a)
-> (Qu '[] 'DefaultLCSU a -> a)
-> Qu '[] 'DefaultLCSU a
-> Qu '[ 'F PlaneAngleHyperbolic One] 'DefaultLCSU a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. Floating a => a -> a
acosh (a -> a)
-> (Qu '[] 'DefaultLCSU a -> a) -> Qu '[] 'DefaultLCSU a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Qu '[] 'DefaultLCSU a -> Number -> a
forall (dim :: [Factor *]) unit n.
(ValidDLU dim 'DefaultLCSU unit, Fractional n) =>
Qu dim 'DefaultLCSU n -> unit -> n
# [si||])

qAbs :: forall a l u . Num a => Qu u l a -> Qu u l a
qAbs :: Qu u l a -> Qu u l a
qAbs = (a -> a) -> Qu u l a -> Qu u l a
forall a b. Coercible a b => a -> b
coerce (Num a => a -> a
forall a. Num a => a -> a
abs @a)

qCross
  :: Num n
  => V3 (Qu a l n)
  -> V3 (Qu b l n)
  -> V3 (Qu (Normalize (a @@+ Reorder b a)) l n)
qCross :: V3 (Qu a l n)
-> V3 (Qu b l n) -> V3 (Qu (Normalize (a @@+ Reorder b a)) l n)
qCross (V3 a :: Qu a l n
a b :: Qu a l n
b c :: Qu a l n
c) (V3 d :: Qu b l n
d e :: Qu b l n
e f :: Qu b l n
f) =
  Qu (Normalize (a @@+ Reorder b a)) l n
-> Qu (Normalize (a @@+ Reorder b a)) l n
-> Qu (Normalize (a @@+ Reorder b a)) l n
-> V3 (Qu (Normalize (a @@+ Reorder b a)) l n)
forall a. a -> a -> a -> V3 a
V3 (Qu a l n
b Qu a l n -> Qu b l n -> Qu (Normalize (a @+ b)) l n
forall n (a :: [Factor *]) (l :: LCSU *) (b :: [Factor *]).
Num n =>
Qu a l n -> Qu b l n -> Qu (Normalize (a @+ b)) l n
|*| Qu b l n
f Qu (Normalize (a @@+ Reorder b a)) l n
-> Qu (Normalize (a @@+ Reorder b a)) l n
-> Qu (Normalize (a @@+ Reorder b a)) l n
forall (d1 :: [Factor *]) (d2 :: [Factor *]) n (l :: LCSU *).
(d1 @~ d2, Num n) =>
Qu d1 l n -> Qu d2 l n -> Qu d1 l n
|-| Qu a l n
c Qu a l n -> Qu b l n -> Qu (Normalize (a @+ b)) l n
forall n (a :: [Factor *]) (l :: LCSU *) (b :: [Factor *]).
Num n =>
Qu a l n -> Qu b l n -> Qu (Normalize (a @+ b)) l n
|*| Qu b l n
e) (Qu a l n
c Qu a l n -> Qu b l n -> Qu (Normalize (a @+ b)) l n
forall n (a :: [Factor *]) (l :: LCSU *) (b :: [Factor *]).
Num n =>
Qu a l n -> Qu b l n -> Qu (Normalize (a @+ b)) l n
|*| Qu b l n
d Qu (Normalize (a @@+ Reorder b a)) l n
-> Qu (Normalize (a @@+ Reorder b a)) l n
-> Qu (Normalize (a @@+ Reorder b a)) l n
forall (d1 :: [Factor *]) (d2 :: [Factor *]) n (l :: LCSU *).
(d1 @~ d2, Num n) =>
Qu d1 l n -> Qu d2 l n -> Qu d1 l n
|-| Qu a l n
a Qu a l n -> Qu b l n -> Qu (Normalize (a @+ b)) l n
forall n (a :: [Factor *]) (l :: LCSU *) (b :: [Factor *]).
Num n =>
Qu a l n -> Qu b l n -> Qu (Normalize (a @+ b)) l n
|*| Qu b l n
f) (Qu a l n
a Qu a l n -> Qu b l n -> Qu (Normalize (a @+ b)) l n
forall n (a :: [Factor *]) (l :: LCSU *) (b :: [Factor *]).
Num n =>
Qu a l n -> Qu b l n -> Qu (Normalize (a @+ b)) l n
|*| Qu b l n
e Qu (Normalize (a @@+ Reorder b a)) l n
-> Qu (Normalize (a @@+ Reorder b a)) l n
-> Qu (Normalize (a @@+ Reorder b a)) l n
forall (d1 :: [Factor *]) (d2 :: [Factor *]) n (l :: LCSU *).
(d1 @~ d2, Num n) =>
Qu d1 l n -> Qu d2 l n -> Qu d1 l n
|-| Qu a l n
b Qu a l n -> Qu b l n -> Qu (Normalize (a @+ b)) l n
forall n (a :: [Factor *]) (l :: LCSU *) (b :: [Factor *]).
Num n =>
Qu a l n -> Qu b l n -> Qu (Normalize (a @+ b)) l n
|*| Qu b l n
d)

qNorm :: forall u l a . Floating a => V3 (Qu u l a) -> Qu u l a
qNorm :: V3 (Qu u l a) -> Qu u l a
qNorm = (V3 a -> a) -> V3 (Qu u l a) -> Qu u l a
forall a b. Coercible a b => a -> b
coerce (Floating a => V3 a -> a
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> a
norm @V3 @a)

-- qNormalize
--   :: forall u l a . (Floating a, Epsilon a) => V3 (Qu u l a) -> V3 (Qu '[] l a)
-- qNormalize = coerce (normalize @a @V3)
qNormalize
  :: Floating n
  => V3 (Qu b l n)
  -> V3
       ( Qu
           ( Normalize
               (Normalize ('[] @- b) @@+ Reorder b (Normalize ('[] @- b)))
           )
           l
           n
       )
qNormalize :: V3 (Qu b l n)
-> V3
     (Qu
        (Normalize
           (Normalize ('[] @- b) @@+ Reorder b (Normalize ('[] @- b))))
        l
        n)
qNormalize x :: V3 (Qu b l n)
x = (Qu b l n -> Qu (Normalize ('[] @- b)) l n
forall (u :: [Factor *]) (l :: LCSU *) a.
Fractional a =>
Qu u l a -> Qu (Normalize ('[] @- u)) l a
qRecip (V3 (Qu b l n) -> Qu b l n
forall (u :: [Factor *]) (l :: LCSU *) a.
Floating a =>
V3 (Qu u l a) -> Qu u l a
qNorm V3 (Qu b l n)
x) Qu (Normalize ('[] @- b)) l n
-> Qu b l n -> Qu (Normalize (Normalize ('[] @- b) @+ b)) l n
forall n (a :: [Factor *]) (l :: LCSU *) (b :: [Factor *]).
Num n =>
Qu a l n -> Qu b l n -> Qu (Normalize (a @+ b)) l n
|*|) (Qu b l n
 -> Qu
      (Normalize
         (Normalize ('[] @- b) @@+ Reorder b (Normalize ('[] @- b))))
      l
      n)
-> V3 (Qu b l n)
-> V3
     (Qu
        (Normalize
           (Normalize ('[] @- b) @@+ Reorder b (Normalize ('[] @- b))))
        l
        n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> V3 (Qu b l n)
x

qDot
  :: forall u v l a. Num a
  => V3 (Qu u l a)
  -> V3 (Qu v l a)
  -> Qu (Normalize (u @@+ Reorder v u)) l a
qDot :: V3 (Qu u l a)
-> V3 (Qu v l a) -> Qu (Normalize (u @@+ Reorder v u)) l a
qDot = (V3 a -> V3 a -> a)
-> V3 (Qu u l a)
-> V3 (Qu v l a)
-> Qu (Normalize (u @@+ Reorder v u)) l a
forall a b. Coercible a b => a -> b
coerce (Num a => V3 a -> V3 a -> a
forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
dot @V3 @a)

qQuadrance
  :: forall u l a
   . Num a
  => V3 (Qu u l a)
  -> Qu (Normalize (u @@+ Reorder u u)) l a
qQuadrance :: V3 (Qu u l a) -> Qu (Normalize (u @@+ Reorder u u)) l a
qQuadrance = (V3 a -> a) -> V3 (Qu u l a) -> Qu (Normalize (u @@+ u)) l a
forall a b. Coercible a b => a -> b
coerce (Num a => V3 a -> a
forall (f :: * -> *) a. (Metric f, Num a) => f a -> a
quadrance @V3 @a)

(|^/|) :: (Functor f, Fractional n) =>
            f (Qu b l n)
            -> Qu u l n
            -> f (Qu
                    (Normalize
                       (Normalize ('[] @- u) @@+ Reorder b (Normalize ('[] @- u))))
                    l
                    n)
x :: f (Qu b l n)
x |^/| :: f (Qu b l n)
-> Qu u l n
-> f (Qu
        (Normalize
           (Normalize ('[] @- u) @@+ Reorder b (Normalize ('[] @- u))))
        l
        n)
|^/| y :: Qu u l n
y = (Qu u l n -> Qu (Normalize ('[] @- u)) l n
forall (u :: [Factor *]) (l :: LCSU *) a.
Fractional a =>
Qu u l a -> Qu (Normalize ('[] @- u)) l a
qRecip Qu u l n
y Qu (Normalize ('[] @- u)) l n
-> Qu b l n -> Qu (Normalize (Normalize ('[] @- u) @+ b)) l n
forall n (a :: [Factor *]) (l :: LCSU *) (b :: [Factor *]).
Num n =>
Qu a l n -> Qu b l n -> Qu (Normalize (a @+ b)) l n
|*|) (Qu b l n
 -> Qu
      (Normalize
         (Normalize ('[] @- u) @@+ Reorder b (Normalize ('[] @- u))))
      l
      n)
-> f (Qu b l n)
-> f (Qu
        (Normalize
           (Normalize ('[] @- u) @@+ Reorder b (Normalize ('[] @- u))))
        l
        n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Qu b l n)
x

(|^-^|)
  :: forall f u l a
   . (Additive f, Applicative f, Num a)
  => f (Qu u l a)
  -> f (Qu u l a)
  -> f (Qu u l a)
|^-^| :: f (Qu u l a) -> f (Qu u l a) -> f (Qu u l a)
(|^-^|) = (Qu u l a -> Qu u l a -> Qu u l a)
-> f (Qu u l a) -> f (Qu u l a) -> f (Qu u l a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Qu u l a -> Qu u l a -> Qu u l a
forall (d1 :: [Factor *]) (d2 :: [Factor *]) n (l :: LCSU *).
(d1 @~ d2, Num n) =>
Qu d1 l n -> Qu d2 l n -> Qu d1 l n
(|-|)