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

-- |
-- Module:      SwiftNav.SBP.Logging
-- Copyright:   Copyright (C) 2015-2021 Swift Navigation, Inc.
-- License:     MIT
-- Contact:     https://support.swiftnav.com
-- Stability:   experimental
-- Portability: portable
--
-- \< Logging and debugging messages from the device. \>

module SwiftNav.SBP.Logging
  ( module SwiftNav.SBP.Logging
  ) 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) #-}


msgLog :: Word16
msgLog :: Word16
msgLog = Word16
0x0401

-- | SBP class for message MSG_LOG (0x0401).
--
-- This message contains a human-readable payload string from the device
-- containing errors, warnings and informational messages at ERROR, WARNING,
-- DEBUG, INFO logging levels.
data MsgLog = MsgLog
  { MsgLog -> Word8
_msgLog_level :: !Word8
    -- ^ Logging level
  , MsgLog -> Text
_msgLog_text :: !Text
    -- ^ Human-readable string
  } deriving ( Int -> MsgLog -> ShowS
[MsgLog] -> ShowS
MsgLog -> String
(Int -> MsgLog -> ShowS)
-> (MsgLog -> String) -> ([MsgLog] -> ShowS) -> Show MsgLog
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgLog] -> ShowS
$cshowList :: [MsgLog] -> ShowS
show :: MsgLog -> String
$cshow :: MsgLog -> String
showsPrec :: Int -> MsgLog -> ShowS
$cshowsPrec :: Int -> MsgLog -> ShowS
Show, ReadPrec [MsgLog]
ReadPrec MsgLog
Int -> ReadS MsgLog
ReadS [MsgLog]
(Int -> ReadS MsgLog)
-> ReadS [MsgLog]
-> ReadPrec MsgLog
-> ReadPrec [MsgLog]
-> Read MsgLog
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgLog]
$creadListPrec :: ReadPrec [MsgLog]
readPrec :: ReadPrec MsgLog
$creadPrec :: ReadPrec MsgLog
readList :: ReadS [MsgLog]
$creadList :: ReadS [MsgLog]
readsPrec :: Int -> ReadS MsgLog
$creadsPrec :: Int -> ReadS MsgLog
Read, MsgLog -> MsgLog -> Bool
(MsgLog -> MsgLog -> Bool)
-> (MsgLog -> MsgLog -> Bool) -> Eq MsgLog
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgLog -> MsgLog -> Bool
$c/= :: MsgLog -> MsgLog -> Bool
== :: MsgLog -> MsgLog -> Bool
$c== :: MsgLog -> MsgLog -> Bool
Eq )

instance Binary MsgLog where
  get :: Get MsgLog
get = do
    Word8
_msgLog_level <- Get Word8
getWord8
    Text
_msgLog_text <- ByteString -> Text
decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> ByteString
toStrict (ByteString -> Text) -> Get ByteString -> Get Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getRemainingLazyByteString
    MsgLog -> Get MsgLog
forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgLog :: Word8 -> Text -> MsgLog
MsgLog {Word8
Text
_msgLog_text :: Text
_msgLog_level :: Word8
_msgLog_text :: Text
_msgLog_level :: Word8
..}

  put :: MsgLog -> Put
put MsgLog {Word8
Text
_msgLog_text :: Text
_msgLog_level :: Word8
_msgLog_text :: MsgLog -> Text
_msgLog_level :: MsgLog -> Word8
..} = do
    Word8 -> Put
putWord8 Word8
_msgLog_level
    ByteString -> Put
putByteString (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
_msgLog_text

$(makeSBP 'msgLog ''MsgLog)
$(makeJSON "_msgLog_" ''MsgLog)
$(makeLenses ''MsgLog)

msgFwd :: Word16
msgFwd :: Word16
msgFwd = Word16
0x0402

-- | SBP class for message MSG_FWD (0x0402).
--
-- This message provides the ability to forward messages over SBP.  This may
-- take the form of wrapping up SBP messages received by Piksi for logging
-- purposes or wrapping another protocol with SBP.
--
-- The source identifier indicates from what interface a forwarded stream
-- derived. The protocol identifier identifies what the expected protocol the
-- forwarded msg contains. Protocol 0 represents SBP and the remaining values
-- are implementation defined.
data MsgFwd = MsgFwd
  { MsgFwd -> Word8
_msgFwd_source    :: !Word8
    -- ^ source identifier
  , MsgFwd -> Word8
_msgFwd_protocol  :: !Word8
    -- ^ protocol identifier
  , MsgFwd -> [Word8]
_msgFwd_fwd_payload :: ![Word8]
    -- ^ variable length wrapped binary message
  } deriving ( Int -> MsgFwd -> ShowS
[MsgFwd] -> ShowS
MsgFwd -> String
(Int -> MsgFwd -> ShowS)
-> (MsgFwd -> String) -> ([MsgFwd] -> ShowS) -> Show MsgFwd
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgFwd] -> ShowS
$cshowList :: [MsgFwd] -> ShowS
show :: MsgFwd -> String
$cshow :: MsgFwd -> String
showsPrec :: Int -> MsgFwd -> ShowS
$cshowsPrec :: Int -> MsgFwd -> ShowS
Show, ReadPrec [MsgFwd]
ReadPrec MsgFwd
Int -> ReadS MsgFwd
ReadS [MsgFwd]
(Int -> ReadS MsgFwd)
-> ReadS [MsgFwd]
-> ReadPrec MsgFwd
-> ReadPrec [MsgFwd]
-> Read MsgFwd
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgFwd]
$creadListPrec :: ReadPrec [MsgFwd]
readPrec :: ReadPrec MsgFwd
$creadPrec :: ReadPrec MsgFwd
readList :: ReadS [MsgFwd]
$creadList :: ReadS [MsgFwd]
readsPrec :: Int -> ReadS MsgFwd
$creadsPrec :: Int -> ReadS MsgFwd
Read, MsgFwd -> MsgFwd -> Bool
(MsgFwd -> MsgFwd -> Bool)
-> (MsgFwd -> MsgFwd -> Bool) -> Eq MsgFwd
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgFwd -> MsgFwd -> Bool
$c/= :: MsgFwd -> MsgFwd -> Bool
== :: MsgFwd -> MsgFwd -> Bool
$c== :: MsgFwd -> MsgFwd -> Bool
Eq )

