stratux-demo (empty) → 0.0.12
raw patch · 5 files changed
+370/−0 lines, 5 filesdep +basedep +lensdep +network-urisetup-changed
Dependencies added: base, lens, network-uri, optparse-applicative, stratux, stratux-demo, text, time, transformers
Files
- LICENCE +27/−0
- Setup.hs +2/−0
- src/Data/Aviation/Stratux/Demo.hs +260/−0
- src/Main.hs +14/−0
- stratux-demo.cabal +67/−0
+ LICENCE view
@@ -0,0 +1,27 @@+Copyright 2016 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:+1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+2. 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.+3. Neither the name of the author nor the names of his contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS 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 AUTHORS 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
+ src/Data/Aviation/Stratux/Demo.hs view
@@ -0,0 +1,260 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE CPP #-}++module Data.Aviation.Stratux.Demo where++import Control.Applicative(pure, (<*>), (<**>))+import Control.Category((.))+import Control.Concurrent(threadDelay)+import Control.Lens((^.), makeClassy)+import Control.Monad(forever, join)+import Control.Monad.IO.Class(MonadIO(liftIO))+import Control.Monad.Trans.Except(runExceptT)+import Data.Aviation.Stratux+import Data.Bool(Bool, bool)+import Data.Either(either)+import Data.String(String)+import Data.Eq(Eq((==)))+import Data.Function(($))+import Data.Functor((<$>))+import Data.Int(Int)+import Data.List((++))+import Data.Maybe(Maybe(Just, Nothing))+import Data.Ord(Ord)+import Data.Semigroup((<>))+import Data.Text(Text)+import Network.URI(URIAuth(URIAuth))+import Prelude(Show(show))+import System.IO(IO, putStrLn)+import Text.Printf(printf)+import Options.Applicative(Parser, execParser, info, helper, fullDesc, header, option, maybeReader, short, long, value, help, strOption, switch, metavar, auto, showDefault)++hdr ::+ Bool+ -> String+ -> String+hdr nc s =+ bool+ (join ["\ESC[92m\ESC[42m", s, "\ESC[m"])+ s+ nc++val ::+ Bool+ -> String+ -> String+val nc s =+ bool+ (join ["\ESC[38m\ESC[41m", s, "\ESC[m"])+ s+ nc++----++demoSituation ::+ HasSituation s =>+ Bool+ -> s+ -> String+demoSituation nc = + let hdr' = hdr nc+ val' = val nc+ in do pa <- (^. pressureAlt)+ pc <- (^. pitch)+ rl <- (^. roll)+ hd <- (^. gyroHeading)+ lt <- (^. lat)+ ln <- (^. lon)+ vs <- (^. gpsVertVel)+ ht <- (^. heightAboveEllipsoid)+ cs <- (^. trueCourse)+ gs <- (^. groundSpeed)+ pure (join [+ hdr' "p.alt: "+ , val' (printf "%*.2fft" (8 :: Int) pa)+ , hdr' " pitch: "+ , val' (printf "%*.2fdeg" (7 :: Int) pc)+ , hdr' " roll: "+ , val' (printf "%*.2fdeg" (7 :: Int) rl)+ , hdr' " hdg: "+ , val' (printf "%*.2fdeg" (7 :: Int) hd)+ , hdr' " lat: " + , val' (printf "%*.4f" (8 :: Int) lt)+ , hdr' " lon: "+ , val' (printf "%*.4f" (9 :: Int) ln)+ , hdr' " v.speed: "+ , val' (printf "%*.2fft/min" (9 :: Int) vs)+ , hdr' " hgt: "+ , val' (printf "%*.2fft" (8 :: Int) ht)+ , hdr' " tr: "+ , val' (printf "%*.2fdeg" (6 :: Int) cs)+ , hdr' " g.speed: "+ , val' (printf "%*dkt" (3 :: Int) gs) + ])+ +printloop ::+ MonadIO f =>+ Int+ -> f String+ -> f ()+printloop d x =+ forever $+ do a <- x+ liftIO (putStrLn a)+ liftIO (threadDelay d)++----++demoAirTraffic ::+ HasTraffic s =>+ Bool+ -> s+ -> String+demoAirTraffic nc =+ let hdr' = hdr nc+ val' = val nc+ in do t <- (^. tail)+ s <- (^. signalLevel)+ l <- (^. latitude)+ g <- (^. longitude)+ a <- (^. altitude)+ p <- (^. speed)+ v <- (^. verticalVelocity)+ x <- (^. timestamp)+ pure (join [+ hdr' "flight: "+ , val' (printf "%*s" (6 :: Int) t)+ , hdr' " power: "+ , val' (printf "%*.2f dB" (6 :: Int) s)+ , hdr' " lat: " + , val' (printf "%*.4f" (8 :: Int) l)+ , hdr' " lon: "+ , val' (printf "%*.4f" (9 :: Int) g)+ , hdr' " alt: "+ , val' (printf "%*dft" (5 :: Int) a)+ , hdr' " velocity: "+ , val' (printf "%*dkt" (3 :: Int) p)+ , hdr' " v/velocity: "+ , val' (printf "%*dft/min" (6 :: Int) v)+ , hdr' " time: "+ , val' (printf "%*s" (27 :: Int) (show x))+ ])++data DemoType =+ SituationDemo+ | TrafficDemo+ deriving (Eq, Ord)++instance Show DemoType where+ show SituationDemo =+ "situation"+ show TrafficDemo =+ "traffic"++data StratuxConfig =+ StratuxConfig {+ _demohost ::+ String+ , _demoport ::+ Int+ , _delay ::+ Int+ , _dtype ::+ DemoType+ , _nocolours ::+ Bool+ } deriving (Eq, Ord, Show)++parserDemoType ::+ Parser DemoType+parserDemoType =+ option+ (+ maybeReader+ (\s ->+ bool+ (+ bool+ Nothing+ (Just TrafficDemo)+ (s == "traffic")+ )+ (Just SituationDemo)+ (s == "situation")+ )+ )+ (+ short 'm' <>+ long "demo" <>+ value SituationDemo <>+ showDefault <>+ help "which demo" <>+ metavar "<situation|traffic>"+ )++parserStratuxConfig ::+ Parser StratuxConfig+parserStratuxConfig =+ StratuxConfig <$>+ strOption+ (+ short 'h' <>+ long "host" <>+ help "the host name" <>+ metavar "HOSTNAME"+ ) <*>+ option auto+ ( + short 'p' <>+ long "port" <>+ help "The host port" <>+ showDefault <>+ value 80 <>+ metavar "INT"+ ) <*>+ option auto+ ( + short 'd' <>+ long "delay" <>+ help "The delay between reading from the stratux device (milliseconds)" <>+ showDefault <>+ value 4000 <>+ metavar "INT"+ ) <*>+ parserDemoType <*>+ switch+ (+ short 'c' <>+ long "no-colours" <>+ help "terminal colours off"+ )++makeClassy ''StratuxConfig++run ::+ IO ()+run =+ let execopts =+ execParser+ (info (parserStratuxConfig <**> helper) (+ fullDesc <>+ header ("stratux-demo " <> VERSION_stratux_demo <> "demonstrates situation and traffic given by stratux <https://stratux.me/>")+ )+ )+ in do c <- execopts+ case c ^. dtype of+ SituationDemo ->+ printloop+ (c ^. delay)+ (either ("Error: " ++) (demoSituation (c ^. nocolours)) <$> runExceptT (getSituation (URIAuth (c ^. demohost) "" (':' : show (c ^. demoport))) "" ""))+ TrafficDemo ->+ trafficApp+ (c ^. demohost)+ (c ^. demoport) (+ either+ (\e ->+ putStrLn ("Error: " ++ e))+ (putStrLn . demoAirTraffic (c ^. nocolours))+ )+ ("" :: Text)
+ src/Main.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-}++module Main(+ main+) where++import Data.Aviation.Stratux.Demo(run)++main ::+ IO ()+main =+ run
+ stratux-demo.cabal view
@@ -0,0 +1,67 @@+name: stratux-demo+version: 0.0.12+license: BSD3+license-file: LICENCE+author: Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ>+maintainer: Tony Morris+copyright: Copyright (C) 2016 Tony Morris+synopsis: A demonstration of the stratux library.+category: Aviation, ADSB, Stratux+description: A demonstration of the stratux library <http://stratux.me/>+homepage: https://gitlab.com/stratux/stratux-demo+bug-reports: https://gitlab.com/stratux/stratux-demo/issues+cabal-version: >= 1.10+build-type: Simple+source-repository head+ type: git+ location: git@gitlab.com:stratux/stratux-demo.git++library+ default-language:+ Haskell2010++ build-depends:+ base >= 4 && < 6+ , lens >= 4.0 && < 5.0 + , network-uri >= 2.6 && < 3.0+ , optparse-applicative >= 0.13.2 && < 1+ , stratux == 0.0.12+ , transformers >= 0.4 && < 1.0+ , text >= 1.2 && < 2.0+ , time >= 1.4 && < 2.0+ , text >= 1.2 && < 2.0++ ghc-options:+ -Wall++ default-extensions:+ NoImplicitPrelude++ hs-source-dirs:+ src++ exposed-modules:+ Data.Aviation.Stratux.Demo++executable stratux-demo+ default-language: Haskell2010++ hs-source-dirs: src++ main-is: Main.hs++ build-depends: base >= 4 && < 6+ , lens >= 4.0 && < 5.0 + , network-uri >= 2.6 && < 3.0+ , optparse-applicative >= 0.13.2 && < 1+ , stratux == 0.0.12+ , transformers >= 0.4 && < 1.0+ , text >= 1.2 && < 2.0+ , time >= 1.4 && < 2.0+ , text >= 1.2 && < 2.0+ , stratux-demo++ other-modules:+ Data.Aviation.Stratux.Demo++ ghc-options: -Wall