{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# LANGUAGE NoImplicitPrelude           #-}
{-# LANGUAGE TemplateHaskell             #-}
{-# LANGUAGE RecordWildCards             #-}

-- |
-- Module:      SwiftNav.SBP.ExtEvents
-- Copyright:   Copyright (C) 2015-2021 Swift Navigation, Inc.
-- License:     MIT
-- Contact:     https://support.swiftnav.com
-- Stability:   experimental
-- Portability: portable
--
-- \< Messages reporting accurately-timestamped external events, e.g. camera
-- shutter time. \>

module SwiftNav.SBP.ExtEvents
  ( module SwiftNav.SBP.ExtEvents
  ) where

import BasicPrelude
import Control.Lens
import Control.Monad.Loops
import Data.Binary
import Data.Binary.Get
import Data.Binary.IEEE754
import Data.Binary.Put
import Data.ByteString.Lazy    hiding (ByteString)
import Data.Int
import Data.Word
import SwiftNav.SBP.TH
import SwiftNav.SBP.Types

{-# ANN module ("HLint: ignore Use camelCase"::String) #-}
{-# ANN module ("HLint: ignore Redundant do"::String) #-}
{-# ANN module ("HLint: ignore Use newtype instead of data"::String) #-}


msgExtEvent :: Word16
msgExtEvent :: Word16
msgExtEvent = Word16
0x0101

-- | SBP class for message MSG_EXT_EVENT (0x0101).
--
-- Reports detection of an external event, the GPS time it occurred, which pin
-- it was and whether it was rising or falling.
data MsgExtEvent = MsgExtEvent
  { MsgExtEvent -> Word16
_msgExtEvent_wn        :: !Word16
    -- ^ GPS week number
  , MsgExtEvent -> Word32
_msgExtEvent_tow       :: !Word32
    -- ^ GPS time of week rounded to the nearest millisecond
  , MsgExtEvent -> Int32
_msgExtEvent_ns_residual :: !Int32
    -- ^ Nanosecond residual of millisecond-rounded TOW (ranges from -500000 to
    -- 500000)
  , MsgExtEvent -> Word8
_msgExtEvent_flags     :: !Word8
    -- ^ Flags
  , MsgExtEvent -> Word8
_msgExtEvent_pin       :: !Word8
    -- ^ Pin number.  0..9 = DEBUG0..9.
  } deriving ( Int -> MsgExtEvent -> ShowS
[MsgExtEvent] -> ShowS
MsgExtEvent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgExtEvent] -> ShowS
$cshowList :: [MsgExtEvent] -> ShowS
show :: MsgExtEvent -> String
$cshow :: MsgExtEvent -> String
showsPrec :: Int -> MsgExtEvent -> ShowS
$cshowsPrec :: Int -> MsgExtEvent -> ShowS
Show, ReadPrec [MsgExtEvent]
ReadPrec MsgExtEvent
Int -> ReadS MsgExtEvent
ReadS [MsgExtEvent]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgExtEvent]
$creadListPrec :: ReadPrec [MsgExtEvent]
readPrec :: ReadPrec MsgExtEvent
$creadPrec :: ReadPrec MsgExtEvent
readList :: ReadS [MsgExtEvent]
$creadList :: ReadS [MsgExtEvent]
readsPrec :: Int -> ReadS MsgExtEvent
$creadsPrec :: Int -> ReadS MsgExtEvent
Read, MsgExtEvent -> MsgExtEvent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgExtEvent -> MsgExtEvent -> Bool
$c/= :: MsgExtEvent -> MsgExtEvent -> Bool
== :: MsgExtEvent -> MsgExtEvent -> Bool
$c== :: MsgExtEvent -> MsgExtEvent -> Bool
Eq )

instance Binary MsgExtEvent where
  get :: Get MsgExtEvent
get = do
    Word16
_msgExtEvent_wn <- Get Word16
getWord16le
    Word32
_msgExtEvent_tow <- Get Word32
getWord32le
    Int32
_msgExtEvent_ns_residual <- (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le)
    Word8
_msgExtEvent_flags <- Get Word8
getWord8
    Word8
_msgExtEvent_pin <- Get Word8
getWord8
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgExtEvent {Int32
Word8
Word16
Word32
_msgExtEvent_pin :: Word8
_msgExtEvent_flags :: Word8
_msgExtEvent_ns_residual :: Int32
_msgExtEvent_tow :: Word32
_msgExtEvent_wn :: Word16
_msgExtEvent_pin :: Word8
_msgExtEvent_flags :: Word8
_msgExtEvent_ns_residual :: Int32
_msgExtEvent_tow :: Word32
_msgExtEvent_wn :: Word16
..}

  put :: MsgExtEvent -> Put
put MsgExtEvent {Int32
Word8
Word16
Word32
_msgExtEvent_pin :: Word8
_msgExtEvent_flags :: Word8
_msgExtEvent_ns_residual :: Int32
_msgExtEvent_tow :: Word32
_msgExtEvent_wn :: Word16
_msgExtEvent_pin :: MsgExtEvent -> Word8
_msgExtEvent_flags :: MsgExtEvent -> Word8
_msgExtEvent_ns_residual :: MsgExtEvent -> Int32
_msgExtEvent_tow :: MsgExtEvent -> Word32
_msgExtEvent_wn :: MsgExtEvent -> Word16
..} = do
    Word16 -> Put
putWord16le Word16
_msgExtEvent_wn
    Word32 -> Put
putWord32le Word32
_msgExtEvent_tow
    (Word32 -> Put
putWord32le forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) Int32
_msgExtEvent_ns_residual
    Word8 -> Put
putWord8 Word8
_msgExtEvent_flags
    Word8 -> Put
putWord8 Word8
_msgExtEvent_pin

$(makeSBP 'msgExtEvent ''MsgExtEvent)
$(makeJSON "_msgExtEvent_" ''MsgExtEvent)
$(makeLenses ''MsgExtEvent)