{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}

module Data.Aviation.Navigation.WindCorrection(
  WindCorrection(..)
, HasWindCorrection(..)
, calculateWindCorrection
, printWindCorrection
, run
) where

import Control.Category ( Category(id, (.)) )
import Control.Lens ( view, Lens' )
import Options.Applicative
    ( (<**>), fullDesc, header, info, execParser, helper )
import Text.Printf ( PrintfArg, printf, PrintfType )
import Data.String ( IsString, String )
import Data.Radian ( toRadians )
import Data.Aviation.Navigation.Vector
    ( Vector(..), Vector', HasVector(..) )
import Data.Aviation.Navigation.WindComponent
    ( WindComponent, HasWindComponent(windComponent, headwind, crosswind), calculateWindComponent )
import Data.Aviation.Navigation.WindParameters
    ( HasWindParameters(trackTAS), optWindParametersVersion )
import Data.Eq ( Eq )
import Data.Function(($))
import Data.Functor ( Functor(fmap) )
import Data.Maybe ( Maybe(Just, Nothing) )
import Data.Ord ( Ord )
import Data.Semigroup ( Semigroup((<>)) )
import GHC.Float ( Floating(sqrt), Double )
import GHC.Show(Show)
import Prelude(Num((-), (+), (*)), Fractional((/)))
import System.IO ( IO, putStrLn )

data WindCorrection =
  WindCorrection
    WindComponent -- crosswind/headwind
    Double -- TAS
    Vector' -- heading/ground speed
  deriving (WindCorrection -> WindCorrection -> Bool
(WindCorrection -> WindCorrection -> Bool)
-> (WindCorrection -> WindCorrection -> Bool) -> Eq WindCorrection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WindCorrection -> WindCorrection -> Bool
== :: WindCorrection -> WindCorrection -> Bool
$c/= :: WindCorrection -> WindCorrection -> Bool
/= :: WindCorrection -> WindCorrection -> Bool
Eq, Eq WindCorrection
Eq WindCorrection =>
(WindCorrection -> WindCorrection -> Ordering)
-> (WindCorrection -> WindCorrection -> Bool)
-> (WindCorrection -> WindCorrection -> Bool)
-> (WindCorrection -> WindCorrection -> Bool)
-> (WindCorrection -> WindCorrection -> Bool)
-> (WindCorrection -> WindCorrection -> WindCorrection)
-> (WindCorrection -> WindCorrection -> WindCorrection)
-> Ord WindCorrection
WindCorrection -> WindCorrection -> Bool
WindCorrection -> WindCorrection -> Ordering
WindCorrection -> WindCorrection -> WindCorrection
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
$ccompare :: WindCorrection -> WindCorrection -> Ordering
compare :: WindCorrection -> WindCorrection -> Ordering
$c< :: WindCorrection -> WindCorrection -> Bool
< :: WindCorrection -> WindCorrection -> Bool
$c<= :: WindCorrection -> WindCorrection -> Bool
<= :: WindCorrection -> WindCorrection -> Bool
$c> :: WindCorrection -> WindCorrection -> Bool
> :: WindCorrection -> WindCorrection -> Bool
$c>= :: WindCorrection -> WindCorrection -> Bool
>= :: WindCorrection -> WindCorrection -> Bool
$cmax :: WindCorrection -> WindCorrection -> WindCorrection
max :: WindCorrection -> WindCorrection -> WindCorrection
$cmin :: WindCorrection -> WindCorrection -> WindCorrection
min :: WindCorrection -> WindCorrection -> WindCorrection
Ord, Int -> WindCorrection -> ShowS
[WindCorrection] -> ShowS
WindCorrection -> String
(Int -> WindCorrection -> ShowS)
-> (WindCorrection -> String)
-> ([WindCorrection] -> ShowS)
-> Show WindCorrection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WindCorrection -> ShowS
showsPrec :: Int -> WindCorrection -> ShowS
$cshow :: WindCorrection -> String
show :: WindCorrection -> String
$cshowList :: [WindCorrection] -> ShowS
showList :: [WindCorrection] -> ShowS
Show)

calculateWindCorrection ::
  HasWindParameters a Double =>
  a
  -> WindCorrection
calculateWindCorrection :: forall a. HasWindParameters a Double => a -> WindCorrection
calculateWindCorrection a
wp =
  let square :: a -> a
square a
x = a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
x
      pythagoras :: a -> a -> a
pythagoras a
a a
b = a -> a
forall a. Floating a => a -> a
sqrt (a -> a
forall {a}. Num a => a -> a
square a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall {a}. Num a => a -> a
square a
b)
      tas' :: Double
tas' = Getting Double a Double -> a -> Double
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Vector' -> Const Double Vector') -> a -> Const Double a
forall a c. HasWindParameters a c => Lens' a (Vector c)
Lens' a Vector'
trackTAS ((Vector' -> Const Double Vector') -> a -> Const Double a)
-> ((Double -> Const Double Double)
    -> Vector' -> Const Double Vector')
-> Getting Double a Double
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
. (Double -> Const Double Double) -> Vector' -> Const Double Vector'
forall a c. HasVector a c => Lens' a c
Lens' Vector' Double
magnitude) a
wp
      wc :: WindComponent
