packages feed

labsat (empty) → 0.0.0

raw patch · 10 files changed

+1536/−0 lines, 10 filesdep +attoparsecdep +basedep +bytestringsetup-changed

Dependencies added: attoparsec, base, bytestring, conduit, conduit-extra, labsat, lifted-async, lifted-base, optparse-generic, preamble, scientific, tasty, tasty-hunit, text

Files

+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (C) 2018 Swift Navigation Inc.++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ labsat.cabal view
@@ -0,0 +1,68 @@+name:                  labsat+version:               0.0.0+synopsis:              LabSat TCP Interface Wrapper+description:           labsat provides a wrapper around the LabSat3 TCP interface+homepage:              https://github.com/swift-nav/labsat+license:               MIT+license-file:          LICENSE+author:                Swift Navigation Inc.+maintainer:            Swift Navigation <dev@swiftnav.com>+copyright:             Copyright (C) 2015-2018 Swift Navigation, Inc.+build-type:            Simple+cabal-version:         >= 1.22++source-repository head+  type:                git+  location:            git@github.com:swift-nav/labsat.git++library+  hs-source-dirs:      src+  exposed-modules:     Labsat+                     , Labsat.Ctx+                     , Labsat.Types+                     , Labsat.Parser+  default-language:    Haskell2010+  ghc-options:         -Wall+  build-depends:       base >= 4.8 && < 5+                     , attoparsec+                     , bytestring+                     , conduit+                     , conduit-extra+                     , lifted-async+                     , lifted-base+                     , scientific+                     , preamble+                     , text++executable labsat+  default-language:    Haskell2010+  hs-source-dirs:      main+  main-is:             labsat-cli.hs+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N -Wall -O2+  build-depends:       base+                     , labsat+                     , optparse-generic+                     , preamble+                     , text++test-suite test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Test.hs+  other-modules:       Test.Labsat.Parser+  build-depends:       attoparsec+                     , base+                     , bytestring+                     , labsat+                     , preamble+                     , tasty+                     , tasty-hunit+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N -Wall+  default-language:    Haskell2010++--executable shake-labsat+--  main-is:             Shakefile.hs+--  ghc-options:         -threaded -rtsopts -with-rtsopts=-N -Wall+--  build-depends:       base >= 4.8 && < 5+--                     , shakers+--  efault-language:    Haskell2010
+ main/labsat-cli.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++-- | LabSat telnet interface+--+import Options.Generic+import Preamble+import Labsat++-- | Args+--+-- Program arguments.+--+data Args = Args+  {+    ip          :: Text+    -- ^ Host IP.+  , port        :: Int+    -- ^ Host port.+  } deriving (Show, Generic)++instance ParseRecord Args++-- | Run Labsat Telnet Wrapper+--+main :: IO ()+main = do+  args <- getRecord "Labsat Telnet Wrapper"+  labsatMain+    (ip args)+    (port args)
+ src/Labsat.hs view
@@ -0,0 +1,504 @@+{-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE NoImplicitPrelude   #-}+{-# LANGUAGE OverloadedStrings   #-}++module Labsat where++import           Control.Concurrent.Async.Lifted   (race_)+import           Control.Concurrent.Lifted         (threadDelay)+import           Data.Attoparsec.ByteString+import qualified Data.ByteString               as BS+import qualified Data.ByteString.Char8         as C+import           Data.Conduit+import           Data.Conduit.Attoparsec+import qualified Data.Conduit.Binary           as B+import           Data.Conduit.Network+import           Data.Text.Encoding               (encodeUtf8)+import           Labsat.Ctx+import           Labsat.Parser+import           Labsat.Types+import           Preamble+import           System.IO                 hiding (print, putStrLn)+++--------------------------------------------------------------------------------++-- | Bracketed opening, closing of a binary file.+--+withBinaryFile' :: (MonadIO m, MonadBaseControl IO m) => FilePath -> (Handle -> m a) -> m a+withBinaryFile' f = flip bracket (liftIO . hClose) $ do+    h <- liftIO $ openBinaryFile f AppendMode+    liftIO $ hSetBuffering h LineBuffering+    pure h++-- | Add Labsat end-of-line delimiters and send command+--+sendCmd :: MonadTcpCtx c m => ByteString -> m ()+sendCmd s = do+  ad <- view tcpAppData+  yield (s <> "\r\r\n") $$ appSink ad++-- | Strip ANSI color codes+--+colorStripper :: MonadIO m => Conduit ByteString m ByteString+colorStripper = do+  mx <- await+  case mx of+    Nothing -> pure ()+    Just bs ->+      case BS.findIndex isEscape bs of+        Nothing -> do+          yield bs+          colorStripper+        Just idx -> do+          let (prefix, escape) = BS.splitAt idx bs+          yield prefix+          case parse parseColorSeq escape of+            Fail{} -> do+              let (h,t) = BS.splitAt 1 escape+              yield h+              leftover t+            Partial _ -> leftover escape+            Done i _ -> leftover i+          colorStripper++-- | Receive command response and strip color codes+--+receiveResp :: MonadTcpCtx c m => Parser a -> m a+receiveResp p = runResourceT $ do+  ad <- view tcpAppData+  appSource ad =$= colorStripper $$ sinkParser p++-- | Receive command response, strip color codes, and log to file+--+logResp :: MonadTcpCtx c m => FilePath -> m ()+logResp lf = runResourceT $ do+  ad <- view tcpAppData+  withBinaryFile' lf $ \lh ->+    appSource ad =$= colorStripper $$ B.sinkHandle lh++-- | Send a command and parser for its response.+--+command :: (MonadTcpCtx c m) => ByteString -> Parser a -> m a+command c p = do+  sendCmd c+  receiveResp $ parseCommandAck c *> p++-- | Send a command and parse for OK and the prompt+--+okCommand :: (MonadTcpCtx c m) => ByteString -> m ByteString+okCommand = flip command okPrompt++-- Swallow first message, capture and print second one (debug)+--+debugRecv :: ByteString -> ByteString -> Int -> IO ()+debugRecv msg host port =+  runCtx $ runStatsCtx $+    runGeneralTCPClient (clientSettings port host) $+      flip runTcpCtx $ do+        msg0 <- receiveResp parseUntilPrompt+        putStrLn "First message:"+        print msg0++        putStrLn "Debug message:"+        sendCmd msg+        res <- receiveResp parseUntilPrompt+        print (res <> "LABSAT_V3 >")++testCommand :: (MonadStatsCtx c m, Show a) => ByteString -> Int -> TransT TcpCtx m a -> m ()+testCommand host port cmd =+  runGeneralTCPClient (clientSettings port host) $+    flip runTcpCtx $ do+      void $ receiveResp parseFirstLabsatMsg+      res <- cmd+      print res++--------------------------------------------------------------------------------+-- Commands+--------------------------------------------------------------------------------++-- | Optionally create argument string from Maybe a+--+-- | TODO fix this function so output doesn't have escaped quotes from 'show'+--+argFromMaybe :: (Show a) => ByteString -> Maybe a -> ByteString+argFromMaybe a m =+  case m of+    Nothing -> ""+    Just m' -> a ++ showToBs m'++-- Int -> ByteString+--+intToBs :: Int -> ByteString+intToBs = C.pack . show++-- Bool -> ByteString+--+boolToBs :: Bool -> ByteString+boolToBs = bool "N" "Y"++showToBs :: Show a => a -> ByteString+showToBs = C.pack . show++--------------------------------------------------------------------------------+-- Help command+--------------------------------------------------------------------------------++-- | HELP command.+--+help :: MonadTcpCtx c m => m HelpCommands+help = command "HELP" parseHelp++--------------------------------------------------------------------------------+-- Media command+--------------------------------------------------------------------------------++-- | MEDIA:LIST command.+--+mediaList :: MonadTcpCtx c m => m MediaList+mediaList = command "MEDIA:LIST" parseMediaList++-- | MEDIA:CHDIR:\ command.+--+mediaChdirRoot :: MonadTcpCtx c m => m ByteString+mediaChdirRoot = command "MEDIA:CHDIR:\\" parseMediaChdir++-- | MEDIA:CHDIR:.. command.+--+mediaChdirUp :: MonadTcpCtx c m => m ByteString+mediaChdirUp = command "MEDIA:CHDIR:.." parseMediaChdir++-- | MEDIA:CHDIR:<dir> command.+--+mediaChdir :: MonadTcpCtx c m => ByteString -> m ByteString+mediaChdir d = command ("MEDIA:CHDIR:" <> d) parseMediaChdir++-- | MEDIA:PROTECT:Y/N:FILE command.+--+mediaProtect :: MonadTcpCtx c m => Bool -> ByteString -> m ByteString+mediaProtect b f = okCommand $ "MEDIA:PROTECT:" <> bool "N:" "Y:" b <> f++-- | MEDIA:DELETE:FILE command.+--+mediaDelete :: MonadTcpCtx c m => ByteString -> m ByteString+mediaDelete f = okCommand $ "MEDIA:DELETE:" <> f++-- | MEDIA:SELECT:SD/USB/SATA command.+--+mediaSelect :: MonadTcpCtx c m => MediaType -> m ByteString+mediaSelect s = okCommand $ "MEDIA:SELECT:" <> showToBs s++--------------------------------------------------------------------------------+-- Play command+--------------------------------------------------------------------------------++-- | PLAY command.+--+play :: MonadTcpCtx c m => ByteString -> m ByteString+play f = command ("PLAY:FILE:" <> f) (parsePlay f)++-- | PLAY command that supports FOR and FROM+--+play' :: MonadTcpCtx c m => PlayConf -> m ByteString+play' pc = command cmd (parsePlay file')+  where+    for'  = argFromMaybe ":FOR:"  $ pc ^.pcFor+    from' = argFromMaybe ":FROM:" $ pc ^.pcFrom+    file' = pc ^. pcFile+    cmd = "PLAY:FILE:" <> file' <> for' <> from'++-- | PLAY:STOP command.+--+playStop :: MonadTcpCtx c m => m ByteString+playStop = okCommand "PLAY:STOP"++-- | PLAY:? command.+--+playStatus :: MonadTcpCtx c m => m PlayStatus+playStatus = command "PLAY:?" parsePlayStatus++--------------------------------------------------------------------------------+-- Type command+--------------------------------------------------------------------------------++-- | TYPE command. Named 'info' to avoid the obvious conflict.+--+info :: MonadTcpCtx c m => m Info+info = command "TYPE" parseInfo++--------------------------------------------------------------------------------+-- Find command+--------------------------------------------------------------------------------++-- | FIND command.+--+find :: MonadTcpCtx c m => m ByteString+find = okCommand "FIND"++--------------------------------------------------------------------------------+-- Mon command+--------------------------------------------------------------------------------++-- | MON:NMEA:ON command.+--+nmeaOn :: MonadTcpCtx c m => m ByteString+nmeaOn = okCommand "MON:NMEA:ON"++-- | MON:NMEA:OFF command.+--+nmeaOff :: MonadTcpCtx c m => m ByteString+nmeaOff = okCommand "MON:NMEA:OFF"++-- | Capture NMEA log for 'n' seconds+--+nmeaLog :: (MonadIO m, MonadTcpCtx c m) => Int -> FilePath -> m ()+nmeaLog n f = do+  void nmeaOn+  race_ (threadDelay $ n * 1000000) $ logResp f+  void nmeaOff+  pure ()++-- | MON:LOC command.+--+monLoc :: MonadTcpCtx c m => m Location+monLoc = command "MON:LOC" parseMonLoc++-- | MON:SAT command.+--+monSat :: MonadTcpCtx c m => m [ConstellationCNO]+monSat = command "MON:SAT" parseMonSat++--------------------------------------------------------------------------------+-- Rec command+--------------------------------------------------------------------------------++-- | REC command.+--+rec :: MonadTcpCtx c m => m ByteString+rec = command "REC" parseRec++-- | REC command that supports FILE and FOR.+--+rec' :: MonadTcpCtx c m => RecordConf -> m ByteString+rec' rc = command cmd parseRec+  where+    file' = argFromMaybe ":FILE:" $ rc ^. rcFile+    for'  = argFromMaybe ":FOR:"  $ rc ^. rcFor+    cmd = "REC" <> file' <> for'++-- | REC:STOP command.+--+recStop :: MonadTcpCtx c m => m ByteString+recStop = okCommand "REC:STOP"++-- | REC:? command.+--+recStatus :: MonadTcpCtx c m => m RecordStatus+recStatus = command "REC:?" parseRecordStatus++--------------------------------------------------------------------------------+-- Mute command+--------------------------------------------------------------------------------++-- | MUTE command.+--+mute :: MonadTcpCtx c m => Bool -> m ByteString+mute b = okCommand ("MUTE:" <> boolToBs b)++-- | MUTE command that supports individual channel control.+--+mute' :: MonadTcpCtx c m => MuteConf -> m MuteConf+mute' mc =+  case mc ^. mcMuteAll of+    Just b  -> command ("MUTE:" <> b2c b) parseMute+    Nothing -> do+      let ch1 = fromMaybeBoolToMuteStr "CH1" $ mc ^. mcMuteCh1+          ch2 = fromMaybeBoolToMuteStr "CH2" $ mc ^. mcMuteCh2+          ch3 = fromMaybeBoolToMuteStr "CH3" $ mc ^. mcMuteCh3+      command ("MUTE:" <> ch1 <> ch2 <> ch3) parseMute+    where+      b2c = boolToBs+      fromMaybeBoolToMuteStr prefix m = case m of+        Nothing -> ""+        Just b  -> ":" ++ prefix ++ ":" ++ b2c b++--------------------------------------------------------------------------------+-- Attentuation command+--------------------------------------------------------------------------------++-- | ATTN command.+--+attn :: MonadTcpCtx c m => Int -> m AttnConf+attn i = command ("ATTN:" <> intToBs i) parseAttn++-- | ATTN command that supports individual channel control.+--+attn' :: MonadTcpCtx c m => AttnConf -> m AttnConf+attn' ac =+  case ac ^. acAttnAll of+    Just i  -> command ("ATTN:" <> intToBs i) parseAttn+    Nothing -> do+      let ch1 = fromMaybeIntToAttnStr "CH1" $ ac ^. acAttnCh1+          ch2 = fromMaybeIntToAttnStr "CH2" $ ac ^. acAttnCh2+          ch3 = fromMaybeIntToAttnStr "CH3" $ ac ^. acAttnCh3+      command ("ATTN:" <> ch1 <> ch2 <> ch3) parseAttn+    where+      fromMaybeIntToAttnStr prefix m = case m of+        Nothing -> ""+        Just i  -> ":" ++ prefix ++ ":" ++ intToBs i++--------------------------------------------------------------------------------+-- Configuration command+--------------------------------------------------------------------------------++-- | CONF:PLAY:LOOP command.+--+confPlayLoop :: MonadTcpCtx c m => Bool -> m ByteString+confPlayLoop b = okCommand ("CONF:PLAY:LOOP:" <> boolToBs b)++-- | CONF:PLAY:PAUSE command.+--+confPlayPause :: MonadTcpCtx c m => Int -> m ByteString+confPlayPause i = okCommand ("CONF:PLAY:PAUSE:" <> intToBs i)++-- | CONF:PLAY:FOR command.+--+confPlayFor :: MonadTcpCtx c m => Int -> m ByteString+confPlayFor i = okCommand ("CONF:PLAY:FOR:" <> intToBs i)++-- | CONF:PLAY:FROM command.+--+confPlayFrom :: MonadTcpCtx c m => Int -> m ByteString+confPlayFrom i = okCommand ("CONF:PLAY:FROM:" <> intToBs i)++-- | CONF:PLAY:FOR:FROM command.+--+confPlayForFrom :: MonadTcpCtx c m => Int -> Int -> m ByteString+confPlayForFrom i j = okCommand ("CONF:PLAY:FOR:" <> intToBs i <> ":FROM:" <> intToBs j)++-- | CONF:REC:FOR command.+--+confRecFor :: MonadTcpCtx c m => Int -> m ByteString+confRecFor i = okCommand ("CONF:REC:FOR:" <> intToBs i)++-- | CONF:SETUP:DISP:CONT command.+--+confContrast :: MonadTcpCtx c m => Int -> m ByteString+confContrast i = okCommand ("CONF:SETUP:DISP:CONT:" <> intToBs i)++-- | CONF:SETUP:DISP:BRIG command.+--+confBrightness :: MonadTcpCtx c m => Int -> m ByteString+confBrightness i = okCommand ("CONF:SETUP:DISP:BRIG:" <> intToBs i)++-- | CONF:SETUP:PSAV command.+--+confPsav :: MonadTcpCtx c m => Bool -> m ByteString+confPsav b = okCommand ("CONF:SETUP:PSAV:" <> boolToBs b)++-- | CONF:SETUP:SYNC command.+--+confSync :: MonadTcpCtx c m => Bool -> m ByteString+confSync b = okCommand ("CONF:SETUP:SYNC:" <> boolToBs b)+++-- | CONF:SETUP:BEEP command.+--+confBeep :: MonadTcpCtx c m => Bool -> m ByteString+confBeep b = okCommand ("CONF:SETUP:BEEP:" <> boolToBs b)+++-- | CONF:SETUP:TIME:UTC command.+--+confTimeUTC :: MonadTcpCtx c m => m ByteString+confTimeUTC = okCommand "CONF:SETUP:TIME:UTC:Y"++-- | CONF:SETUP:TIME:MAN command.+--+confTimeManual :: MonadTcpCtx c m+               => ByteString+               -> ByteString+               -> ByteString+               -> ByteString+               -> ByteString+               -> ByteString+               -> m ByteString+confTimeManual year month day hours minutes seconds =+  okCommand ("CONF:SETUP:TIME:UTC:N:MAN:" <> intercalate ":" [year, month, day, hours, minutes, seconds])++-- | CONF:SETUP:DIGI command.+--+confDigi :: MonadTcpCtx c m => CANChannel -> DigitalFunction -> m ByteString+confDigi ch df = okCommand ("CONF:SETUP:DIGI:" <> showToBs ch <> ":" <> showToBs df)++-- | CONF:SETUP:CAN:CH*:BAUD command.+--+confCANBaud :: MonadTcpCtx c m => CANChannel -> Double -> m Double+confCANBaud ch val = command ("CONF:SETUP:CAN:" <> showToBs ch <> ":BAUD:" <> showToBs val) parseCANBaud+++-- | CONF:SETUP:CAN:SILENT command.+--+confCANSilent :: MonadTcpCtx c m => Bool -> m ByteString+confCANSilent b = okCommand ("CONF:SETUP:CAN:SILENT:" <> boolToBs b)++-- | CONF:SETUP:CAN:LOGFILE command.+--+confCANLogfile :: MonadTcpCtx c m => Bool -> m ByteString+confCANLogfile b = okCommand ("CONF:SETUP:CAN:LOGFILE:" <> boolToBs b)++-- | CONF:SETUP:CAN:REPLAYFILE command.+--+confCANReplayfile :: MonadTcpCtx c m => Bool -> m ByteString+confCANReplayfile b = okCommand ("CONF:SETUP:CAN:REPLAYFILE:" <> boolToBs b)++-- | CONF:SETUP:CLKREF:OCXO command.+--+confClkRefOCXO :: MonadTcpCtx c m => m ByteString+confClkRefOCXO = okCommand "CONF:SETUP:CLKREF:OCXO"++-- | CONF:SETUP:CLKREF:TCXO command.+--+confClkRefTCXO :: MonadTcpCtx c m => m ByteString+confClkRefTCXO = okCommand "CONF:SETUP:CLKREF:TCXO"++-- | CONF:SETUP:CLKREF:EXT command.+--+confClkRefEXT :: MonadTcpCtx c m => m ByteString+confClkRefEXT = okCommand "CONF:SETUP:CLKREF:EXT"++-- | CONF:SETUP:CLKREF:REFOUT command.+--+confClkRefout :: MonadTcpCtx c m => Bool -> m ByteString+confClkRefout b = okCommand ("CONF:SETUP:CLKREF:REFOUT:" <> boolToBs b)++-- | CONF:CONS command.+--+confConstellationPreset :: MonadTcpCtx c m => ConstellationPresetConf -> m ConstellationPresetConf+confConstellationPreset cc = command ("CONF:CONS:" <> showToBs cc) parseConsPreset++-- | CONF:CONS command.+--+confConstellationFreq :: MonadTcpCtx c m => ConstellationFreqConf -> m ConstellationFreqConf+confConstellationFreq cc = command ("CONF:CONS:" <> showToBs cc) parseConsFreq++-- | CONF:? command.+--+confQuery :: MonadTcpCtx c m => m ByteString+confQuery = command "CONF:?" parseUntilPrompt++-- | Labsat Main+--+labsatMain :: MonadControl m => Text -> Int -> m ()+labsatMain ip port= do+  putStrLn "Labsat!"+  print ip+  print port++  -- Example+  runCtx $ runStatsCtx $+    runGeneralTCPClient (clientSettings port $ encodeUtf8 ip) $+      flip runTcpCtx $ do+        void $ receiveResp parseFirstLabsatMsg+        resp <- info+        print resp
+ src/Labsat/Ctx.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE ConstraintKinds     #-}+{-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE NoImplicitPrelude   #-}+{-# LANGUAGE TemplateHaskell     #-}++module Labsat.Ctx where++import Data.Conduit.Network (AppData)+import Preamble++data TcpCtx = TcpCtx+  { _tcpStatsCtx :: StatsCtx+  , _tcpAppData :: AppData+  }++$(makeClassyConstraints ''TcpCtx [''HasStatsCtx])++instance HasStatsCtx TcpCtx where+  statsCtx = tcpStatsCtx++instance HasCtx TcpCtx where+  ctx = statsCtx . ctx++type MonadTcpCtx c m =+  ( MonadStatsCtx c m+  , HasTcpCtx c+  )++runTcpCtx :: MonadStatsCtx c m => AppData -> TransT TcpCtx m a -> m a+runTcpCtx ad action = do+  e <- view statsCtx+  runTransT (TcpCtx e ad) action+
+ src/Labsat/Parser.hs view
@@ -0,0 +1,362 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings   #-}++module Labsat.Parser where+++import qualified Data.ByteString as BS+import           Data.Attoparsec.ByteString+import           Data.Attoparsec.ByteString.Char8 (char, decimal, double, isDigit_w8, isEndOfLine, scientific, signed)+import           Labsat.Types+import           Preamble hiding (takeWhile)+++--------------------------------------------------------------------------------+-- Helper Parsers+--------------------------------------------------------------------------------++prompt :: Parser ByteString+prompt = string "LABSAT_V3 >"++newline :: Parser ByteString+newline = string "\r\r\n"++ok :: Parser ByteString+ok = string "OK"++err :: Parser ByteString+err = string "ERR"++colon :: Word8 -> Bool+colon = (== 58)++isETX :: Word8 -> Bool+isETX = (==03)++etx :: Parser Word8+etx = word8 03++isEscape :: Word8 -> Bool+isEscape = (== 27)++notNewline :: Word8 -> Bool+notNewline w = w /= 10 && w /= 13++parseNotNewline :: Parser Word8+parseNotNewline = satisfy notNewline++mediaDelim :: Parser ByteString+mediaDelim = string " \ESC[40G "++takeDigits :: Parser ByteString+takeDigits = takeWhile1 isDigit_w8++-- | Parse OK followed by prompt+--+okPrompt :: Parser ByteString+okPrompt = ok <* takeNewlines <* prompt++-- | Parse comma separated lists+--+commaSep :: Parser ByteString -> Parser [ByteString]+commaSep = flip sepBy' (char ',')++-- | take [\r\n]++--+takeNewlines :: Parser ()+takeNewlines = satisfy isEndOfLine *> skipWhile isEndOfLine++-- | Parse everything up to [\r\n]++--+parseLabsatLine :: Parser ByteString+parseLabsatLine = takeWhile1 (not . isEndOfLine) <* takeNewlines++-- | Parse lines until next Labsat prompt+--+parseLabsatLines :: Parser [ByteString]+parseLabsatLines = manyTill parseLabsatLine prompt++-- | Parse everything until next prompt (debug)+--+parseUntilPrompt :: Parser ByteString+parseUntilPrompt = BS.pack <$> manyTill anyWord8 prompt++-- | Parse everything up to and including next prompt (debug)+--+parseThroughPrompt :: Parser ByteString+parseThroughPrompt = do+  x <- parseUntilPrompt+  pure $ x <> "LABSAT_V3 >"++-- | Parse echoed command followed by newline(s)+--+parseCommandAck :: ByteString -> Parser ByteString+parseCommandAck cmd = string cmd <* takeNewlines++-- | Parse ANSI Color Escape Sequence+--+parseColorSeq :: Parser ByteString+parseColorSeq = do+  esc <- string "\ESC["+  n <- takeDigits+  m <- string "m"+  pure $ BS.concat [esc, n, m]++-- | Parse Labsat header+--+takeLabsatHeader :: Parser ByteString+takeLabsatHeader = takeWhile1 (not . isETX) <* etx++-- | Parse Y/N+--+parseYN :: Parser Bool+parseYN =+  (string "Y" >> pure True) <|>+  (string "N" >> pure False)++-- | Parse IP address+--+-- | TODO make sure its a valid IP address+parseIP :: Parser ByteString+parseIP = do+  octet1 <- takeDigits+  void $ char '.'+  octet2 <- takeDigits+  void $ char '.'+  octet3 <- takeDigits+  void $ char '.'+  octet4 <- takeDigits+  pure $ intercalate "." [octet1, octet2, octet3, octet4]++-- | Parse Duration HH:MM:SS+--+parseDuration :: Parser ByteString+parseDuration = do+  hh <- takeWhile isDigit_w8+  void $ char ':'+  mm <- takeWhile isDigit_w8+  void $ char ':'+  ss <- takeWhile isDigit_w8+  pure $ intercalate ":" [hh, mm, ss]++-- | Parse In Use Error+--+parseInUse :: Parser ByteString+parseInUse = takeLabsatHeader *> string "in use with " *> parseIP <* takeNewlines++-- | Parse First Labsat Message+--+parseFirstLabsatMsg :: Parser ByteString+parseFirstLabsatMsg = takeLabsatHeader <* takeNewlines *> prompt++--------------------------------------------------------------------------------+-- HELP Parsers+--------------------------------------------------------------------------------++parseHelp :: Parser HelpCommands+parseHelp =+  HelpCommands <$> ("Current commands are : " <* takeNewlines *> parseLabsatLines)++--------------------------------------------------------------------------------+-- MEDIA Parsers+--------------------------------------------------------------------------------++parseMediaFile :: Parser Media+parseMediaFile = File <$> (BS.pack <$> manyTill parseNotNewline mediaDelim) <*> parseDuration <* newline++parseMediaDir :: Parser Media+parseMediaDir = Dir <$> (BS.pack <$> manyTill parseNotNewline newline)++parseMedia :: Parser Media+parseMedia = parseMediaFile <|> parseMediaDir++parseMediaList :: Parser MediaList+parseMediaList = MediaList <$> manyTill parseMedia (newline *> prompt)++parseMediaChdir :: Parser ByteString+parseMediaChdir = takeWhile notNewline <* takeNewlines <* ok <* takeNewlines <* prompt++--------------------------------------------------------------------------------+-- PLAY Parsers+--------------------------------------------------------------------------------++parsePlayFile :: ByteString -> Parser ByteString+parsePlayFile = string++parsePlayIdle :: Parser PlayStatus+parsePlayIdle = do+  void "PLAY:IDLE"+  pure PlayIdle++parsePlaying :: Parser PlayStatus+parsePlaying =+  Playing <$> parseFile <*> parseDuration'+    where+      parseFile      = "PLAY:/mnt/sata/" *> takeWhile1 (not . colon)+      parseDuration' = ":DUR:" *> parseDuration++parsePlay :: ByteString -> Parser ByteString+parsePlay f = string f <* takeWhile notNewline <* takeNewlines <* prompt++parsePlayStatus :: Parser PlayStatus+parsePlayStatus = (parsePlayIdle <|> parsePlaying) <* takeNewlines <* prompt++--------------------------------------------------------------------------------+-- REC Parsers+--------------------------------------------------------------------------------+parseRec :: Parser ByteString+parseRec = takeWhile notNewline <* takeNewlines <* prompt++parseRecordIdle :: Parser RecordStatus+parseRecordIdle = do+  void "REC:IDLE"+  pure RecordIdle++parseRecording :: Parser RecordStatus+parseRecording =+  Recording <$> parseFile <*> parseDuration'+    where+      parseFile      = "REC:/mnt/sata/" *> takeWhile1 (not . colon)+      parseDuration' = ":DUR:" *> parseDuration++parseRecordStatus :: Parser RecordStatus+parseRecordStatus = (parseRecordIdle <|> parseRecording) <* takeNewlines <* prompt++--------------------------------------------------------------------------------+-- TYPE Parser+--------------------------------------------------------------------------------++parseInfo :: Parser Info+parseInfo = Info <$> parseLabsatLines++--------------------------------------------------------------------------------+-- MON Parsers+--------------------------------------------------------------------------------++-- | Constellation parser.+--+parseConstellation :: Parser Constellation+parseConstellation =+  (string "GPS" >> pure GPS) <|>+  (string "GLO" >> pure GLO) <|>+  (string "BDS" >> pure BDS) <|>+  (string "GAL" >> pure GAL)++-- | Satellite CNO parser.+--+parseSatelliteCNO :: Parser [SatelliteCNO]+parseSatelliteCNO = do+  res <- option [] (commaSep takeDigits <* takeNewlines)+  pure $ uncurry SatelliteCNO <$>  extractSatelliteCNOPairs res+    where+      extractSatelliteCNOPairs :: [ByteString] -> [(ByteString, ByteString)]+      extractSatelliteCNOPairs [] = []+      extractSatelliteCNOPairs [_] = error "Corrupt Satellite CNO information"+      extractSatelliteCNOPairs (x:y:xs) = (x,y) : extractSatelliteCNOPairs xs++-- | Constellation CNO parser.+--+parseConstellationCNO :: Parser ConstellationCNO+parseConstellationCNO =+  ConstellationCNO               <$>+    parseConstellation <* " "    <*>+    takeDigits <* takeNewlines   <*>+    parseSatelliteCNO++-- | 'MON:LOC' parser+--+-- | TODO handle case when record/replay is turned off and ',0.000000,,,,,' is returned+--+parseMonLoc :: Parser Location+parseMonLoc = Location <$> double <* "," <*> parseLocation <* "," <*> parseLocation <* "," <*> parseLocation+  where+    parseLocation = (,) <$> double <* "," <*> parseDirection+    parseDirection = takeWhile1 (inClass "MNSEW")++-- | 'MON:SAT' parser+--+parseMonSat :: Parser [ConstellationCNO]+parseMonSat = manyTill parseConstellationCNO prompt++--------------------------------------------------------------------------------+-- MUTE Parsers+--------------------------------------------------------------------------------++-- | 'MUTE' parser+--+parseMute :: Parser MuteConf+parseMute =+  MuteConf <$>+    pure Nothing <*>+    parseChannelMute "CH1" <*>+    parseChannelMute "CH2" <*>+    parseChannelMute "CH3" <* ok <* takeNewlines <* prompt+    where+      parseChannelId ch = string $ "OK:MUTE:"++ch++":"+      parseChannelMute ch = option Nothing (parseChannelId ch *> (Just <$> parseYN) <* optWhitespace)+      optWhitespace = option "" " \r\r\n"++--------------------------------------------------------------------------------+-- ATTN Parsers+--------------------------------------------------------------------------------++-- | 'ATTN' parser+--+parseAttn :: Parser AttnConf+parseAttn =+  AttnConf <$>+    pure Nothing <*>+    parseChannelAttn "CH1" <*>+    parseChannelAttn "CH2" <*>+    parseChannelAttn "CH3" <* ok <* takeNewlines <* prompt+    where+      parseChannelId ch = string $ "OK:ATTN:"++ch++":"+      parseChannelAttn ch = option Nothing (parseChannelId ch *> (Just <$> signed decimal) <* " " <* takeNewlines)++--------------------------------------------------------------------------------+-- CONF Parsers+--------------------------------------------------------------------------------++-- | 'CONF:SETUP:CAN:CHX:BAUD' parser+--+parseCANBaud :: Parser Double+parseCANBaud = "baud value is " *> double <* " " <* takeNewlines <* okPrompt+++parseQuantization :: Parser Quantization+parseQuantization = (string "QUA-1" >> pure QUA1) <|>+                    (string "QUA-2" >> pure QUA2) <|>+                    (string "QUA-3" >> pure QUA3)+++parseBandwidth :: Parser Bandwidth+parseBandwidth = (string "BW-10" >> pure BW_10) <|>+                 (string "BW-30" >> pure BW_30) <|>+                 (string "BW-56" >> pure BW_56)++-- | 'CONF:CONS' parsers+--+-- | WARNING: The output of CONF:CONS relies on a leading space in some cases+--+-- | TODO: cleanup+parseConsPreset :: Parser ConstellationPresetConf+parseConsPreset =+  ConstellationPresetConf <$> parseQua <*> parseBW <*> parsePresets <* takeNewlines <* okPrompt+    where parseQua   = parseQuantization <* ", "+          parseBW    = parseBandwidth <* ", "+          parsePresets = do+            void $ string "Available ch(" <* takeDigits <* string ") "+            presets <- takeDigits `sepBy'` string ", " <* string " "+            pure $ freqPresetLookup <$> presets++parseConsFreq :: Parser ConstellationFreqConf+parseConsFreq =+  ConstellationFreqConf <$> parseQua <*> parseBW <*> parseFreqs <* takeNewlines <* okPrompt+    where optHeader  = option "" ("TELNET_CONF " <* takeNewlines)+          parseQua   = optHeader *> " " *> parseQuantization <* ", "+          parseBW    = parseBandwidth <* ", "+          parseFreqs = do+            void $ string "Available ch(" <* takeDigits <* string ") "+            scientific `sepBy'` string ", " <* string " "++
+ src/Labsat/Types.hs view
@@ -0,0 +1,310 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell   #-}++module Labsat.Types where++import Data.Scientific+import Preamble+++-- | HelpCommands: List of commands returned by 'HELP'+--+newtype HelpCommands =+  HelpCommands [ByteString]+  deriving (Eq, Show)++$(makePrisms ''HelpCommands)+++-- | Info: List of information returned by 'TYPE'+--+newtype Info =+  Info [ByteString]+  deriving (Eq, Show)++$(makePrisms ''Info)++-- | PlayStatus: Playback status, Idle or Playing+--+data PlayStatus =+    Playing ByteString ByteString+  | PlayIdle+  deriving (Eq, Show)++$(makePrisms ''PlayStatus)++-- | RecordStatus: Recording status, Idle or Recording+--+data RecordStatus =+    Recording ByteString ByteString+  | RecordIdle+  deriving (Eq, Show)++$(makePrisms ''RecordStatus)++-- | PlayConf: Playback configuration+--+data PlayConf = PlayConf+  { -- File to playback+    _pcFile :: ByteString+    -- Playback duration+  , _pcFor  :: Maybe Int+    -- Starting position+  , _pcFrom :: Maybe Int+  } deriving (Eq, Show)++$(makeLenses ''PlayConf)++-- | RecConf: Record configuration+--+data RecordConf = RecordConf+  { -- File to record+    _rcFile :: Maybe ByteString+    -- Record duration+  , _rcFor  :: Maybe Int+  } deriving (Eq, Show)++$(makeLenses ''RecordConf)++-- | MuteConf: Mute configuration+--+data MuteConf = MuteConf+  { -- Mute all (overrides the rest)+    _mcMuteAll :: Maybe Bool+    -- Mute channel 1+  , _mcMuteCh1 :: Maybe Bool+    -- Mute channel 2+  , _mcMuteCh2 :: Maybe Bool+    -- Mute channel 3+  , _mcMuteCh3 :: Maybe Bool+  } deriving (Eq, Show)++$(makeLenses ''MuteConf)++-- | Attentuation configuration.+--+data AttnConf = AttnConf+  { -- Attentuation value for all channels+    _acAttnAll :: Maybe Int+    -- Attentuation value for channel 1+  , _acAttnCh1 :: Maybe Int+    -- Attentuation value for channel 2+  , _acAttnCh2 :: Maybe Int+    -- Attentuation value for channel 3+  , _acAttnCh3 :: Maybe Int+  } deriving (Eq, Show)++$(makeLenses ''AttnConf)++-- | Media: File or Directory+--+data Media =+    File ByteString ByteString+  | Dir ByteString+  deriving (Eq, Show)++$(makePrisms ''Media)++-- | MediaList: List of files and directories+--+newtype MediaList =+  MediaList [Media]+  deriving (Eq, Show)++$(makePrisms ''MediaList)++-- | Media type+--+data MediaType = USB | SD | SATA+  deriving (Eq, Show)++$(makePrisms ''MediaType)++-- | Digital Function type+data DigitalFunction = OFF | CAN1 | CAN2 | RS232 | DIGI1 | DIGI2 | OnePPS+  deriving (Eq, Show)++$(makePrisms ''DigitalFunction)++-- | CAN Bus Channel+--+data CANChannel = CAN_CH1 | CAN_CH2++$(makePrisms ''CANChannel)++instance Show CANChannel where+  show CAN_CH1 = "CH1"+  show CAN_CH2 = "CH2"++-- | Bandwidth type+--+data Bandwidth = BW_10 | BW_30 | BW_56+  deriving (Eq)++$(makePrisms ''Bandwidth)++instance Show Bandwidth where+  show BW_10 = "BW:10"+  show BW_30 = "BW:30"+  show BW_56 = "BW:56"++-- | Quantization type+--+data Quantization = QUA1 | QUA2 | QUA3+  deriving (Eq)++$(makePrisms ''Quantization)++instance Show Quantization where+  show QUA1 = "QUA:1"+  show QUA2 = "QUA:2"+  show QUA3 = "QUA:3"++-- | Frequency presets+--+data FreqPreset =+    Beidou1+  | Beidou2+  | Beidou3+  | Freq1191_795MHz+  | Freq1233_738MHz+  | Freq1567_236MHz+  | Freq1580MHz+  | GLONASS1+  | GLONASS2+  | GPS1+  | GPS2+  | GPS5+  | Galileo6+  | LBand+  | UnknownPreset ByteString+  deriving (Eq)++$(makePrisms ''FreqPreset)++instance Show FreqPreset where+  show Beidou1           = "5"+  show Beidou2           = "12"+  show Beidou3           = "8"+  show Freq1191_795MHz   = "14"+  show Freq1233_738MHz   = "10"+  show Freq1567_236MHz   = "4"+  show Freq1580MHz       = "2"+  show GLONASS1          = "1"+  show GLONASS2          = "9"+  show GPS1              = "3"+  show GPS2              = "11"+  show GPS5              = "13"+  show Galileo6          = "7"+  show LBand             = "6"+  show (UnknownPreset a) = show a++freqPresetLookup :: ByteString -> FreqPreset+freqPresetLookup bs =+  case bs of+    "5"  -> Beidou1+    "12" -> Beidou2+    "8"  -> Beidou3+    "14" -> Freq1191_795MHz+    "10" -> Freq1233_738MHz+    "4"  -> Freq1567_236MHz+    "2"  -> Freq1580MHz+    "1"  -> GLONASS1+    "9"  -> GLONASS2+    "3"  -> GPS1+    "11" -> GPS2+    "13" -> GPS5+    "7"  -> Galileo6+    "6"  -> LBand+    other -> UnknownPreset other++-- | Constellation Preset Configuration+--+data ConstellationPresetConf = ConstellationPresetConf+  { -- Signal quantization+    _cpcQuantization :: Quantization+    -- Bandwidth+  , _cpcBandwidth :: Bandwidth+    -- Frequency presets (up to three)+  , _cpcFreqPresets :: [FreqPreset]+  }++$(makeLenses ''ConstellationPresetConf)++instance Show ConstellationPresetConf where+  show cpc = joinColon [quant, bandwidth, presets]+    where joinColon = intercalate ":"+          freqs     = cpc ^. cpcFreqPresets+          quant     = show $ cpc ^. cpcQuantization+          bandwidth = show $ cpc ^. cpcBandwidth+          presets   = if null freqs+                      then ""+                      else joinColon ("SETS" : map show freqs)++-- | Constellation Frequency Configuration+--+data ConstellationFreqConf = ConstellationFreqConf+  { -- Signal quantization+    _cfcQuantization :: Quantization+    -- Bandwidth+  , _cfcBandwidth :: Bandwidth+    -- Frequencies+  , _cfcFrequencies :: [Scientific]+  } deriving (Eq)++$(makeLenses ''ConstellationFreqConf)++instance Show ConstellationFreqConf where+  show cfc = joinColon [quant, bandwidth, presets]+    where joinColon = intercalate ":"+          freqs     = cfc ^. cfcFrequencies+          quant     = show $ cfc ^. cfcQuantization+          bandwidth = show $ cfc ^. cfcBandwidth+          presets   = if null freqs+                      then ""+                      else joinColon ("FREQ" : map show freqs)++-- | Satellite navigation systems+--+data Constellation+  = BDS        -- ^ Chinese BeiDou (Compass)+  | GAL        -- ^ European Galileo+  | GLO        -- ^ Russian GLONASS+  | GPS        -- ^ US NAVSTAR GPS+  deriving (Eq, Show)++$(makePrisms ''Constellation)++-- | Satellite CNO: Carrier-to-noise ration for a satellite+--+data SatelliteCNO =+  SatelliteCNO ByteString ByteString+  deriving (Eq, Show)++$(makePrisms ''SatelliteCNO)+++-- | CNO: Carrier-to-noise ratio for a constellation+--+data ConstellationCNO =+  ConstellationCNO Constellation ByteString [SatelliteCNO]+  deriving (Eq, Show)++$(makePrisms ''ConstellationCNO)++-- | Location+--+data Location = Location+  { -- GPS Time+    _time      :: Double+    -- Elevation (meters, direction)+  , _height    :: (Double, ByteString)+    -- Lattitude (degrees, direction)+  , _lattitude :: (Double, ByteString)+    -- Longitude (degrees, direction)+  , _longitude :: (Double, ByteString)+  } deriving (Eq, Show)++$(makeLenses ''Location)+
+ test/Test.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++import           Preamble+import qualified Test.Labsat.Parser as Parser+import           Test.Tasty++tests :: TestTree+tests =+  testGroup "Tests"+    [ Parser.tests+    ]++main :: IO ()+main = defaultMain tests
+ test/Test/Labsat/Parser.hs view
@@ -0,0 +1,190 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module Test.Labsat.Parser+  ( tests+  ) where++import Data.Attoparsec.ByteString+import Data.ByteString+import Labsat.Parser+import Labsat.Types+import Preamble+import Test.Tasty+import Test.Tasty.HUnit++parser :: (Eq a, Show a) => Parser a -> ByteString -> Either String a -> Assertion+parser p s r = parseOnly p s @?= r++--------------------------------------------------------------------------------+-- HELP Parsers+--------------------------------------------------------------------------------+helpOutput :: ByteString+helpOutput = "Current commands are : \r\r\n\r\r\nHELP\r\r\nTYPE\r\r\nFIND\r\r\nMON\r\r\nPLAY\r\r\nREC\r\r\nATTN\r\r\nCONF\r\r\nMEDIA\r\r\nMUTE\r\r\n\r\r\n\r\r\nLABSAT_V3 >"++helpResult :: HelpCommands+helpResult = HelpCommands ["HELP","TYPE","FIND","MON","PLAY","REC","ATTN","CONF","MEDIA","MUTE"]++testHelp :: TestTree+testHelp =+  testGroup "Test help parser"+    [ testCase "Help without colors" $ parser parseHelp helpOutput $ Right helpResult+    ]++--------------------------------------------------------------------------------+-- MEDIA Parsers+--------------------------------------------------------------------------------+mediaListOutput :: ByteString+mediaListOutput = "ABC \ESC[40G 00:00:00\r\r\nASDF\r\r\nFile_001 \ESC[40G 00:05:40\r\r\nFile_002 \ESC[40G 00:21:17\r\r\nLabSat 3 Wideband Demo SSD files\r\r\n\r\r\nLABSAT_V3 >"++mediaListResult :: MediaList+mediaListResult = MediaList [File "ABC" "00:00:00",Dir "ASDF",File "File_001" "00:05:40",File "File_002" "00:21:17",Dir "LabSat 3 Wideband Demo SSD files"]++testMedia :: TestTree+testMedia =+  testGroup "Test media parsers"+    [ testCase "Media list" $ parser parseMediaList mediaListOutput $ Right mediaListResult+    ]++--------------------------------------------------------------------------------+-- PLAY Parsers+--------------------------------------------------------------------------------+playFileOutput :: ByteString+playFileOutput = "File_001\r\r\n\r\r\nLABSAT_V3 >"++statusPlayingOutput :: ByteString+statusPlayingOutput = "PLAY:/mnt/sata/File_001:DUR:00:00:20\r\r\n\r\r\nLABSAT_V3 >"++statusPlayingResult :: PlayStatus+statusPlayingResult = Playing "File_001" "00:00:20"++statusIdleOutput :: ByteString+statusIdleOutput = "PLAY:IDLE\r\r\n\r\r\nLABSAT_V3 >"++testPlay :: TestTree+testPlay =+  testGroup "Test play parsers"+    [ testCase "Play file" $ parser (parsePlay "File_001") playFileOutput $ Right "File_001"+    , testCase "Status playing" $ parser parsePlayStatus statusPlayingOutput $ Right statusPlayingResult+    , testCase "Status idle" $ parser parsePlayStatus statusIdleOutput $ Right PlayIdle+    ]++--------------------------------------------------------------------------------+-- REC Parsers+--------------------------------------------------------------------------------+statusRecordingOutput :: ByteString+statusRecordingOutput = "REC:/mnt/sata/File_004:DUR:00:00:08\r\r\n\r\r\nLABSAT_V3 >"++statusRecordingResult :: RecordStatus+statusRecordingResult = Recording "File_004" "00:00:08"++statusRecordIdleOutput :: ByteString+statusRecordIdleOutput = "REC:IDLE\r\r\n\r\r\nLABSAT_V3 >"++testRecord :: TestTree+testRecord =+  testGroup "Test record parsers"+    [ testCase "Recordfile" $ parser parseRec playFileOutput $ Right "File_001"+    , testCase "Status playing" $ parser parseRecordStatus statusRecordingOutput $ Right statusRecordingResult+    , testCase "Status idle" $ parser parseRecordStatus statusRecordIdleOutput $ Right RecordIdle+    ]++--------------------------------------------------------------------------------+-- TYPE Parser+--------------------------------------------------------------------------------+typeOutput :: ByteString+typeOutput = "Labsat Wideband\r\nSerial 57082 \r\nFirmware 1.0.260\r\nFPGA 33\r\nIP 10.1.22.44\r\nBattery not connected\r\nTCXO-0x7b7f\r\n\r\r\n\r\r\nLABSAT_V3 >"++typeResult :: Info+typeResult = Info ["Labsat Wideband","Serial 57082 ","Firmware 1.0.260","FPGA 33","IP 10.1.22.44","Battery not connected","TCXO-0x7b7f"]++testType :: TestTree+testType =+  testGroup "Test type parser"+    [ testCase "Type command" $ parser parseInfo typeOutput $ Right typeResult+    ]++--------------------------------------------------------------------------------+-- MON Parsers+--------------------------------------------------------------------------------++monSatOutput :: ByteString+monSatOutput = "GPS 9\r\r\n05,42,07,52,08,43,09,52,16,35,23,47,27,43,28,42,30,49\r\r\n\r\r\nGLO 10\r\r\n01,50,02,52,03,36,08,37,10,36,11,50,12,50,13,32,20,31,21,40\r\r\n\r\r\nBDS 0\r\r\n\r\r\nGAL 4\r\r\n01,44,04,42,19,44,20,36\r\r\n\r\r\nLABSAT_V3 >"++monSatResult :: [ConstellationCNO]+monSatResult = [ConstellationCNO GPS "9" [SatelliteCNO "05" "42",SatelliteCNO "07" "52",SatelliteCNO "08" "43",SatelliteCNO "09" "52",SatelliteCNO "16" "35",SatelliteCNO "23" "47",SatelliteCNO "27" "43",SatelliteCNO "28" "42",SatelliteCNO "30" "49"],ConstellationCNO GLO "10" [SatelliteCNO "01" "50",SatelliteCNO "02" "52",SatelliteCNO "03" "36",SatelliteCNO "08" "37",SatelliteCNO "10" "36",SatelliteCNO "11" "50",SatelliteCNO "12" "50",SatelliteCNO "13" "32",SatelliteCNO "20" "31",SatelliteCNO "21" "40"],ConstellationCNO BDS "0" [],ConstellationCNO GAL "4" [SatelliteCNO "01" "44",SatelliteCNO "04" "42",SatelliteCNO "19" "44",SatelliteCNO "20" "36"]]++monLocOutput :: ByteString+monLocOutput = "123456.00,-5.800000,M,1234.12345,N,54321.54321,W\r\r\n\r\r\nLABSAT_V3 >"++monLocResult :: Location+monLocResult = Location {_time = 123456.0, _height = (-5.8,"M"), _lattitude = (1234.12345,"N"), _longitude = (54321.54321,"W")}++testMon :: TestTree+testMon =+  testGroup "Test MON parsers"+    [ testCase "Test MON:SAT" $ parser parseMonSat monSatOutput $ Right monSatResult+    , testCase "Test MON:LOC" $ parser parseMonLoc monLocOutput $ Right monLocResult+    ]++--------------------------------------------------------------------------------+-- ATTN Parsers+--------------------------------------------------------------------------------++attnOutput1 :: ByteString+attnOutput1 = "OK:ATTN:CH1:0 \r\r\nOK:ATTN:CH2:0 \r\r\nOK:ATTN:CH3:0 \r\r\nOK\r\r\n\r\r\nLABSAT_V3 >"++attnOutput2 :: ByteString+attnOutput2 = "OK:ATTN:CH1:10 \r\r\nOK:ATTN:CH3:10 \r\r\nOK\r\r\n\r\r\nLABSAT_V3 >"++attnResult1 :: AttnConf+attnResult1 = AttnConf {_acAttnAll = Nothing, _acAttnCh1 = Just 0, _acAttnCh2 = Just 0, _acAttnCh3 = Just 0}++attnResult2 :: AttnConf+attnResult2 = AttnConf {_acAttnAll = Nothing, _acAttnCh1 = Just 10, _acAttnCh2 = Nothing, _acAttnCh3 = Just 10}++testAttn :: TestTree+testAttn =+  testGroup "Test ATTN parsers"+    [ testCase "Test ATTN:0" $ parser parseAttn attnOutput1 $ Right attnResult1+    , testCase "Test ATTN:CH1:10:CH3:10" $ parser parseAttn attnOutput2 $ Right attnResult2+    ]++--------------------------------------------------------------------------------+-- CONF Parsers+--------------------------------------------------------------------------------++canBaudOutput :: ByteString+canBaudOutput = "baud value is 500000.000000 \r\r\nOK\r\r\n\r\r\nLABSAT_V3 >"++canBaudResult :: Double+canBaudResult = 500000.0++consFreqOutput :: ByteString+consFreqOutput = "TELNET_CONF \r\r\n QUA-1, BW-10, Available ch(1) 1575420000, 1207140014, 1268520019 \r\r\nOK\r\r\n\r\r\nLABSAT_V3 >"++consFreqResult :: ConstellationFreqConf+consFreqResult = ConstellationFreqConf {+                  _cfcQuantization = QUA1,+                  _cfcBandwidth = BW_10,+                  _cfcFrequencies = [1.57542e9,1.207140014e9,1.268520019e9]}++testConf :: TestTree+testConf =+  testGroup "Test CONF parsers"+  [ testCase "Test CONF:SETUP:CAN:CH1:BAUD:500000" $ parser parseCANBaud canBaudOutput $ Right canBaudResult+  , testCase "Test CONF:CONS:QUA:1:BW:10:FREQ:1575420000" $ parser parseConsFreq consFreqOutput $ Right consFreqResult+  ]++tests :: TestTree+tests =+  testGroup "LabSat parser tests"+    [ testHelp+    , testMedia+    , testPlay+    , testRecord+    , testType+    , testMon+    , testAttn+    , testConf+    ]