WindCorrection.hs

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

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 ( printf, PrintfType )
import Data.String ( IsString, String )
import Data.Radian ( toRadians )
import Data.Aviation.Navigation.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.Show(Show)
import Prelude(Double, Num((-), (+), (*)), Fractional((/)), sqrt)
import System.IO ( IO, putStrLn )

data WindCorrection =
  WindCorrection
    WindComponent -- crosswind/headwind
    Double -- effective TAS
    Vector -- heading/ground speed
  deriving (Eq, Ord, Show)

calculateWindCorrection ::
  HasWindParameters s =>
  s
  -> WindCorrection
calculateWindCorrection wp =
  let square x = x * x
      pythagoras a b = sqrt (square a + square b)
      tas = view (trackTAS . magnitude) wp
      wc = calculateWindComponent wp
      hdg = view (trackTAS . angle) wp + view crosswind wc / tas
      emag = pythagoras tas (view crosswind wc)
      etas = square tas / emag
      gs = etas - view headwind wc
  in  WindCorrection wc etas (Vector hdg gs)

printWindCorrection ::
  (PrintfType a, IsString a, Semigroup a, HasWindCorrection s, HasWindComponent s, HasVector s) =>
  s
  -> a
printWindCorrection r =
  "Ground Speed   " <> printf "%06.2f" (view magnitude r) <> " KT\n" <>
  "Effective TAS  " <> printf "%06.2f" (view effectiveTAS r) <> " KT\n" <>
  "Heading        " <> printf "%06.2f" (view (angle . toRadians) r) <> " °\n" <>
  "Crosswind      " <> printf "%06.2f" (view crosswind r) <> " KT\n" <>
  "Headwind       " <> printf "%06.2f" (view headwind r) <> " KT"

run ::
  String
  -> IO ()
run v =
  let desc =
        "Aviation Navigation wind-correction (" <> v <> ")"
      execopts =
        execParser
          (info (optWindParametersVersion <**> helper) (
            fullDesc <>
            header desc
          )
        )
  in  do  conf' <- execopts
          putStrLn $
            case conf' of
              Nothing ->
                desc
              Just wp ->
                printWindCorrection (calculateWindCorrection wp)

class HasWindCorrection a where
  windCorrection ::
    Lens' a WindCorrection
  {-# INLINE effectiveTAS #-}
  effectiveTAS ::
    Lens' a Double
  effectiveTAS =
    windCorrection . effectiveTAS

instance HasWindCorrection WindCorrection where
  windCorrection =
    id
  {-# INLINE effectiveTAS #-}
  effectiveTAS f (WindCorrection wc etas hdg) =
    fmap (\etas' -> WindCorrection wc etas' hdg) (f etas)

instance HasWindComponent WindCorrection where
  {-# INLINE windComponent #-}
  windComponent f (WindCorrection wc etas hdg) =
    fmap (\wc' -> WindCorrection wc' etas hdg) (f wc)

instance HasVector WindCorrection where
  {-# INLINE vector #-}
  vector f (WindCorrection wc etas hdg) =
    fmap (\hdg' -> WindCorrection wc etas hdg') (f hdg)