wc = a -> WindComponent
forall a. HasWindParameters a Double => a -> WindComponent
calculateWindComponent a
wp
      hdg :: Double
hdg = Getting Double a Double -> a -> Double
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Vector' -> Const Double Vector') -> a -> Const Double a
forall a c. HasWindParameters a c => Lens' a (Vector c)
Lens' a Vector'
trackTAS ((Vector' -> Const Double Vector') -> a -> Const Double a)
-> ((Double -> Const Double Double)
    -> Vector' -> Const Double Vector')
-> Getting Double a Double
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
. (Double -> Const Double Double) -> Vector' -> Const Double Vector'
forall a c. HasVector a c => Lens' a c
Lens' Vector' Double
angle) a
wp Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Getting Double WindComponent Double -> WindComponent -> Double
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Double WindComponent Double
forall a. HasWindComponent a => Lens' a Double
Lens' WindComponent Double
crosswind WindComponent
wc Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
tas'
      emag :: Double
emag = Double -> Double -> Double
forall {a}. Floating a => a -> a -> a
pythagoras Double
tas' (Getting Double WindComponent Double -> WindComponent -> Double
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Double WindComponent Double
forall a. HasWindComponent a => Lens' a Double
Lens' WindComponent Double
crosswind WindComponent
wc)
      etas :: Double
etas = Double -> Double
forall {a}. Num a => a -> a
square Double
tas' Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
emag
      gs :: Double
gs = Double
etas Double -> Double -> Double
forall a. Num a => a -> a -> a
- Getting Double WindComponent Double -> WindComponent -> Double
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Double WindComponent Double
forall a. HasWindComponent a => Lens' a Double
Lens' WindComponent Double
headwind WindComponent
wc
  in  WindComponent -> Double -> Vector' -> WindCorrection
WindCorrection WindComponent
wc Double
etas (Double -> Double -> Vector'
forall a. a -> a -> Vector a
Vector Double
hdg Double
gs)

printWindCorrection ::
  (PrintfType a, IsString a, Semigroup a, HasWindCorrection s, HasWindComponent s, PrintfArg x, Floating x, HasVector s x) =>
  s
  -> a
printWindCorrection :: forall a s x.
(PrintfType a, IsString a, Semigroup a, HasWindCorrection s,
 HasWindComponent s, PrintfArg x, Floating x, HasVector s x) =>
s -> a
printWindCorrection s
r =
  a
"Effective TAS  " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> String -> Double -> a
forall r. PrintfType r => String -> r
printf String
"% 6.2f" (Getting Double s Double -> s -> Double
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Double s Double
forall a. HasWindCorrection a => Lens' a Double
Lens' s Double
tas s
r) a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"KT\n" a -> a -> a
forall a. Semigroup a => a -> a -> a
<>
  a
"Ground Speed   " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> String -> x -> a
forall r. PrintfType r => String -> r
printf String
"% 6.2f" (Getting x s x -> s -> x
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting x s x
forall a c. HasVector a c => Lens' a c
Lens' s x
magnitude s
r) a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"KT\n" a -> a -> a
forall a. Semigroup a => a -> a -> a
<>
  a
"Heading        " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> String -> x -> a
forall r. PrintfType r => String -> r
printf String
"% 6.2f" (Getting x s x -> s -> x
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting x s x
forall a c. HasVector a c => Lens' a c
Lens' s x
angle Getting x s x
-> ((x -> Const x x) -> x -> Const x x) -> Getting x s x
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
. (x -> Const x x) -> x -> Const x x
forall a b. (Floating a, Floating b) => Iso a b a b
Iso x x x x
toRadians) s
r) a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"°\n" a -> a -> a
forall a. Semigroup a => a -> a -> a
<>
  a
"Crosswind      " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> String -> Double -> a
forall r. PrintfType r => String -> r
printf String
"% 6.2f" (Getting Double s Double -> s -> Double
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Double s Double
forall a. HasWindComponent a => Lens' a Double
Lens' s Double
crosswind s
r) a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"KT\n" a -> a -> a
forall a. Semigroup a => a -> a -> a
<>
  a
