{-# 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