instance Binary MsgFwd where
  get :: Get MsgFwd
get = do
    Word8
_msgFwd_source <- Get Word8
getWord8
    Word8
_msgFwd_protocol <- Get Word8
getWord8
    [Word8]
_msgFwd_fwd_payload <- Get Bool -> Get Word8 -> Get [Word8]
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m [a]
whileM (Bool -> Bool
not (Bool -> Bool) -> Get Bool -> Get Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Bool
isEmpty) Get Word8
getWord8
    MsgFwd -> Get MsgFwd
forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgFwd :: Word8 -> Word8 -> [Word8] -> MsgFwd
MsgFwd {[Word8]
Word8
_msgFwd_fwd_payload :: [Word8]
_msgFwd_protocol :: Word8
_msgFwd_source :: Word8
_msgFwd_fwd_payload :: [Word8]
_msgFwd_protocol :: Word8
_msgFwd_source :: Word8
..}

  put :: MsgFwd -> Put
put MsgFwd {[Word8]
Word8
_msgFwd_fwd_payload :: [Word8]
_msgFwd_protocol :: Word8
_msgFwd_source :: Word8
_msgFwd_fwd_payload :: MsgFwd -> [Word8]
_msgFwd_protocol :: MsgFwd -> Word8
_msgFwd_source :: MsgFwd -> Word8
..} = do
    Word8 -> Put
putWord8 Word8
_msgFwd_source
    Word8 -> Put
putWord8 Word8
_msgFwd_protocol
    (Word8 -> Put) -> [Word8] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word8 -> Put
putWord8 [Word8]
_msgFwd_fwd_payload

$(makeSBP 'msgFwd ''MsgFwd)
$(makeJSON "_msgFwd_" ''MsgFwd)
$(makeLenses ''MsgFwd)

msgPrintDep :: Word16
msgPrintDep :: Word16
msgPrintDep = Word16
0x0010

-- | SBP class for message MSG_PRINT_DEP (0x0010).
--
-- Deprecated.
data MsgPrintDep = MsgPrintDep
  { MsgPrintDep -> Text
_msgPrintDep_text :: !Text
    -- ^ Human-readable string
  } deriving ( Int -> MsgPrintDep -> ShowS
[MsgPrintDep] -> ShowS
MsgPrintDep -> String
(Int -> MsgPrintDep -> ShowS)
-> (MsgPrintDep -> String)
-> ([MsgPrintDep] -> ShowS)
-> Show MsgPrintDep
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgPrintDep] -> ShowS
$cshowList :: [MsgPrintDep] -> ShowS
show :: MsgPrintDep -> String
$cshow :: MsgPrintDep -> String
showsPrec :: Int -> MsgPrintDep -> ShowS
$cshowsPrec :: Int -> MsgPrintDep -> ShowS
Show, ReadPrec [MsgPrintDep]
ReadPrec MsgPrintDep
Int -> ReadS MsgPrintDep
ReadS [MsgPrintDep]
(Int -> ReadS MsgPrintDep)
-> ReadS [MsgPrintDep]
-> ReadPrec MsgPrintDep
-> ReadPrec [MsgPrintDep]
-> Read MsgPrintDep
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MsgPrintDep]
$creadListPrec :: ReadPrec [MsgPrintDep]
readPrec :: ReadPrec MsgPrintDep
$creadPrec :: ReadPrec MsgPrintDep
readList :: ReadS [MsgPrintDep]
$creadList :: ReadS [MsgPrintDep]
readsPrec :: Int -> ReadS MsgPrintDep
$creadsPrec :: Int -> ReadS MsgPrintDep
Read, MsgPrintDep -> MsgPrintDep -> Bool
(MsgPrintDep -> MsgPrintDep -> Bool)
-> (MsgPrintDep -> MsgPrintDep -> Bool) -> Eq MsgPrintDep
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgPrintDep -> MsgPrintDep -> Bool
$c/= :: MsgPrintDep -> MsgPrintDep -> Bool
== :: MsgPrintDep -> MsgPrintDep -> Bool
$c== :: MsgPrintDep -> MsgPrintDep -> Bool
Eq )

instance Binary MsgPrintDep where
  get :: Get MsgPrintDep
get = do
    Text
_msgPrintDep_text <- ByteString -> Text
decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> ByteString
toStrict (ByteString -> Text) -> Get ByteString -> Get Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getRemainingLazyByteString
    MsgPrintDep -> Get MsgPrintDep
forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgPrintDep :: Text -> MsgPrintDep
MsgPrintDep {Text
_msgPrintDep_text :: Text
_msgPrintDep_text :: Text
..}

  put :: MsgPrintDep -> Put
put MsgPrintDep {Text
_msgPrintDep_text :: Text
_msgPrintDep_text :: MsgPrintDep -> Text
..} = do
    ByteString -> Put
putByteString (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
_msgPrintDep_text

$(makeSBP 'msgPrintDep ''MsgPrintDep)
$(makeJSON "_msgPrintDep_" ''MsgPrintDep)
$(makeLenses ''MsgPrintDep)