"Headwind       " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> String -> Double -> a
forall r. PrintfType r => String -> r
printf String
"% 6.2f" (Getting Double s Double -> s -> Double
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Double s Double
forall a. HasWindComponent a => Lens' a Double
Lens' s Double
headwind s
r) a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"KT"

run ::
  String
  -> IO ()
run :: String -> IO ()
run String
v =
  let desc :: String
desc =
        String
"Aviation Navigation wind-correction (" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
v String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
      execopts :: IO (Maybe WindParameters')
execopts =
        ParserInfo (Maybe WindParameters') -> IO (Maybe WindParameters')
forall a. ParserInfo a -> IO a
execParser
          (Parser (Maybe WindParameters')
-> InfoMod (Maybe WindParameters')
-> ParserInfo (Maybe WindParameters')
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (Maybe WindParameters')
optWindParametersVersion Parser (Maybe WindParameters')
-> Parser (Maybe WindParameters' -> Maybe WindParameters')
-> Parser (Maybe WindParameters')
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (Maybe WindParameters' -> Maybe WindParameters')
forall a. Parser (a -> a)
helper) (
            InfoMod (Maybe WindParameters')
forall a. InfoMod a
fullDesc InfoMod (Maybe WindParameters')
-> InfoMod (Maybe WindParameters')
-> InfoMod (Maybe WindParameters')
forall a. Semigroup a => a -> a -> a
<>
            String -> InfoMod (Maybe WindParameters')
forall a. String -> InfoMod a
header String
desc
          )
        )
  in  do  Maybe WindParameters'
conf' <- IO (Maybe WindParameters')
execopts
          String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
            case Maybe WindParameters'
conf' of
              Maybe WindParameters'
Nothing ->
                String
desc
              Just WindParameters'
wp ->
                WindCorrection -> String
forall a s x.
(PrintfType a, IsString a, Semigroup a, HasWindCorrection s,
 HasWindComponent s, PrintfArg x, Floating x, HasVector s x) =>
s -> a
printWindCorrection (WindParameters' -> WindCorrection
forall a. HasWindParameters a Double => a -> WindCorrection
calculateWindCorrection WindParameters'
wp)

class HasWindCorrection a where
  windCorrection ::
    Lens' a WindCorrection
  {-# INLINE tas #-}
  tas ::
    Lens' a Double
  tas =
    (WindCorrection -> f WindCorrection) -> a -> f a
forall a. HasWindCorrection a => Lens' a WindCorrection
Lens' a WindCorrection
windCorrection ((WindCorrection -> f WindCorrection) -> a -> f a)
-> ((Double -> f Double) -> WindCorrection -> f WindCorrection)
-> (Double -> f Double)
-> 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
. (Double -> f Double) -> WindCorrection -> f WindCorrection
forall a. HasWindCorrection a => Lens' a Double
Lens' WindCorrection Double
tas

instance HasWindCorrection WindCorrection where
  windCorrection :: Lens' WindCorrection WindCorrection
windCorrection =
    (WindCorrection -> f WindCorrection)
-> WindCorrection -> f WindCorrection
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
  {-# INLINE tas #-}
  tas :: Lens' WindCorrection Double
tas Double -> f Double
f (WindCorrection WindComponent
wc Double
etas Vector'
hdg) =
    (Double -> WindCorrection) -> f Double -> f WindCorrection
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Double
etas' -> WindComponent -> Double -> Vector' -> WindCorrection
WindCorrection WindComponent
wc Double
etas' Vector'
hdg) (Double -> f Double
f Double
etas)

instance HasWindComponent WindCorrection where
  {-# INLINE windComponent #-}
  windComponent :: Lens' WindCorrection WindComponent
windComponent WindComponent -> f WindComponent
f (WindCorrection WindComponent
wc Double
etas Vector'
hdg) =
    (WindComponent -> WindCorrection)
-> f WindComponent -> f WindCorrection
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\WindComponent
wc' -> WindComponent -> Double -> Vector' -> WindCorrection
WindCorrection WindComponent
wc' Double
etas Vector'
hdg) (WindComponent -> f WindComponent
f WindComponent
wc)

instance HasVector WindCorrection Double where
  {-# INLINE vector #-}
  vector :: Lens' WindCorrection Vector'
vector Vector' -> f Vector'
f (WindCorrection WindComponent
wc Double
etas Vector'
hdg) =
    (Vector' -> WindCorrection) -> f Vector' -> f WindCorrection
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (WindComponent -> Double -> Vector' -> WindCorrection
WindCorrection WindComponent
wc Double
etas) (Vector' -> f Vector'
f Vector'
hdg)