aviation-navigation 0.1.0.0 → 0.1.0.1
raw patch · 6 files changed
+104/−80 lines, 6 filesdep ~mtldep ~optparse-applicative
Dependency ranges changed: mtl, optparse-applicative
Files
- aviation-navigation.cabal +14/−11
- changelog.md +5/−0
- src/Data/Aviation/Navigation/Vector.hs +23/−19
- src/Data/Aviation/Navigation/WindComponent.hs +7/−6
- src/Data/Aviation/Navigation/WindCorrection.hs +28/−25
- src/Data/Aviation/Navigation/WindParameters.hs +27/−19
@@ -1,23 +1,26 @@ name: aviation-navigation-version: 0.1.0.0+version: 0.1.0.1 synopsis: Aviation Navigation functions-description: Aviation Navigation functions e.g. wind correction+description:+ Aviation Navigation functions e.g. wind correction+ .+ <<https://i.imgur.com/9puyzYK.gif>> license: BSD3 license-file: LICENCE author: Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ> maintainer: Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ>-copyright: Copyright (C) 2021 Tony Morris+copyright: Copyright (C) 2021-2025 Tony Morris category: Test build-type: Simple extra-source-files: changelog.md cabal-version: >=1.10-homepage: https://gitlab.com/tonymorris/aviation-navigation-bug-reports: https://gitlab.com/tonymorris/aviation-navigation/issues-tested-with: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.3, GHC == 8.6.5+homepage: https://gitlab.com/system-f/code/aviation-navigation+bug-reports: https://gitlab.com/system-f/code/aviation-navigation/issues+tested-with: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.3, GHC == 8.6.5, GHC == 9.4.8, GHC == 9.6.7 source-repository head type: git- location: git@github.com:tonymorris/aviation-navigation.git+ location: git@github.com:system-f/code/aviation-navigation.git library exposed-modules: Data.Aviation.Navigation@@ -28,9 +31,9 @@ build-depends: base >= 4.8 && < 6 , lens >= 4 && < 6- , mtl >= 2.2 && < 2.3+ , mtl >= 2.2 && < 3 , radian >= 0.2 && < 1- , optparse-applicative > 0.14 && < 0.15+ , optparse-applicative > 0.14 && < 1 hs-source-dirs: src default-language: Haskell2010@@ -45,9 +48,9 @@ build-depends: base >= 4.8 && < 6 , lens >= 4 && < 6- , mtl >= 2.2 && < 2.3+ , mtl >= 2.2 && < 3 , radian >= 0.2 && < 1- , optparse-applicative > 0.14 && < 0.15+ , optparse-applicative > 0.14 && < 1 , aviation-navigation hs-source-dirs: exe/wind-correction
changelog.md view
@@ -1,3 +1,8 @@+0.1.0.1++* Update version bounds+* Updates to code+ 0.1.0.0 * The initial version of aviation-navigation.
@@ -1,8 +1,11 @@ {-# OPTIONS_GHC -Wall #-} {-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-} module Data.Aviation.Navigation.Vector( Vector(..)+, Vector' , vectorDegrees , HasVector(..) ) where@@ -15,23 +18,25 @@ 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(Double, Num((*), (-), (+)), Fractional((/)), sqrt, atan, sin, cos, pi)+import Prelude(Num((*), (-), (+)), Fractional((/))) -data Vector =- Vector- Double -- angle- Double -- magnitude+data Vector a =+ Vector a a deriving (Eq, Ord, Show) +type Vector' =+ Vector Double+ vectorDegrees :: Double -> Double- -> Vector+ -> Vector' vectorDegrees = Vector . view fromRadians -instance Semigroup Vector where+instance Floating a => Semigroup (Vector a) where Vector aa am <> Vector ba bm = let square x = x * x t = aa - ba@@ -39,30 +44,29 @@ ang = atan (bm * sin t / (am + bm * cos t)) in Vector (aa - ang) mag -instance Monoid Vector where+instance Floating a => Monoid (Vector a) where mempty = Vector 0 0 -class HasVector a where+class HasVector a c | a -> c where vector ::- Lens' a Vector+ Lens' a (Vector c) {-# INLINE angle #-} angle ::- Lens' a Double+ Lens' a c angle = vector . angle {-# INLINE magnitude #-} magnitude ::- Lens' a Double+ Lens' a c magnitude = vector . magnitude -instance HasVector Vector where- vector =- id+instance HasVector (Vector a) a where+ vector = id {-# INLINE angle #-}- angle f (Vector a m) =- fmap (\a' -> Vector a' m) (f a)+ angle f (Vector x y) =+ fmap (`Vector` y) (f x) {-# INLINE magnitude #-}- magnitude f (Vector a m) =- fmap (\m' -> Vector a m') (f m)+ magnitude f (Vector a y) =+ fmap (Vector a) (f y)
@@ -1,5 +1,6 @@ {-# OPTIONS_GHC -Wall #-} {-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE FlexibleContexts #-} module Data.Aviation.Navigation.WindComponent( WindComponent(..)@@ -12,7 +13,7 @@ import Data.Aviation.Navigation.Vector ( HasVector(magnitude, angle) ) import Data.Aviation.Navigation.WindParameters- ( HasWindParameters(windParameters, trackTAS, windSpeedDirection) )+ ( HasWindParameters(windParameters, trackTAS, windDirSpeed) ) import Data.Eq ( Eq ) import Data.Functor ( Functor(fmap) ) import Data.Ord ( Ord )@@ -44,18 +45,18 @@ id {-# INLINE crosswind #-} crosswind f (WindComponent c h) =- fmap (\c' -> WindComponent c' h) (f c)+ fmap (`WindComponent` h) (f c) {-# INLINE headwind #-} headwind f (WindComponent c h) =- fmap (\h' -> WindComponent c h') (f h)+ fmap (WindComponent c) (f h) calculateWindComponent ::- HasWindParameters s =>- s+ HasWindParameters a Double =>+ a -> WindComponent calculateWindComponent wp = let t = view (windParameters . trackTAS) wp- w = view (windParameters . windSpeedDirection) wp+ w = view (windParameters . windDirSpeed) wp diff = view angle w - view angle t wm = view magnitude w cw = wm * sin diff
@@ -1,6 +1,8 @@ {-# OPTIONS_GHC -Wall #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleContexts #-} module Data.Aviation.Navigation.WindCorrection( WindCorrection(..)@@ -14,11 +16,11 @@ import Control.Lens ( view, Lens' ) import Options.Applicative ( (<**>), fullDesc, header, info, execParser, helper )-import Text.Printf ( printf, PrintfType )+import Text.Printf ( PrintfArg, printf, PrintfType ) import Data.String ( IsString, String ) import Data.Radian ( toRadians ) import Data.Aviation.Navigation.Vector- ( Vector(..), HasVector(..) )+ ( Vector(..), Vector', HasVector(..) ) import Data.Aviation.Navigation.WindComponent ( WindComponent, HasWindComponent(windComponent, headwind, crosswind), calculateWindComponent ) import Data.Aviation.Navigation.WindParameters@@ -29,42 +31,43 @@ 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(Double, Num((-), (+), (*)), Fractional((/)), sqrt)+import Prelude(Num((-), (+), (*)), Fractional((/))) import System.IO ( IO, putStrLn ) data WindCorrection = WindCorrection WindComponent -- crosswind/headwind- Double -- effective TAS- Vector -- heading/ground speed+ Double -- TAS+ Vector' -- heading/ground speed deriving (Eq, Ord, Show) calculateWindCorrection ::- HasWindParameters s =>- s+ HasWindParameters a Double =>+ a -> WindCorrection calculateWindCorrection wp = let square x = x * x pythagoras a b = sqrt (square a + square b)- tas = view (trackTAS . magnitude) wp+ 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+ 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) =>+ (PrintfType a, IsString a, Semigroup a, HasWindCorrection s, HasWindComponent s, PrintfArg x, Floating x, HasVector s x) => 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"+ "Effective TAS " <> printf "% 6.2f" (view tas r) <> "KT\n" <>+ "Ground Speed " <> printf "% 6.2f" (view magnitude r) <> "KT\n" <>+ "Heading " <> printf "% 6.2f" (view (angle . toRadians) r) <> "°\n" <>+ "Crosswind " <> printf "% 6.2f" (view crosswind r) <> "KT\n" <>+ "Headwind " <> printf "% 6.2f" (view headwind r) <> "KT" run :: String@@ -90,17 +93,17 @@ class HasWindCorrection a where windCorrection :: Lens' a WindCorrection- {-# INLINE effectiveTAS #-}- effectiveTAS ::+ {-# INLINE tas #-}+ tas :: Lens' a Double- effectiveTAS =- windCorrection . effectiveTAS+ tas =+ windCorrection . tas instance HasWindCorrection WindCorrection where windCorrection = id- {-# INLINE effectiveTAS #-}- effectiveTAS f (WindCorrection wc etas hdg) =+ {-# INLINE tas #-}+ tas f (WindCorrection wc etas hdg) = fmap (\etas' -> WindCorrection wc etas' hdg) (f etas) instance HasWindComponent WindCorrection where@@ -108,7 +111,7 @@ windComponent f (WindCorrection wc etas hdg) = fmap (\wc' -> WindCorrection wc' etas hdg) (f wc) -instance HasVector WindCorrection where+instance HasVector WindCorrection Double where {-# INLINE vector #-} vector f (WindCorrection wc etas hdg) =- fmap (\hdg' -> WindCorrection wc etas hdg') (f hdg)+ fmap (WindCorrection wc etas) (f hdg)
@@ -1,8 +1,11 @@ {-# OPTIONS_GHC -Wall #-} {-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-} module Data.Aviation.Navigation.WindParameters ( WindParameters(..)+, WindParameters' , HasWindParameters(..) , optWindParameters , optWindParametersVersion@@ -10,7 +13,8 @@ import Control.Category ( Category(id, (.)) ) import Control.Lens ( Lens' )-import Data.Aviation.Navigation.Vector ( Vector, vectorDegrees )+import Data.Aviation.Navigation.Vector+ ( Vector, vectorDegrees ) import Data.Eq ( Eq ) import Data.Functor ( Functor(fmap), (<$>) ) import Data.Maybe ( Maybe(Just, Nothing) )@@ -28,39 +32,43 @@ option, short, Parser )+import Prelude(Double) -data WindParameters =+data WindParameters a = WindParameters- Vector -- TAS, trk- Vector -- wind speed/dir+ (Vector a) -- trk, TAS+ (Vector a) -- wind direction, wind speed deriving (Eq, Ord, Show) -class HasWindParameters a where+type WindParameters' =+ WindParameters Double++class HasWindParameters a c | a -> c where windParameters ::- Lens' a WindParameters+ Lens' a (WindParameters c) {-# INLINE trackTAS #-} trackTAS ::- Lens' a Vector+ Lens' a (Vector c) trackTAS = windParameters . trackTAS- {-# INLINE windSpeedDirection #-}- windSpeedDirection ::- Lens' a Vector- windSpeedDirection =- windParameters . windSpeedDirection+ {-# INLINE windDirSpeed #-}+ windDirSpeed ::+ Lens' a (Vector c)+ windDirSpeed =+ windParameters . windDirSpeed -instance HasWindParameters WindParameters where+instance HasWindParameters (WindParameters a) a 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)+ fmap (`WindParameters` wsd) (f tt)+ {-# INLINE windDirSpeed #-}+ windDirSpeed f (WindParameters tt wsd) =+ fmap (WindParameters tt) (f wsd) optWindParameters ::- Parser WindParameters+ Parser WindParameters' optWindParameters = (\trk tas wd ws -> WindParameters (vectorDegrees trk tas) (vectorDegrees wd ws)) <$> option auto (@@ -92,7 +100,7 @@ ) optWindParametersVersion ::- Parser (Maybe WindParameters)+ Parser (Maybe WindParameters') optWindParametersVersion = flag' Nothing