aviation-navigation (empty) → 0.1.0.0
raw patch · 10 files changed
+468/−0 lines, 10 filesdep +aviation-navigationdep +basedep +lenssetup-changed
Dependencies added: aviation-navigation, base, lens, mtl, optparse-applicative, radian
Files
- LICENCE +30/−0
- Setup.hs +2/−0
- aviation-navigation.cabal +57/−0
- changelog.md +3/−0
- exe/wind-correction/Main.hs +16/−0
- src/Data/Aviation/Navigation.hs +11/−0
- src/Data/Aviation/Navigation/Vector.hs +68/−0
- src/Data/Aviation/Navigation/WindComponent.hs +63/−0
- src/Data/Aviation/Navigation/WindCorrection.hs +114/−0
- src/Data/Aviation/Navigation/WindParameters.hs +104/−0
+ LICENCE view
@@ -0,0 +1,30 @@+Copyright (c) 2021 Tony Morris++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Tony Morris nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
@@ -0,0 +1,57 @@+name: aviation-navigation+version: 0.1.0.0+synopsis: Aviation Navigation functions+description: Aviation Navigation functions e.g. wind correction+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+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++source-repository head+ type: git+ location: git@github.com:tonymorris/aviation-navigation.git++library+ exposed-modules: Data.Aviation.Navigation+ Data.Aviation.Navigation.WindComponent+ Data.Aviation.Navigation.WindCorrection+ Data.Aviation.Navigation.WindParameters+ Data.Aviation.Navigation.Vector++ build-depends: base >= 4.8 && < 6+ , lens >= 4 && < 6+ , mtl >= 2.2 && < 2.3+ , radian >= 0.2 && < 1+ , optparse-applicative > 0.14 && < 0.15++ hs-source-dirs: src+ default-language: Haskell2010+ ghc-options: -Wall++executable wind-correction+ other-modules: Data.Aviation.Navigation+ Data.Aviation.Navigation.WindComponent+ Data.Aviation.Navigation.WindCorrection+ Data.Aviation.Navigation.WindParameters+ Data.Aviation.Navigation.Vector++ build-depends: base >= 4.8 && < 6+ , lens >= 4 && < 6+ , mtl >= 2.2 && < 2.3+ , radian >= 0.2 && < 1+ , optparse-applicative > 0.14 && < 0.15+ , aviation-navigation++ hs-source-dirs: exe/wind-correction+ src+ default-language: Haskell2010+ main-is: Main.hs+ ghc-options: -Wall
+ changelog.md view
@@ -0,0 +1,3 @@+0.1.0.0++* The initial version of aviation-navigation.
+ exe/wind-correction/Main.hs view
@@ -0,0 +1,16 @@+{-# OPTIONS_GHC -Wall #-}++{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE CPP #-}++module Main(+ main+) where++import Data.Aviation.Navigation ( run )+import Prelude++main ::+ IO ()+main =+ run VERSION_aviation_navigation
@@ -0,0 +1,11 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Data.Aviation.Navigation(+ module T+) where++import Data.Aviation.Navigation.Vector as T+import Data.Aviation.Navigation.WindComponent as T+import Data.Aviation.Navigation.WindCorrection as T+import Data.Aviation.Navigation.WindParameters as T
@@ -0,0 +1,68 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Data.Aviation.Navigation.Vector(+ Vector(..)+, vectorDegrees+, HasVector(..)+) where++import Control.Category ( Category(id, (.)) )+import Control.Lens ( view, Lens' )+import Data.Eq ( Eq )+import Data.Functor ( Functor(fmap) )+import Data.Monoid ( Monoid(mempty) )+import Data.Ord ( Ord )+import Data.Radian ( fromRadians )+import Data.Semigroup ( Semigroup((<>)) )+import GHC.Show(Show)+import Prelude(Double, Num((*), (-), (+)), Fractional((/)), sqrt, atan, sin, cos, pi)++data Vector =+ Vector+ Double -- angle+ Double -- magnitude+ deriving (Eq, Ord, Show)++vectorDegrees ::+ Double+ -> Double+ -> Vector+vectorDegrees =+ Vector . view fromRadians++instance Semigroup Vector where+ Vector aa am <> Vector ba bm =+ let square x = x * x+ t = aa - ba+ mag = sqrt (square am + square bm - 2 * am * bm * cos (pi - t))+ ang = atan (bm * sin t / (am + bm * cos t))+ in Vector (aa - ang) mag++instance Monoid Vector where+ mempty =+ Vector 0 0++class HasVector a where+ vector ::+ Lens' a Vector+ {-# INLINE angle #-}+ angle ::+ Lens' a Double+ angle =+ vector . angle+ {-# INLINE magnitude #-}+ magnitude ::+ Lens' a Double+ magnitude =+ vector . magnitude++instance HasVector Vector where+ vector =+ id+ {-# INLINE angle #-}+ angle f (Vector a m) =+ fmap (\a' -> Vector a' m) (f a)+ {-# INLINE magnitude #-}+ magnitude f (Vector a m) =+ fmap (\m' -> Vector a m') (f m)
@@ -0,0 +1,63 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Data.Aviation.Navigation.WindComponent(+ WindComponent(..)+, HasWindComponent(..)+, calculateWindComponent+) where++import Control.Category ( Category(id, (.)) )+import Control.Lens ( view, Lens' )+import Data.Aviation.Navigation.Vector+ ( HasVector(magnitude, angle) )+import Data.Aviation.Navigation.WindParameters+ ( HasWindParameters(windParameters, trackTAS, windSpeedDirection) )+import Data.Eq ( Eq )+import Data.Functor ( Functor(fmap) )+import Data.Ord ( Ord )+import GHC.Show(Show)+import Prelude(Double, Num((*), (-)), sin, cos)++data WindComponent =+ WindComponent+ Double+ Double+ deriving (Eq, Ord, Show)++class HasWindComponent a where+ windComponent ::+ Lens' a WindComponent+ {-# INLINE crosswind #-}+ crosswind ::+ Lens' a Double+ crosswind =+ windComponent . crosswind+ {-# INLINE headwind #-}+ headwind ::+ Lens' a Double+ headwind =+ windComponent . headwind++instance HasWindComponent WindComponent where+ windComponent =+ id+ {-# INLINE crosswind #-}+ crosswind f (WindComponent c h) =+ fmap (\c' -> WindComponent c' h) (f c)+ {-# INLINE headwind #-}+ headwind f (WindComponent c h) =+ fmap (\h' -> WindComponent c h') (f h)++calculateWindComponent ::+ HasWindParameters s =>+ s+ -> WindComponent+calculateWindComponent wp =+ let t = view (windParameters . trackTAS) wp+ w = view (windParameters . windSpeedDirection) wp+ diff = view angle w - view angle t+ wm = view magnitude w+ cw = wm * sin diff+ hw = wm * cos diff+ in WindComponent cw hw
@@ -0,0 +1,114 @@+{-# 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)
@@ -0,0 +1,104 @@+{-# 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