{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}

module Data.Aviation.Navigation.Vector(
  Vector(..)
, Vector'
, vectorDegrees
, HasVector(..)
) where

import Control.Category ( Category(id, (.)) )
import Control.Lens ( view, Lens' )
import Data.Eq ( Eq )
import Data.Functor ( Functor(fmap) )
import Data.Monoid ( Monoid(mempty) )
import Data.Ord ( Ord )
import Data.Radian ( fromRadians )
import Data.Semigroup ( Semigroup((<>)) )
import GHC.Float ( Floating(cos, sqrt, pi, atan, sin), Double )
import GHC.Show(Show)
import Prelude(Num((*), (-), (+)), Fractional((/)))

data Vector a =
  Vector a a
  deriving (Vector a -> Vector a -> Bool
(Vector a -> Vector a -> Bool)
-> (Vector a -> Vector a -> Bool) -> Eq (Vector a)
forall a. Eq a => Vector a -> Vector a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Vector a -> Vector a -> Bool
== :: Vector a -> Vector a -> Bool
$c/= :: forall a. Eq a => Vector a -> Vector a -> Bool
/= :: Vector a -> Vector a -> Bool
Eq, Eq (Vector a)
Eq (Vector a) =>
(Vector a -> Vector a -> Ordering)
-> (Vector a -> Vector a -> Bool)
-> (Vector a -> Vector a -> Bool)
-> (Vector a -> Vector a -> Bool)
-> (Vector a -> Vector a -> Bool)
-> (Vector a -> Vector a -> Vector a)
-> (Vector a -> Vector a -> Vector a)
-> Ord (Vector a)
Vector a -> Vector a -> Bool
Vector a -> Vector a -> Ordering
Vector a -> Vector a -> Vector a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Vector a)
forall a. Ord a => Vector a -> Vector a -> Bool
forall a. Ord a => Vector a -> Vector a -> Ordering
forall a. Ord a => Vector a -> Vector a -> Vector a
$ccompare :: forall a. Ord a => Vector a -> Vector a -> Ordering
compare :: Vector a -> Vector a -> Ordering
$c< :: forall a. Ord a => Vector a -> Vector a -> Bool
< :: Vector a -> Vector a -> Bool
$c<= :: forall a. Ord a => Vector a -> Vector a -> Bool
<= :: Vector a -> Vector a -> Bool
$c> :: forall a. Ord a => Vector a -> Vector a -> Bool
> :: Vector a -> Vector a -> Bool
$c>= :: forall a. Ord a => Vector a -> Vector a -> Bool
>= :: Vector a -> Vector a -> Bool
$cmax :: forall a. Ord a => Vector a -> Vector a -> Vector a
max :: Vector a -> Vector a -> Vector a
$cmin :: forall a. Ord a => Vector a -> Vector a -> Vector a
min :: Vector a -> Vector a -> Vector a
Ord, Int -> Vector a -> ShowS
[Vector a] -> ShowS
Vector a -> String
(Int -> Vector a -> ShowS)
-> (Vector a -> String) -> ([Vector a] -> ShowS) -> Show (Vector a)
forall a. Show a => Int -> Vector a -> ShowS
forall a. Show a => [Vector a] -> ShowS
forall a. Show a => Vector a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Vector a -> ShowS
showsPrec :: Int -> Vector a -> ShowS
$cshow :: forall a. Show a => Vector a -> String
show :: Vector a -> String
$cshowList :: forall a. Show a => [Vector a] -> ShowS
showList :: [Vector a] -> ShowS
Show)

type Vector' =
  Vector Double

vectorDegrees ::
  Double
  -> Double
  -> Vector'
vectorDegrees :: Double -> Double -> Vector'
vectorDegrees =
  Double -> Double -> Vector'
forall a. a -> a -> Vector a
Vector (Double -> Double -> Vector')
-> (Double -> Double) -> Double -> Double -> Vector'
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Getting Double Double Double -> Double -> Double
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Double Double Double
forall a b. (Floating a, Floating b) => Iso a b a b
Iso Double Double Double Double
fromRadians

instance Floating a => Semigroup (Vector a) where
  Vector a
aa a
am <> :: Vector a -> Vector a -> Vector a
<> Vector a
ba a
bm =
    let square :: a -> a
square a
x = a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
x
        t :: a
t = a
aa a -> a -> a
forall a. Num a => a -> a -> a
- a
ba
        mag :: a
mag = a -> a
forall a. Floating a => a -> a
sqrt (a -> a
forall {a}. Num a => a -> a
square a
am a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall {a}. Num a => a -> a
square a
bm a -> a -> a
forall a. Num a => a -> a -> a
- a
2 a -> a -> a
forall a. Num a => a -> a -> a
* a
am a -> a -> a
forall a. Num a => a -> a -> a
* a
bm a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
forall a. Floating a => a -> a
cos (a
forall a. Floating a => a
pi a -> a -> a
forall a. Num a => a -> a -> a
- a
t))
        ang :: a
ang = a -> a
forall a. Floating a => a -> a
atan (a
bm a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
forall a. Floating a => a -> a
sin a
t a -> a -> a
forall a. Fractional a => a -> a -> a
/ (a
am a -> a -> a
forall a. Num a => a -> a -> a
+ a
bm a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
forall a. Floating a => a -> a
cos a
t))
    in  a -> a -> Vector a
forall a. a -> a -> Vector a
Vector (a
aa a -> a -> a
forall a. Num a => a -> a -> a
- a
ang) a
mag

instance Floating a => Monoid (Vector a) where
  mempty :: Vector a
mempty =
    a -> a -> Vector a
forall a. a -> a -> Vector a
Vector a
0 a
0

class HasVector a c | a -> c where
  vector ::
    Lens' a (Vector c)
  {-# INLINE angle #-}
  angle ::
    Lens' a c
  angle =
    (Vector c -> f (Vector c)) -> a -> f a
forall a c. HasVector a c => Lens' a (Vector c)
Lens' a (Vector c)
vector ((Vector c -> f (Vector c)) -> a -> f a)
-> ((c -> f c) -> Vector c -> f (Vector c))
-> (c -> f c)
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (c -> f c) -> Vector c -> f (Vector c)
forall a c. HasVector a c => Lens' a c
Lens' (Vector c) c
angle
  {-# INLINE magnitude #-}
  magnitude ::
    Lens' a c
  magnitude =
    (Vector c -> f (Vector c)) -> a -> f a
forall a c. HasVector a c => Lens' a (Vector c)
Lens' a (Vector c)
vector ((Vector c -> f (Vector c)) -> a -> f a)
-> ((c -> f c) -> Vector c -> f (Vector c))
-> (c -> f c)
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (c -> f c) -> Vector c -> f (Vector c)
forall a c. HasVector a c => Lens' a c
Lens' (Vector c) c
magnitude

instance HasVector (Vector a) a where
  vector :: Lens' (Vector a) (Vector a)
vector = (Vector a -> f (Vector a)) -> Vector a -> f (Vector a)
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
  {-# INLINE angle #-}
  angle :: Lens' (Vector a) a
angle a -> f a
f (Vector a
x a
y) =
    (a -> Vector a) -> f a -> f (Vector a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> a -> Vector a
forall a. a -> a -> Vector a
`Vector` a
y) (a -> f a
f a
x)
  {-# INLINE magnitude #-}
  magnitude :: Lens' (Vector a) a
magnitude a -> f a
f (Vector a
a a
y) =
    (a -> Vector a) -> f a -> f (Vector a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> a -> Vector a
forall a. a -> a -> Vector a
Vector a
a) (a -> f a
f a
y)