diff --git a/LICENCE b/LICENCE new file mode 100644 --- /dev/null +++ b/LICENCE @@ -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. diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,44 @@ +#!/usr/bin/env runhaskell +\begin{code} +{-# OPTIONS_GHC -Wall #-} +module Main (main) where + +import Data.List ( nub ) +import Data.Version ( showVersion ) +import Distribution.Package ( PackageName(PackageName), PackageId, InstalledPackageId, packageVersion, packageName ) +import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) ) +import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks ) +import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose ) +import Distribution.Simple.BuildPaths ( autogenModulesDir ) +import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), fromFlag ) +import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) ) +import Distribution.Verbosity ( Verbosity ) +import System.FilePath ( () ) + +main :: IO () +main = defaultMainWithHooks simpleUserHooks + { buildHook = \pkg lbi hooks flags -> do + generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi + buildHook simpleUserHooks pkg lbi hooks flags + } + +generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO () +generateBuildModule verbosity pkg lbi = do + let dir = autogenModulesDir lbi + createDirectoryIfMissingVerbose verbosity True dir + withLibLBI pkg lbi $ \_ libcfg -> do + withTestLBI pkg lbi $ \suite suitecfg -> do + rewriteFile (dir "Build_" ++ testName suite ++ ".hs") $ unlines + [ "module Build_" ++ testName suite ++ " where" + , "deps :: [String]" + , "deps = " ++ (show $ formatdeps (testDeps libcfg suitecfg)) + ] + where + formatdeps = map (formatone . snd) + formatone p = case packageName p of + PackageName n -> n ++ "-" ++ showVersion (packageVersion p) + +testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)] +testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys + +\end{code} diff --git a/changelog.md b/changelog.md new file mode 100644 --- /dev/null +++ b/changelog.md @@ -0,0 +1,3 @@ +0.0.1 + +Initial. diff --git a/src/Data/Aviation/Stratux.hs b/src/Data/Aviation/Stratux.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Stratux.hs @@ -0,0 +1,5 @@ +module Data.Aviation.Stratux( + module S +) where + +import Data.Aviation.Stratux.Types as S diff --git a/src/Data/Aviation/Stratux/Types.hs b/src/Data/Aviation/Stratux/Types.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Stratux/Types.hs @@ -0,0 +1,8 @@ +module Data.Aviation.Stratux.Types( + module T +) where + +import Data.Aviation.Stratux.Types.EmitterCategory as T +import Data.Aviation.Stratux.Types.IcaoAddr as T +import Data.Aviation.Stratux.Types.TargetType as T +import Data.Aviation.Stratux.Types.Traffic as T diff --git a/src/Data/Aviation/Stratux/Types/EmitterCategory.hs b/src/Data/Aviation/Stratux/Types/EmitterCategory.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Stratux/Types/EmitterCategory.hs @@ -0,0 +1,147 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Data.Aviation.Stratux.Types.EmitterCategory( + EmitterCategory(..) +, AsEmitterCategory(..) +, AsEmitterCategoryNum(..) +) where + +import Control.Category(Category(id)) +import Control.Lens(Prism', prism', makeClassyPrisms, (^?), ( # )) +import Control.Monad(mzero, Monad(return)) +import Data.Aeson(FromJSON(parseJSON), ToJSON(toJSON), Value(Number), withScientific) +import Data.Eq(Eq) +import Data.Maybe(Maybe(Just, Nothing)) +import Data.Ord(Ord) +import Data.Scientific(Scientific) +import Prelude(Show, Num) + +-- $setup +-- >>> :set -XOverloadedStrings +-- >>> import Control.Lens +-- >>> import Data.Aeson(decode, encode) +-- >>> import Data.Maybe(Maybe) +-- >>> import Prelude + +-- https://i.imgur.com/cXYhzZM.png +data EmitterCategory = -- 0 to 7 + NoEmitterCategory + | Light -- < 15500lb + | Small -- 15500-75000lb + | Large -- 75000-300000lb + | HighVortexLarge -- B757 + | Heavy -- > 300000lb + | HighPerformance -- >5G accel @ > 400KIAS + | Rotorcraft + deriving (Eq, Ord, Show) + +makeClassyPrisms ''EmitterCategory + +class AsEmitterCategoryNum a where + _EmitterCategoryNum :: + (Num a, Eq a) => + Prism' + a + EmitterCategory + +instance AsEmitterCategoryNum EmitterCategory where + _EmitterCategoryNum = + id + +-- | +-- +-- >>> _EmitterCategoryNum # NoEmitterCategory :: Scientific +-- 0.0 +-- +-- >>> _EmitterCategoryNum # Light :: Scientific +-- 1.0 +-- +-- >>> _EmitterCategoryNum # HighVortexLarge :: Scientific +-- 4.0 +-- +-- >>> _EmitterCategoryNum # Rotorcraft :: Scientific +-- 7.0 +instance AsEmitterCategoryNum Scientific where + _EmitterCategoryNum = + emitterCategoryNum + +emitterCategoryNum :: + (Num a, Eq a) => + Prism' + a + EmitterCategory +emitterCategoryNum = + prism' + (\t -> case t of + NoEmitterCategory -> + 0 + Light -> + 1 + Small -> + 2 + Large -> + 3 + HighVortexLarge -> + 4 + Heavy -> + 5 + HighPerformance -> + 6 + Rotorcraft -> + 7) + (\n -> case n of + 0 -> + Just NoEmitterCategory + 1 -> + Just Light + 2 -> + Just Small + 3 -> + Just Large + 4 -> + Just HighVortexLarge + 5 -> + Just Heavy + 6 -> + Just HighPerformance + 7 -> + Just Rotorcraft + _ -> + Nothing) + +-- | +-- +-- >>> decode "0" :: Maybe EmitterCategory +-- Just NoEmitterCategory +-- +-- >>> decode "1" :: Maybe EmitterCategory +-- Just Light +-- +-- >>> decode "4" :: Maybe EmitterCategory +-- Just HighVortexLarge +-- +-- >>> decode "7" :: Maybe EmitterCategory +-- Just Rotorcraft +instance FromJSON EmitterCategory where + parseJSON = + withScientific "EmitterCategory" (\n -> case n ^? _EmitterCategoryNum of + Nothing -> + mzero + Just t -> + return t) +-- | +-- +-- >>> encode NoEmitterCategory +-- "0" +-- +-- >>> encode Light +-- "1" +-- +-- >>> encode HighVortexLarge +-- "4" +-- +-- >>> encode Rotorcraft +-- "7" +instance ToJSON EmitterCategory where + toJSON c = + Number (_EmitterCategoryNum # c) diff --git a/src/Data/Aviation/Stratux/Types/IcaoAddr.hs b/src/Data/Aviation/Stratux/Types/IcaoAddr.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Stratux/Types/IcaoAddr.hs @@ -0,0 +1,82 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Data.Aviation.Stratux.Types.IcaoAddr( + IcaoAddr(..) +, HasIcaoAddr(..) +, HasWord8s(..) +) where + +import Control.Applicative(Applicative((<*>))) +import Control.Category(Category(id)) +import Control.Lens(makeClassy, Traversal') +import Control.Monad(Monad(return)) +import Data.Aeson(FromJSON(parseJSON), ToJSON(toJSON), Value(Number), withScientific) +import Data.Bits(shiftR, shiftL, (.|.), (.&.)) +import Data.Eq(Eq) +import Data.Functor((<$>)) +import Data.Ord(Ord) +import Data.Word(Word8, Word) +import Prelude(floor, fromIntegral, Show, Num((*))) + +-- $setup +-- >>> :set -XOverloadedStrings +-- >>> import Control.Lens +-- >>> import Data.Aeson(decode, encode) +-- >>> import Data.Maybe(Maybe) +-- >>> import Prelude + +data IcaoAddr = + IcaoAddr { + _icaoAddrWord0 :: Word8 + , _icaoAddrWord1 :: Word8 + , _icaoAddrWord2 :: Word8 + } deriving (Eq, Ord, Show) + +makeClassy ''IcaoAddr + +-- | +-- +-- >>> decode "8153826" :: Maybe IcaoAddr +-- Just (IcaoAddr {_icaoAddrWord0 = 124, _icaoAddrWord1 = 106, _icaoAddrWord2 = 226}) +-- +-- >>> decode "66051" :: Maybe IcaoAddr +-- Just (IcaoAddr {_icaoAddrWord0 = 1, _icaoAddrWord1 = 2, _icaoAddrWord2 = 3}) +instance FromJSON IcaoAddr where + parseJSON = + withScientific "IcaoAddr" (\i -> + let r :: Word + r = floor i + w n = fromIntegral (shiftR r (n * 8) .&. 255) + in return (IcaoAddr (w 2) (w 1) (w 0))) + +-- | +-- +-- >>> encode (IcaoAddr 1 2 3) +-- "66051" +-- +-- >>> encode (IcaoAddr 124 106 226) +-- "8153826" +instance ToJSON IcaoAddr where + toJSON (IcaoAddr w0 w1 w2) = + Number (fromIntegral (shiftL (shiftL (fromIntegral w0 :: Word) 8 .|. fromIntegral w1) 8 .|. fromIntegral w2)) + +-- | +-- +-- >>> _Word8s %~ (+1) $ IcaoAddr 124 106 226 +-- IcaoAddr {_icaoAddrWord0 = 125, _icaoAddrWord1 = 107, _icaoAddrWord2 = 227} +-- +-- >>> _Word8s %~ (+1) $ IcaoAddr 1 2 3 +-- IcaoAddr {_icaoAddrWord0 = 2, _icaoAddrWord1 = 3, _icaoAddrWord2 = 4} +class HasWord8s a where + _Word8s :: + Traversal' + a + Word8 + +instance HasWord8s Word8 where + _Word8s = + id + +instance HasWord8s IcaoAddr where + _Word8s f (IcaoAddr w0 w1 w2) = + IcaoAddr <$> f w0 <*> f w1 <*> f w2 diff --git a/src/Data/Aviation/Stratux/Types/TargetType.hs b/src/Data/Aviation/Stratux/Types/TargetType.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Stratux/Types/TargetType.hs @@ -0,0 +1,126 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Data.Aviation.Stratux.Types.TargetType( + TargetType(..) +, AsTargetType(..) +, AsTargetTypeNum(..) +) where + +import Control.Category(Category(id)) +import Control.Lens(makeClassyPrisms, Prism', prism', (^?), ( # )) +import Control.Monad(Monad(return), mzero) +import Data.Aeson(FromJSON(parseJSON), ToJSON(toJSON), Value(Number), withScientific) +import Data.Eq(Eq) +import Data.Maybe +import Data.Ord(Ord) +import Data.Scientific(Scientific) +import Prelude(Num, Show) + +-- $setup +-- >>> :set -XOverloadedStrings +-- >>> import Control.Lens +-- >>> import Data.Aeson(decode, encode) +-- >>> import Data.Maybe(Maybe) +-- >>> import Prelude + +data TargetType = + ModeS + | Adsb + | Adsr + | TisbS + | Tisb + deriving (Eq, Ord, Show) + +makeClassyPrisms ''TargetType + +class AsTargetTypeNum a where + _TargetTypeNum :: + (Num a, Eq a) => + Prism' + a + TargetType + +instance AsTargetTypeNum TargetType where + _TargetTypeNum = + id + +-- | +-- +-- >>> _TargetTypeNum # ModeS :: Scientific +-- 0.0 +-- +-- >>> _TargetTypeNum # Adsb :: Scientific +-- 1.0 +-- +-- >>> _TargetTypeNum # Tisb :: Scientific +-- 4.0 +instance AsTargetTypeNum Scientific where + _TargetTypeNum = + targetTypeNum + +targetTypeNum :: + (Num a, Eq a) => + Prism' + a + TargetType +targetTypeNum = + prism' + (\t -> case t of + ModeS -> + 0 + Adsb -> + 1 + Adsr -> + 2 + TisbS -> + 3 + Tisb -> + 4) + (\n -> case n of + 0 -> + Just ModeS + 1 -> + Just Adsb + 2 -> + Just Adsr + 3 -> + Just TisbS + 4 -> + Just Tisb + _ -> + Nothing) + +-- | +-- +-- >>> decode "0" :: Maybe TargetType +-- Just ModeS +-- +-- >>> decode "1" :: Maybe TargetType +-- Just Adsb +-- +-- >>> decode "4" :: Maybe TargetType +-- Just Tisb +-- +-- >>> decode "5" :: Maybe TargetType +-- Nothing +instance FromJSON TargetType where + parseJSON = + withScientific "TargetType" (\n -> case n ^? targetTypeNum of + Nothing -> + mzero + Just t -> + return t) + +-- | +-- +-- >>> encode ModeS +-- "0" +-- +-- >>> encode Adsb +-- "1" +-- +-- >>> encode Tisb +-- "4" +instance ToJSON TargetType where + toJSON c = + Number (targetTypeNum # c) diff --git a/src/Data/Aviation/Stratux/Types/Traffic.hs b/src/Data/Aviation/Stratux/Types/Traffic.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Stratux/Types/Traffic.hs @@ -0,0 +1,186 @@ + {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE OverloadedStrings #-} + +module Data.Aviation.Stratux.Types.Traffic( + Traffic(..) +, HasTraffic(..) +, HasUTCTimes(..) +) where + +import Control.Applicative(Applicative((<*>))) +import Control.Category(Category((.), id)) +import Control.Lens(makeClassy, lens, Traversal') +import Data.Aviation.Stratux.Types.EmitterCategory(EmitterCategory) +import Data.Aviation.Stratux.Types.IcaoAddr(IcaoAddr, HasIcaoAddr(icaoAddr), HasWord8s(_Word8s)) +import Data.Aviation.Stratux.Types.TargetType(TargetType) +import Data.Aeson(FromJSON(parseJSON), ToJSON(toJSON), (.:), withObject, (.=), object) +import Data.Bool(Bool) +import Data.Eq(Eq) +import Data.Int(Int) +import Data.Functor((<$>)) +import Data.Ord(Ord) +import Data.String(String) +import Data.Time(UTCTime) +import Prelude(Double, Show) + +-- $setup +-- >>> :set -XOverloadedStrings +-- >>> import Control.Lens +-- >>> import Data.Aeson(decode, encode) +-- >>> import Data.Maybe(Maybe) +-- >>> import Prelude +-- >>> import Data.Aviation.Stratux.Types.EmitterCategory +-- >>> import Data.Aviation.Stratux.Types.IcaoAddr +-- >>> import Data.Aviation.Stratux.Types.TargetType +-- >>> import Data.Time + + +-- https://i.imgur.com/nOqGbfr.png +data Traffic = + Traffic { + icaoAddrTraffic :: IcaoAddr + , _tail :: String -- tail + , _emitterCategory :: EmitterCategory + , _onGround :: Bool -- on-ground + , _addressType :: Int -- address type + , _targetType :: TargetType + , _signalLevel :: Double -- signal level + , _positionValid :: Bool -- position valid + , _latitude :: Double -- latitude + , _longitude :: Double -- longitude + , _altitude :: Int -- altitude + , _gnssDiffFromBaroAlt :: Int -- GNSS altitude above WGS84 datum + , _altIsGnss :: Bool -- AltIsGNSS, Pressure alt = 0; GNSS alt = 1 + , _navigationIntegrityCategory :: Int -- Navigation Integrity Category. + , _navigationAccuracyCategoryForPosition :: Int -- Navigation Accuracy Category for Position + , _track :: Int -- Track degrees true + , _speed :: Int -- speed (knots) + , _speedValid :: Bool -- speed valid + , _verticalVelocity :: Int -- Vertical velocity (feet/minute) + , _timestamp :: UTCTime -- Timestamp + , _age :: Double -- age + , _lastSeen :: UTCTime -- last seen + , _lastAltitude :: UTCTime -- last altitude + , _lastGnssDiff :: UTCTime -- last GNSS diff + , _lastGnssDiffAltitude :: Int -- last GNSS diff altitude + , _lastSpeed :: UTCTime -- last speed + , _lastSource :: Int -- last source + , _extrapolatedPosition :: Bool -- extrapolated position + , _bearing :: Double -- Bearing in degrees true to traffic from ownship, if it can be calculated. + , _distanceToTrafficFromOwnship :: Double -- Distance to traffic from ownship, if it can be calculated. + } deriving (Eq, Ord, Show) + +makeClassy ''Traffic + +-- | +-- +-- >>> decode "{\"Icao_addr\":8153826,\"Tail\":\"SVY22\",\"Emitter_category\":1,\"OnGround\":false,\"Addr_type\":0,\"TargetType\":1,\"SignalLevel\":-30.920514783877277,\"Position_valid\":true,\"Lat\":-27.501154,\"Lng\":153.21422,\"Alt\":12500,\"GnssDiffFromBaroAlt\":650,\"AltIsGNSS\":false,\"NIC\":8,\"NACp\":9,\"Track\":89,\"Speed\":205,\"Speed_valid\":true,\"Vvel\":0,\"Timestamp\":\"2016-05-24T01:13:18.189Z\",\"Age\":40.8,\"Last_seen\":\"0001-01-01T03:30:38.2Z\",\"Last_alt\":\"0001-01-01T03:30:38.55Z\",\"Last_GnssDiff\":\"0001-01-01T03:30:36.75Z\",\"Last_GnssDiffAlt\":12500,\"Last_speed\":\"0001-01-01T03:30:36.75Z\",\"Last_source\":1,\"ExtrapolatedPosition\":false,\"Bearing\":0,\"Distance\":0}" :: Maybe Traffic +-- Just (Traffic {icaoAddrTraffic = IcaoAddr {_icaoAddrWord0 = 124, _icaoAddrWord1 = 106, _icaoAddrWord2 = 226}, _tail = "SVY22", _emitterCategory = Light, _onGround = False, _addressType = 0, _targetType = Adsb, _signalLevel = -30.920514783877277, _positionValid = True, _latitude = -27.501154, _longitude = 153.21422, _altitude = 12500, _gnssDiffFromBaroAlt = 650, _altIsGnss = False, _navigationIntegrityCategory = 8, _navigationAccuracyCategoryForPosition = 9, _track = 89, _speed = 205, _speedValid = True, _verticalVelocity = 0, _timestamp = 2016-05-24 01:13:18.189 UTC, _age = 40.8, _lastSeen = 0001-01-01 03:30:38.2 UTC, _lastAltitude = 0001-01-01 03:30:38.55 UTC, _lastGnssDiff = 0001-01-01 03:30:36.75 UTC, _lastGnssDiffAltitude = 12500, _lastSpeed = 0001-01-01 03:30:36.75 UTC, _lastSource = 1, _extrapolatedPosition = False, _bearing = 0.0, _distanceToTrafficFromOwnship = 0.0}) +instance FromJSON Traffic where + parseJSON = + withObject "Traffic" (\x -> + Traffic <$> + x .: "Icao_addr" <*> + x .: "Tail" <*> + x .: "Emitter_category" <*> + x .: "OnGround" <*> + x .: "Addr_type" <*> + x .: "TargetType" <*> + x .: "SignalLevel" <*> + x .: "Position_valid" <*> + x .: "Lat" <*> + x .: "Lng" <*> + x .: "Alt" <*> + x .: "GnssDiffFromBaroAlt" <*> + x .: "AltIsGNSS" <*> + x .: "NIC" <*> + x .: "NACp" <*> + x .: "Track" <*> + x .: "Speed" <*> + x .: "Speed_valid" <*> + x .: "Vvel" <*> + x .: "Timestamp" <*> + x .: "Age" <*> + x .: "Last_seen" <*> + x .: "Last_alt" <*> + x .: "Last_GnssDiff" <*> + x .: "Last_GnssDiffAlt" <*> + x .: "Last_speed" <*> + x .: "Last_source" <*> + x .: "ExtrapolatedPosition" <*> + x .: "Bearing" <*> + x .: "Distance") + +-- | +-- +-- >>> toJSON (Traffic (IcaoAddr 124 106 226) "SVY22" Light False 0 Adsb (-30.920514783877277) True (-27.501154) 153.21422 12500 650 False 8 9 89 205 True 0 (UTCTime (fromGregorian 1 1 1) 3597) 40.8 (UTCTime (fromGregorian 1 1 1) 259) (UTCTime (fromGregorian 1 1 1) 23) (UTCTime (fromGregorian 1 1 1) 597) 12500 (UTCTime (fromGregorian 2016 5 24) 237) 1 False 0.0 0.0) +-- Object (fromList [("OnGround",Bool False),("Bearing",Number 0.0),("ExtrapolatedPosition",Bool False),("NIC",Number 8.0),("Last_alt",String "0001-01-01T00:00:23Z"),("Track",Number 89.0),("Last_speed",String "2016-05-24T00:03:57Z"),("GnssDiffFromBaroAlt",Number 650.0),("Last_seen",String "0001-01-01T00:04:19Z"),("Icao_addr",Number 8153826.0),("SignalLevel",Number -30.920514783877277),("Distance",Number 0.0),("Age",Number 40.8),("Speed_valid",Bool True),("TargetType",Number 1.0),("Lat",Number -27.501154),("Vvel",Number 0.0),("NACp",Number 9.0),("Addr_type",Number 0.0),("Speed",Number 205.0),("AltIsGNSS",Bool False),("Lng",Number 153.21422),("Tail",String "SVY22"),("Last_GnssDiffAlt",Number 12500.0),("Position_valid",Bool True),("Last_source",Number 1.0),("Timestamp",String "0001-01-01T00:59:57Z"),("Last_GnssDiff",String "0001-01-01T00:09:57Z"),("Alt",Number 12500.0),("Emitter_category",Number 1.0)]) +instance ToJSON Traffic where + toJSON (Traffic icaoAddr_ tail_ emitterCategory_ onGround_ addressType_ targetType_ signalLevel_ positionValid_ latitude_ longitude_ altitude_ gnssDiffFromBaroAlt_ altIsGnss_ navigationIntegrityCategory_ navigationAccuracyCategoryForPosition_ track_ speed_ speedValid_ verticalVelocity_ timestamp_ age_ lastSeen_ lastAltitude_ lastGnssDiff_ lastGnssDiffAltitude_ lastSpeed_ lastSource_ extrapolatedPosition_ bearing_ distanceToTrafficFromOwnship_) = + object [ + "Icao_addr" .= icaoAddr_ + , "Tail" .= tail_ + , "Emitter_category" .= emitterCategory_ + , "OnGround" .= onGround_ + , "Addr_type" .= addressType_ + , "TargetType" .= targetType_ + , "SignalLevel" .= signalLevel_ + , "Position_valid" .= positionValid_ + , "Lat" .= latitude_ + , "Lng" .= longitude_ + , "Alt" .= altitude_ + , "GnssDiffFromBaroAlt" .= gnssDiffFromBaroAlt_ + , "AltIsGNSS" .= altIsGnss_ + , "NIC" .= navigationIntegrityCategory_ + , "NACp" .= navigationAccuracyCategoryForPosition_ + , "Track" .= track_ + , "Speed" .= speed_ + , "Speed_valid" .= speedValid_ + , "Vvel" .= verticalVelocity_ + , "Timestamp" .= timestamp_ + , "Age" .= age_ + , "Last_seen" .= lastSeen_ + , "Last_alt" .= lastAltitude_ + , "Last_GnssDiff" .= lastGnssDiff_ + , "Last_GnssDiffAlt" .= lastGnssDiffAltitude_ + , "Last_speed" .= lastSpeed_ + , "Last_source" .= lastSource_ + , "ExtrapolatedPosition" .= extrapolatedPosition_ + , "Bearing" .= bearing_ + , "Distance" .= distanceToTrafficFromOwnship_ + ] + +instance HasIcaoAddr Traffic where + icaoAddr = + lens + (\(Traffic x _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) -> x) + (\(Traffic _ tail_ emitterCategory_ onGround_ addressType_ targetType_ signalLevel_ positionValid_ latitude_ longitude_ altitude_ gnssDiffFromBaroAlt_ altIsGnss_ navigationIntegrityCategory_ navigationAccuracyCategoryForPosition_ track_ speed_ speedValid_ verticalVelocity_ timestamp_ age_ lastSeen_ lastAltitude_ lastGnssDiff_ lastGnssDiffAltitude_ lastSpeed_ lastSource_ extrapolatedPosition_ bearing_ distanceToTrafficFromOwnship_) x -> Traffic x tail_ emitterCategory_ onGround_ addressType_ targetType_ signalLevel_ positionValid_ latitude_ longitude_ altitude_ gnssDiffFromBaroAlt_ altIsGnss_ navigationIntegrityCategory_ navigationAccuracyCategoryForPosition_ track_ speed_ speedValid_ verticalVelocity_ timestamp_ age_ lastSeen_ lastAltitude_ lastGnssDiff_ lastGnssDiffAltitude_ lastSpeed_ lastSource_ extrapolatedPosition_ bearing_ distanceToTrafficFromOwnship_) + +instance HasWord8s Traffic where + _Word8s = + icaoAddr . _Word8s + +class HasUTCTimes a where + utcTimes :: + Traversal' + a + UTCTime + +instance HasUTCTimes UTCTime where + utcTimes = + id + +-- | +-- +-- >>> (utcTimes %~ addUTCTime 1) (UTCTime (fromGregorian 1 1 1) 600) +-- 0001-01-01 00:10:01 UTC +instance HasUTCTimes Traffic where + utcTimes f (Traffic icaoAddr_ tail_ emitterCategory_ onGround_ addressType_ targetType_ signalLevel_ positionValid_ latitude_ longitude_ altitude_ gnssDiffFromBaroAlt_ altIsGnss_ navigationIntegrityCategory_ navigationAccuracyCategoryForPosition_ track_ speed_ speedValid_ verticalVelocity_ timestamp_ age_ lastSeen_ lastAltitude_ lastGnssDiff_ lastGnssDiffAltitude_ lastSpeed_ lastSource_ extrapolatedPosition_ bearing_ distanceToTrafficFromOwnship_) = + (\timestamp__ lastSeen__ lastAltitude__ lastGnssDiff__ lastSpeed__ -> + Traffic icaoAddr_ tail_ emitterCategory_ onGround_ addressType_ targetType_ signalLevel_ positionValid_ latitude_ longitude_ altitude_ gnssDiffFromBaroAlt_ altIsGnss_ navigationIntegrityCategory_ navigationAccuracyCategoryForPosition_ track_ speed_ speedValid_ verticalVelocity_ timestamp__ age_ lastSeen__ lastAltitude__ lastGnssDiff__ lastGnssDiffAltitude_ lastSpeed__ lastSource_ extrapolatedPosition_ bearing_ distanceToTrafficFromOwnship_) <$> + f timestamp_ <*> + f lastSeen_ <*> + f lastAltitude_ <*> + f lastGnssDiff_ <*> + f lastSpeed_ + diff --git a/stratux.cabal b/stratux.cabal new file mode 100644 --- /dev/null +++ b/stratux.cabal @@ -0,0 +1,76 @@ +name: stratux +version: 0.0.1 +license: BSD3 +license-file: LICENCE +author: Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ> +maintainer: Tony Morris +copyright: Copyright (C) 2016 Tony Morris +synopsis: A library for stratux +category: Development +description: A library for reading JSON output from stratux http://stratux.me/ +homepage: https://github.com/tonymorris/stratux +bug-reports: https://github.com/tonymorris/stratux/issues +cabal-version: >= 1.10 +build-type: Custom +extra-source-files: changelog.md + +source-repository head + type: git + location: git@github.com:tonymorris/stratux.git + +flag small_base + description: Choose the new, split-up base package. + +library + default-language: + Haskell2010 + + build-depends: + base < 5 && >= 3 + , lens >= 4.0 + , aeson >= 0.11 + , time >= 1.4 + , bytestring >= 0.10 + , scientific >= 0.3 + + ghc-options: + -Wall + + default-extensions: + NoImplicitPrelude + + hs-source-dirs: + src + + exposed-modules: + Data.Aviation.Stratux + Data.Aviation.Stratux.Types + Data.Aviation.Stratux.Types.EmitterCategory + Data.Aviation.Stratux.Types.IcaoAddr + Data.Aviation.Stratux.Types.TargetType + Data.Aviation.Stratux.Types.Traffic + +test-suite doctests + type: + exitcode-stdio-1.0 + + main-is: + doctests.hs + + default-language: + Haskell2010 + + build-depends: + base < 5 && >= 3 + , doctest >= 0.9.7 + , filepath >= 1.3 + , directory >= 1.1 + , QuickCheck >= 2.0 + , template-haskell >= 2.8 + + ghc-options: + -Wall + -threaded + + hs-source-dirs: + test diff --git a/test/doctests.hs b/test/doctests.hs new file mode 100644 --- /dev/null +++ b/test/doctests.hs @@ -0,0 +1,32 @@ +module Main where + +import Build_doctests (deps) +import Control.Applicative +import Control.Monad +import Data.List +import System.Directory +import System.FilePath +import Test.DocTest + +main :: + IO () +main = + getSources >>= \sources -> doctest $ + "-isrc" + : "-idist/build/autogen" + : "-optP-include" + : "-optPdist/build/autogen/cabal_macros.h" + : "-hide-all-packages" + : map ("-package="++) deps ++ sources + +getSources :: IO [FilePath] +getSources = filter (isSuffixOf ".hs") <$> go "src" + where + go dir = do + (dirs, files) <- getFilesAndDirectories dir + (files ++) . concat <$> mapM go dirs + +getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath]) +getFilesAndDirectories dir = do + c <- map (dir ) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir + (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c