WindParameters.hs

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

module Data.Aviation.Navigation.WindParameters (
  WindParameters(..)
, HasWindParameters(..)
, optWindParameters
, optWindParametersVersion
) where

import Control.Category ( Category(id, (.)) )
import Control.Lens ( Lens' )
import Data.Aviation.Navigation.Vector ( Vector, vectorDegrees )
import Data.Eq ( Eq )
import Data.Functor ( Functor(fmap), (<$>) )
import Data.Maybe ( Maybe(Just, Nothing) )
import Data.Ord ( Ord )
import Data.Semigroup((<>))
import GHC.Show(Show)
import Options.Applicative
    ( Applicative((<*>)),
      Alternative((<|>)),
      auto,
      flag',
      help,
      long,
      metavar,
      option,
      short,
      Parser )

data WindParameters =
  WindParameters
    Vector -- TAS, trk
    Vector -- wind speed/dir
  deriving (Eq, Ord, Show)

class HasWindParameters a where
  windParameters ::
    Lens' a WindParameters
  {-# INLINE trackTAS #-}
  trackTAS ::
    Lens' a Vector
  trackTAS =
    windParameters . trackTAS
  {-# INLINE windSpeedDirection #-}
  windSpeedDirection ::
    Lens' a Vector
  windSpeedDirection =
    windParameters . windSpeedDirection

instance HasWindParameters WindParameters where
  windParameters =
    id
  {-# INLINE trackTAS #-}
  trackTAS f (WindParameters tt wsd) =
    fmap (\tt' -> WindParameters tt' wsd) (f tt)
  {-# INLINE windSpeedDirection #-}
  windSpeedDirection f (WindParameters tt wsd) =
    fmap (\wsd' -> WindParameters tt wsd') (f wsd)

optWindParameters ::
  Parser WindParameters
optWindParameters =
  (\trk tas wd ws -> WindParameters (vectorDegrees trk tas) (vectorDegrees wd ws)) <$>
    option auto (
      long "trk" <>
      short 't' <>
      metavar "TRACK" <>
      help "Track Direction °"
    )
    <*>
    option auto (
      long "tas" <>
      short 'a' <>
      metavar "TRUE_AIRSPEED" <>
      help "True Air Speed kt"
    )
    <*>
    option auto (
      long "wd" <>
      short 'd' <>
      metavar "WIND_DIRECTION" <>
      help "Wind Direction °"
    )
    <*>
    option auto (
      long "ws" <>
      short 's' <>
      metavar "WIND_SPEED" <>
      help "Wind Speed kt"
    )

optWindParametersVersion ::
  Parser (Maybe WindParameters)
optWindParametersVersion =
  flag'
    Nothing
    (
      short 'v' <>
      long "version" <>
      help "the program version"
    ) <|>
    Just <$> optWindParameters