diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,10 @@ +0.0.6 + +* Create `SettingsSet` data type. +* Create `Situation` data type. +* Split out some type-classes to own module. +* Organise tests better. + 0.0.5 * Create `Settings` data type. diff --git a/src/Data/Aviation/Stratux/Types.hs b/src/Data/Aviation/Stratux/Types.hs --- a/src/Data/Aviation/Stratux/Types.hs +++ b/src/Data/Aviation/Stratux/Types.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE NoImplicitPrelude #-} + module Data.Aviation.Stratux.Types( module T ) where @@ -7,6 +9,10 @@ import Data.Aviation.Stratux.Types.IcaoAddr as T import Data.Aviation.Stratux.Types.NetworkConnection as T import Data.Aviation.Stratux.Types.Settings as T +import Data.Aviation.Stratux.Types.Situation as T import Data.Aviation.Stratux.Types.Status as T import Data.Aviation.Stratux.Types.TargetType as T import Data.Aviation.Stratux.Types.Traffic as T +import Data.Aviation.Stratux.Types.UTCTimes as T +import Data.Aviation.Stratux.Types.Word8s as T + diff --git a/src/Data/Aviation/Stratux/Types/EmitterCategory.hs b/src/Data/Aviation/Stratux/Types/EmitterCategory.hs --- a/src/Data/Aviation/Stratux/Types/EmitterCategory.hs +++ b/src/Data/Aviation/Stratux/Types/EmitterCategory.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE TemplateHaskell #-} module Data.Aviation.Stratux.Types.EmitterCategory( diff --git a/src/Data/Aviation/Stratux/Types/GpsSolution.hs b/src/Data/Aviation/Stratux/Types/GpsSolution.hs --- a/src/Data/Aviation/Stratux/Types/GpsSolution.hs +++ b/src/Data/Aviation/Stratux/Types/GpsSolution.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} diff --git a/src/Data/Aviation/Stratux/Types/IcaoAddr.hs b/src/Data/Aviation/Stratux/Types/IcaoAddr.hs --- a/src/Data/Aviation/Stratux/Types/IcaoAddr.hs +++ b/src/Data/Aviation/Stratux/Types/IcaoAddr.hs @@ -1,16 +1,16 @@ +{-# LANGUAGE NoImplicitPrelude #-} {-# 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.Lens(makeClassy) import Control.Monad(Monad(return)) import Data.Aeson(FromJSON(parseJSON), ToJSON(toJSON), Value(Number), withScientific) +import Data.Aviation.Stratux.Types.Word8s(HasWord8s(word8s)) import Data.Bits(shiftR, shiftL, (.|.), (.&.)) import Data.Eq(Eq) import Data.Functor((<$>)) @@ -62,21 +62,11 @@ -- | -- --- >>> _Word8s %~ (+1) $ IcaoAddr 124 106 226 +-- >>> word8s %~ (+1) $ IcaoAddr 124 106 226 -- IcaoAddr {_icaoAddrWord0 = 125, _icaoAddrWord1 = 107, _icaoAddrWord2 = 227} -- --- >>> _Word8s %~ (+1) $ IcaoAddr 1 2 3 +-- >>> 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) = + word8s f (IcaoAddr w0 w1 w2) = IcaoAddr <$> f w0 <*> f w1 <*> f w2 diff --git a/src/Data/Aviation/Stratux/Types/NetworkConnection.hs b/src/Data/Aviation/Stratux/Types/NetworkConnection.hs --- a/src/Data/Aviation/Stratux/Types/NetworkConnection.hs +++ b/src/Data/Aviation/Stratux/Types/NetworkConnection.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} diff --git a/src/Data/Aviation/Stratux/Types/Settings.hs b/src/Data/Aviation/Stratux/Types/Settings.hs --- a/src/Data/Aviation/Stratux/Types/Settings.hs +++ b/src/Data/Aviation/Stratux/Types/Settings.hs @@ -1,21 +1,31 @@ +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} -module Data.Aviation.Stratux.Types.Settings( +module Data.Aviation.Stratux.Types.Settings ( Settings(..) , HasSettings(..) +, SettingsSet(..) +, HasSettingsSet(..) +, AsSettings(..) +, emptySettingsSet ) where import Control.Applicative((<*>)) -import Control.Lens(makeClassy) -import Data.Aeson(FromJSON(parseJSON), ToJSON(toJSON), (.:), (.=), object, withObject) +import Control.Category((.), id) +import Control.Lens(makeClassy, Prism', prism') +import Data.Aeson(FromJSON(parseJSON), ToJSON(toJSON), (.:), (.:?), (.=), object, withObject) +import Data.Aeson.Types(KeyValue) import Data.Aviation.Stratux.Types.NetworkConnection import Data.Bool(Bool) import Data.Eq(Eq) import Data.Functor((<$>)) +import Data.Function(($)) import Data.Int(Int) +import Data.Maybe(Maybe(Nothing, Just), catMaybes) import Data.Ord(Ord) import Data.String(String) +import Data.Text(Text) import Prelude(Show) -- $setup @@ -80,3 +90,133 @@ , "OwnshipModeS" .= ownshipModeS_ , "WatchList" .= watchList_ ] + +data SettingsSet = + SettingsSet { + _uatEnabled_ :: Maybe Bool + , _esEnabled_ :: Maybe Bool + , _gpsEnabled_ :: Maybe Bool + , _networkOutputs_ :: Maybe [NetworkConnection] + , _ahrsEnabled_ :: Maybe Bool + , _debug_ :: Maybe Bool + , _replayLog_ :: Maybe Bool + , _ppm_ :: Maybe Int + , _ownshipModeS_ :: Maybe String + , _watchList_ :: Maybe String + } deriving (Eq, Ord, Show) + +makeClassy ''SettingsSet + +class AsSettings a where + _Settings :: + Prism' + a + Settings + +instance AsSettings Settings where + _Settings = + id + +instance AsSettings SettingsSet where + _Settings = + prism' + (\(Settings _uatEnabled_ _esEnabled_ _gpsEnabled_ _networkOutputs_ _ahrsEnabled_ _debug_ _replayLog_ _ppm_ _ownshipModeS_ _watchList_) -> + SettingsSet + (Just _uatEnabled_) + (Just _esEnabled_) + (Just _gpsEnabled_) + (Just _networkOutputs_) + (Just _ahrsEnabled_) + (Just _debug_) + (Just _replayLog_) + (Just _ppm_) + (Just _ownshipModeS_) + (Just _watchList_) + ) + (\(SettingsSet _uatEnabled_ _esEnabled_ _gpsEnabled_ _networkOutputs_ _ahrsEnabled_ _debug_ _replayLog_ _ppm_ _ownshipModeS_ _watchList_) -> + Settings <$> + _uatEnabled_ <*> + _esEnabled_ <*> + _gpsEnabled_ <*> + _networkOutputs_ <*> + _ahrsEnabled_ <*> + _debug_ <*> + _replayLog_ <*> + _ppm_ <*> + _ownshipModeS_ <*> + _watchList_ + ) + +emptySettingsSet :: + SettingsSet +emptySettingsSet = + SettingsSet + Nothing + Nothing + Nothing + Nothing + Nothing + Nothing + Nothing + Nothing + Nothing + Nothing + +-- | +-- +-- >>> decode "{\"UAT_Enabled\":true,\"ES_Enabled\":true,\"GPS_Enabled\":true,\"NetworkOutputs\":[{\"Conn\":null,\"Ip\":\"\",\"Port\":4000,\"Capability\":5,\"LastUnreachable\":\"0001-01-01T00:00:00Z\",\"SleepFlag\":false}],\"AHRS_Enabled\":false,\"DEBUG\":false,\"ReplayLog\":true,\"PPM\":0,\"OwnshipModeS\":\"F00000\",\"WatchList\":\"\"}" :: Maybe SettingsSet +-- Just (SettingsSet {_uatEnabled_ = Just True, _esEnabled_ = Just True, _gpsEnabled_ = Just True, _networkOutputs_ = Just [NetworkConnection {_conn = Nothing, _ip = "", _port = 4000, _capability = 5, _lastUnreachable = 0001-01-01 00:00:00 UTC, _sleepFlag = False}], _ahrsEnabled_ = Just False, _debug_ = Just False, _replayLog_ = Just True, _ppm_ = Just 0, _ownshipModeS_ = Just "F00000", _watchList_ = Just ""}) +-- +-- >>> decode "{\"ES_Enabled\":true,\"GPS_Enabled\":true,\"NetworkOutputs\":[{\"Conn\":null,\"Ip\":\"\",\"Port\":4000,\"Capability\":5,\"LastUnreachable\":\"0001-01-01T00:00:00Z\",\"SleepFlag\":false}],\"AHRS_Enabled\":false,\"DEBUG\":false,\"ReplayLog\":true,\"PPM\":0,\"OwnshipModeS\":\"F00000\",\"WatchList\":\"\"}" :: Maybe SettingsSet +-- Just (SettingsSet {_uatEnabled_ = Nothing, _esEnabled_ = Just True, _gpsEnabled_ = Just True, _networkOutputs_ = Just [NetworkConnection {_conn = Nothing, _ip = "", _port = 4000, _capability = 5, _lastUnreachable = 0001-01-01 00:00:00 UTC, _sleepFlag = False}], _ahrsEnabled_ = Just False, _debug_ = Just False, _replayLog_ = Just True, _ppm_ = Just 0, _ownshipModeS_ = Just "F00000", _watchList_ = Just ""}) +-- +-- >>> decode "{\"ES_Enabled\":true,\"NetworkOutputs\":[{\"Conn\":null,\"Ip\":\"\",\"Port\":4000,\"Capability\":5,\"LastUnreachable\":\"0001-01-01T00:00:00Z\",\"SleepFlag\":false}],\"AHRS_Enabled\":false,\"DEBUG\":false,\"OwnshipModeS\":\"F00000\",\"WatchList\":\"\"}" :: Maybe SettingsSet +-- Just (SettingsSet {_uatEnabled_ = Nothing, _esEnabled_ = Just True, _gpsEnabled_ = Nothing, _networkOutputs_ = Just [NetworkConnection {_conn = Nothing, _ip = "", _port = 4000, _capability = 5, _lastUnreachable = 0001-01-01 00:00:00 UTC, _sleepFlag = False}], _ahrsEnabled_ = Just False, _debug_ = Just False, _replayLog_ = Nothing, _ppm_ = Nothing, _ownshipModeS_ = Just "F00000", _watchList_ = Just ""}) +instance FromJSON SettingsSet where + parseJSON = + withObject "SettingsSet" (\x -> + SettingsSet <$> + x .:? "UAT_Enabled" <*> + x .:? "ES_Enabled" <*> + x .:? "GPS_Enabled" <*> + x .:? "NetworkOutputs" <*> + x .:? "AHRS_Enabled" <*> + x .:? "DEBUG" <*> + x .:? "ReplayLog" <*> + x .:? "PPM" <*> + x .:? "OwnshipModeS" <*> + x .:? "WatchList" + ) + +-- | +-- +-- >>> encode (SettingsSet (Just True) (Just True) (Just True) (Just [(NetworkConnection Nothing "" 4000 5 (UTCTime (fromGregorian 1 1 1) 597) False)]) (Just False) (Just False) (Just True) (Just 0) (Just "F00000") (Just "")) +-- "{\"OwnshipModeS\":\"F00000\",\"AHRS_Enabled\":false,\"NetworkOutputs\":[{\"Ip\":\"\",\"Conn\":null,\"Capability\":5,\"SleepFlag\":false,\"LastUnreachable\":\"0001-01-01T00:09:57Z\",\"Port\":4000}],\"PPM\":0,\"GPS_Enabled\":true,\"DEBUG\":false,\"ES_Enabled\":true,\"ReplayLog\":true,\"UAT_Enabled\":true,\"WatchList\":\"\"}" +-- +-- >>> encode (SettingsSet Nothing (Just True) (Just True) (Just [(NetworkConnection Nothing "" 4000 5 (UTCTime (fromGregorian 1 1 1) 597) False)]) (Just False) (Just False) (Just True) (Just 0) (Just "F00000") (Just "")) +-- "{\"OwnshipModeS\":\"F00000\",\"AHRS_Enabled\":false,\"NetworkOutputs\":[{\"Ip\":\"\",\"Conn\":null,\"Capability\":5,\"SleepFlag\":false,\"LastUnreachable\":\"0001-01-01T00:09:57Z\",\"Port\":4000}],\"PPM\":0,\"GPS_Enabled\":true,\"DEBUG\":false,\"ES_Enabled\":true,\"ReplayLog\":true,\"WatchList\":\"\"}" +-- +-- >>> encode (SettingsSet Nothing (Just True) Nothing (Just [(NetworkConnection Nothing "" 4000 5 (UTCTime (fromGregorian 1 1 1) 597) False)]) (Just False) (Just False) Nothing Nothing (Just "F00000") (Just "")) +-- "{\"OwnshipModeS\":\"F00000\",\"AHRS_Enabled\":false,\"NetworkOutputs\":[{\"Ip\":\"\",\"Conn\":null,\"Capability\":5,\"SleepFlag\":false,\"LastUnreachable\":\"0001-01-01T00:09:57Z\",\"Port\":4000}],\"DEBUG\":false,\"ES_Enabled\":true,\"WatchList\":\"\"}" +instance ToJSON SettingsSet where + toJSON (SettingsSet uatEnabled__ esEnabled__ gpsEnabled__ networkOutputs__ ahrsEnabled__ debug__ replayLog__ ppm__ ownshipModeS__ watchList__) = + let (.=?) :: + (ToJSON v, KeyValue kv) => + Text + -> Maybe v + -> Maybe kv + (.=?) = + (<$>) . (.=) + in object . catMaybes $ + [ + "UAT_Enabled" .=? uatEnabled__ + , "ES_Enabled" .=? esEnabled__ + , "GPS_Enabled" .=? gpsEnabled__ + , "NetworkOutputs" .=? networkOutputs__ + , "AHRS_Enabled" .=? ahrsEnabled__ + , "DEBUG" .=? debug__ + , "ReplayLog" .=? replayLog__ + , "PPM" .=? ppm__ + , "OwnshipModeS" .=? ownshipModeS__ + , "WatchList" .=? watchList__ + ] diff --git a/src/Data/Aviation/Stratux/Types/Situation.hs b/src/Data/Aviation/Stratux/Types/Situation.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Stratux/Types/Situation.hs @@ -0,0 +1,134 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE OverloadedStrings #-} + +module Data.Aviation.Stratux.Types.Situation( + Situation(..) +, HasSituation(..) +) where + +import Control.Applicative(Applicative((<*>))) +import Control.Lens(makeClassy) +import Data.Aeson(FromJSON(parseJSON), ToJSON(toJSON), (.:), withObject, (.=), object) +import Data.Aviation.Stratux.Types.UTCTimes(HasUTCTimes(utcTimes)) +import Data.Eq(Eq) +import Data.Int(Int) +import Data.Functor((<$>)) +import Data.Ord(Ord) +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.Time + +data Situation = + Situation { + _lat :: Double + , _lon :: Double + , _heightAboveEllipsoid :: Double + , _geoidSep :: Double + , _satellites :: Int + , _satellitesTracked :: Int + , _satellitesSeen :: Int + , _accuracy :: Double + , _nacp :: Int + , _alt :: Double + , _accuracyVert :: Double + , _gpsVertVel :: Double + , _lastFixLocalTime :: UTCTime + , _trueCourse :: Double + , _groundSpeed :: Int + , _lastGroundTrackTime :: UTCTime + , _lastGPSTimeTime :: UTCTime + , _lastNMEAMessage :: UTCTime + , _temp :: Double + , _pressureAlt :: Double + , _pitch :: Double + , _roll :: Double + , _gyroHeading :: Double + , _lastAttitudeTime :: UTCTime + } deriving (Eq, Ord, Show) + +makeClassy ''Situation + +-- | +-- +-- >>> decode "{\"Lat\":-27.39512,\"Lng\":152.87691,\"HeightAboveEllipsoid\":214.26509,\"GeoidSep\":125,\"Satellites\":7,\"SatellitesTracked\":11,\"SatellitesSeen\":8,\"Accuracy\":5.4,\"NACp\":10,\"Alt\":89.26509,\"AccuracyVert\":7.2,\"GPSVertVel\":0.18700787,\"LastFixLocalTime\":\"0001-01-01T00:17:01.25Z\",\"TrueCourse\":353,\"GroundSpeed\":0,\"LastGroundTrackTime\":\"0001-01-01T00:17:01.25Z\",\"LastGPSTimeTime\":\"0001-01-01T00:17:00.55Z\",\"LastNMEAMessage\":\"0001-01-01T00:17:01.25Z\",\"Temp\":0,\"Pressure_alt\":0,\"Pitch\":0,\"Roll\":0,\"Gyro_heading\":0,\"LastAttitudeTime\":\"0001-01-01T00:00:00Z\"}" :: Maybe Situation +-- Just (Situation {_lat = -27.39512, _lon = 152.87691, _heightAboveEllipsoid = 214.26509, _geoidSep = 125.0, _satellites = 7, _satellitesTracked = 11, _satellitesSeen = 8, _accuracy = 5.4, _nacp = 10, _alt = 89.26509, _accuracyVert = 7.2, _gpsVertVel = 0.18700787, _lastFixLocalTime = 0001-01-01 00:17:01.25 UTC, _trueCourse = 353.0, _groundSpeed = 0, _lastGroundTrackTime = 0001-01-01 00:17:01.25 UTC, _lastGPSTimeTime = 0001-01-01 00:17:00.55 UTC, _lastNMEAMessage = 0001-01-01 00:17:01.25 UTC, _temp = 0.0, _pressureAlt = 0.0, _pitch = 0.0, _roll = 0.0, _gyroHeading = 0.0, _lastAttitudeTime = 0001-01-01 00:00:00 UTC}) +instance FromJSON Situation where + parseJSON = + withObject "Situation" (\x -> + Situation <$> + x .: "Lat" <*> + x .: "Lng" <*> + x .: "HeightAboveEllipsoid" <*> + x .: "GeoidSep" <*> + x .: "Satellites" <*> + x .: "SatellitesTracked" <*> + x .: "SatellitesSeen" <*> + x .: "Accuracy" <*> + x .: "NACp" <*> + x .: "Alt" <*> + x .: "AccuracyVert" <*> + x .: "GPSVertVel" <*> + x .: "LastFixLocalTime" <*> + x .: "TrueCourse" <*> + x .: "GroundSpeed" <*> + x .: "LastGroundTrackTime" <*> + x .: "LastGPSTimeTime" <*> + x .: "LastNMEAMessage" <*> + x .: "Temp" <*> + x .: "Pressure_alt" <*> + x .: "Pitch" <*> + x .: "Roll" <*> + x .: "Gyro_heading" <*> + x .: "LastAttitudeTime" + ) + +-- | +-- +-- >>> encode (Situation (-27.39412) 152.59218 214.26509 125.0 7 11 8 5.4 10 89.26509 7.2 0.18700787 (UTCTime (fromGregorian 1 1 1) 597) 353.0 0 (UTCTime (fromGregorian 1 1 1) 597) (UTCTime (fromGregorian 1 1 1) 597) (UTCTime (fromGregorian 1 1 1) 597) 0.0 0.0 0.0 0.0 0.0 (UTCTime (fromGregorian 1 1 1) 597)) +-- "{\"Gyro_heading\":0,\"SatellitesSeen\":8,\"Roll\":0,\"Satellites\":7,\"AccuracyVert\":7.2,\"TrueCourse\":353,\"Pressure_alt\":0,\"GPSVertVel\":0.18700787,\"GeoidSep\":125,\"SatellitesTracked\":11,\"Lat\":-27.39412,\"NACp\":10,\"Temp\":0,\"LastAttitudeTime\":\"0001-01-01T00:09:57Z\",\"GroundSpeed\":0,\"Accuracy\":5.4,\"Lng\":152.59218,\"LastFixLocalTime\":\"0001-01-01T00:09:57Z\",\"HeightAboveEllipsoid\":214.26509,\"LastGroundTrackTime\":\"0001-01-01T00:09:57Z\",\"Pitch\":0,\"LastNMEAMessage\":\"0001-01-01T00:09:57Z\",\"LastGPSTimeTime\":\"0001-01-01T00:09:57Z\",\"Alt\":89.26509}" +instance ToJSON Situation where + toJSON (Situation lat_ lon_ heightAboveEllipsoid_ geoidSep_ satellites_ satellitesTracked_ satellitesSeen_ accuracy_ nacp_ alt_ accuracyVert_ gpsVertVel_ lastFixLocalTime_ trueCourse_ groundSpeed_ lastGroundTrackTime_ lastGPSTimeTime_ lastNMEAMessage_ temp_ pressureAlt_ pitch_ roll_ gyroHeading_ lastAttitudeTime_) = + object [ + "Lat" .= lat_ + , "Lng" .= lon_ + , "HeightAboveEllipsoid" .= heightAboveEllipsoid_ + , "GeoidSep" .= geoidSep_ + , "Satellites" .= satellites_ + , "SatellitesTracked" .= satellitesTracked_ + , "SatellitesSeen" .= satellitesSeen_ + , "Accuracy" .= accuracy_ + , "NACp" .= nacp_ + , "Alt" .= alt_ + , "AccuracyVert" .= accuracyVert_ + , "GPSVertVel" .= gpsVertVel_ + , "LastFixLocalTime" .= lastFixLocalTime_ + , "TrueCourse" .= trueCourse_ + , "GroundSpeed" .= groundSpeed_ + , "LastGroundTrackTime" .= lastGroundTrackTime_ + , "LastGPSTimeTime" .= lastGPSTimeTime_ + , "LastNMEAMessage" .= lastNMEAMessage_ + , "Temp" .= temp_ + , "Pressure_alt" .= pressureAlt_ + , "Pitch" .= pitch_ + , "Roll" .= roll_ + , "Gyro_heading" .= gyroHeading_ + , "LastAttitudeTime" .= lastAttitudeTime_ + ] + +instance HasUTCTimes Situation where + utcTimes f (Situation lat_ lon_ heightAboveEllipsoid_ geoidSep_ satellites_ satellitesTracked_ satellitesSeen_ accuracy_ nacp_ alt_ accuracyVert_ gpsVertVel_ lastFixLocalTime_ trueCourse_ groundSpeed_ lastGroundTrackTime_ lastGPSTimeTime_ lastNMEAMessage_ temp_ pressureAlt_ pitch_ roll_ gyroHeading_ lastAttitudeTime_) = + (\lastFixLocalTime__ lastGroundTrackTime__ lastGPSTimeTime__ lastNMEAMessage__ lastAttitudeTime__ -> + Situation lat_ lon_ heightAboveEllipsoid_ geoidSep_ satellites_ satellitesTracked_ satellitesSeen_ accuracy_ nacp_ alt_ accuracyVert_ gpsVertVel_ lastFixLocalTime__ trueCourse_ groundSpeed_ lastGroundTrackTime__ lastGPSTimeTime__ lastNMEAMessage__ temp_ pressureAlt_ pitch_ roll_ gyroHeading_ lastAttitudeTime__) <$> + f lastFixLocalTime_ <*> + f lastGroundTrackTime_ <*> + f lastGPSTimeTime_ <*> + f lastNMEAMessage_ <*> + f lastAttitudeTime_ diff --git a/src/Data/Aviation/Stratux/Types/Status.hs b/src/Data/Aviation/Stratux/Types/Status.hs --- a/src/Data/Aviation/Stratux/Types/Status.hs +++ b/src/Data/Aviation/Stratux/Types/Status.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} @@ -16,6 +17,7 @@ import Control.Lens(makeClassy) import Data.Aeson(FromJSON(parseJSON), ToJSON(toJSON), (.=), (.:), object, withObject) import Data.Aviation.Stratux.Types.GpsSolution(GpsSolution) +import Data.Aviation.Stratux.Types.UTCTimes(HasUTCTimes(utcTimes)) import Prelude(Show, Float) -- $setup @@ -135,3 +137,10 @@ , "NetworkDataBytesSentNonqueueableLastSec" .= networkDataBytesSentNonqueueableLastSec_ , "Errors" .= errors_ ] + +instance HasUTCTimes Status where + utcTimes f (Status version_ build_ hardwareBuild_ devices_ connectedUsers_ uatMessagesLastMinute_ uatMessagesMax_ esMessagesLastMinute_ esMessagesMax_ gpsSatellitesLocked_ gpsSatellitesSeen_ gpsSatellitesTracked_ gpsConnected_ gpsSolution_ ry835aiconnected_ uptime_ clock_ uptimeClock_ cpuTemp_ networkDataMessagesSent_ networkDataMessagesSentNonqueueable_ networkDataBytesSent_ networkDataBytesSentNonqueueable_ networkDataMessagesSentLastSec_ networkDataMessagesSentNonqueueableLastSec_ networkDataBytesSentLastSec_ networkDataBytesSentNonqueueableLastSec_ errors_) = + (\clock__ uptimeClock__ -> + Status version_ build_ hardwareBuild_ devices_ connectedUsers_ uatMessagesLastMinute_ uatMessagesMax_ esMessagesLastMinute_ esMessagesMax_ gpsSatellitesLocked_ gpsSatellitesSeen_ gpsSatellitesTracked_ gpsConnected_ gpsSolution_ ry835aiconnected_ uptime_ clock__ uptimeClock__ cpuTemp_ networkDataMessagesSent_ networkDataMessagesSentNonqueueable_ networkDataBytesSent_ networkDataBytesSentNonqueueable_ networkDataMessagesSentLastSec_ networkDataMessagesSentNonqueueableLastSec_ networkDataBytesSentLastSec_ networkDataBytesSentNonqueueableLastSec_ errors_) <$> + f clock_ <*> + f uptimeClock_ diff --git a/src/Data/Aviation/Stratux/Types/TargetType.hs b/src/Data/Aviation/Stratux/Types/TargetType.hs --- a/src/Data/Aviation/Stratux/Types/TargetType.hs +++ b/src/Data/Aviation/Stratux/Types/TargetType.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE TemplateHaskell #-} module Data.Aviation.Stratux.Types.TargetType( diff --git a/src/Data/Aviation/Stratux/Types/Traffic.hs b/src/Data/Aviation/Stratux/Types/Traffic.hs --- a/src/Data/Aviation/Stratux/Types/Traffic.hs +++ b/src/Data/Aviation/Stratux/Types/Traffic.hs @@ -1,18 +1,20 @@ +{-# LANGUAGE NoImplicitPrelude #-} {-# 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 Control.Category(Category((.))) +import Control.Lens(makeClassy, lens) import Data.Aviation.Stratux.Types.EmitterCategory(EmitterCategory) -import Data.Aviation.Stratux.Types.IcaoAddr(IcaoAddr, HasIcaoAddr(icaoAddr), HasWord8s(_Word8s)) +import Data.Aviation.Stratux.Types.IcaoAddr(IcaoAddr, HasIcaoAddr(icaoAddr)) import Data.Aviation.Stratux.Types.TargetType(TargetType) +import Data.Aviation.Stratux.Types.UTCTimes(HasUTCTimes(utcTimes)) +import Data.Aviation.Stratux.Types.Word8s(HasWord8s(word8s)) import Data.Aeson(FromJSON(parseJSON), ToJSON(toJSON), (.:), withObject, (.=), object) import Data.Bool(Bool) import Data.Eq(Eq) @@ -113,8 +115,9 @@ -- | -- --- >>> 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)]) +-- >>> encode (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) +-- "{\"OnGround\":false,\"Bearing\":0,\"ExtrapolatedPosition\":false,\"NIC\":8,\"Last_alt\":\"0001-01-01T00:00:23Z\",\"Track\":89,\"Last_speed\":\"2016-05-24T00:03:57Z\",\"GnssDiffFromBaroAlt\":650,\"Last_seen\":\"0001-01-01T00:04:19Z\",\"Icao_addr\":8153826,\"SignalLevel\":-30.920514783877277,\"Distance\":0,\"Age\":40.8,\"Speed_valid\":true,\"TargetType\":1,\"Lat\":-27.501154,\"Vvel\":0,\"NACp\":9,\"Addr_type\":0,\"Speed\":205,\"AltIsGNSS\":false,\"Lng\":153.21422,\"Tail\":\"SVY22\",\"Last_GnssDiffAlt\":12500,\"Position_valid\":true,\"Last_source\":1,\"Timestamp\":\"0001-01-01T00:59:57Z\",\"Last_GnssDiff\":\"0001-01-01T00:09:57Z\",\"Alt\":12500,\"Emitter_category\":1}" + 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 [ @@ -157,23 +160,9 @@ (\(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 + word8s = + icaoAddr . word8s --- | --- --- >>> (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__ -> diff --git a/src/Data/Aviation/Stratux/Types/UTCTimes.hs b/src/Data/Aviation/Stratux/Types/UTCTimes.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Stratux/Types/UTCTimes.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module Data.Aviation.Stratux.Types.UTCTimes( + HasUTCTimes(..) +) where + +import Control.Category(id) +import Control.Lens(Traversal') +import Data.Time(UTCTime) + +-- $setup +-- >>> :set -XOverloadedStrings +-- >>> import Control.Lens +-- >>> import Data.Time + +class HasUTCTimes a where + utcTimes :: + Traversal' + a + UTCTime + +-- | +-- +-- >>> (utcTimes %~ addUTCTime 1) (UTCTime (fromGregorian 1 1 1) 600) +-- 0001-01-01 00:10:01 UTC +instance HasUTCTimes UTCTime where + utcTimes = + id diff --git a/src/Data/Aviation/Stratux/Types/Word8s.hs b/src/Data/Aviation/Stratux/Types/Word8s.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aviation/Stratux/Types/Word8s.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module Data.Aviation.Stratux.Types.Word8s( + HasWord8s(..) +) where + +import Control.Category(id) +import Control.Lens(Traversal') +import Data.Word(Word8) + +class HasWord8s a where + word8s :: + Traversal' + a + Word8 + +instance HasWord8s Word8 where + word8s = + id diff --git a/stratux-types.cabal b/stratux-types.cabal --- a/stratux-types.cabal +++ b/stratux-types.cabal @@ -1,5 +1,5 @@ name: stratux-types -version: 0.0.5 +version: 0.0.6 license: BSD3 license-file: LICENCE author: Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ> @@ -32,6 +32,7 @@ , time >= 1.4 && < 2.0 , bytestring >= 0.10 && < 1.0 , scientific >= 0.3 && < 1.0 + , text >= 1.2 && < 2.0 ghc-options: -Wall @@ -49,9 +50,12 @@ Data.Aviation.Stratux.Types.IcaoAddr Data.Aviation.Stratux.Types.NetworkConnection Data.Aviation.Stratux.Types.Settings + Data.Aviation.Stratux.Types.Situation Data.Aviation.Stratux.Types.Status Data.Aviation.Stratux.Types.TargetType Data.Aviation.Stratux.Types.Traffic + Data.Aviation.Stratux.Types.UTCTimes + Data.Aviation.Stratux.Types.Word8s test-suite doctests type: