labsat 0.0.2 → 0.0.3
raw patch · 5 files changed
+44/−35 lines, 5 files
Files
- labsat.cabal +1/−1
- main/labsat-cli.hs +4/−1
- src/Labsat.hs +23/−22
- src/Labsat/Ctx.hs +11/−7
- src/Labsat/Parser.hs +5/−4
labsat.cabal view
@@ -1,5 +1,5 @@ name: labsat-version: 0.0.2+version: 0.0.3 synopsis: LabSat TCP Interface Wrapper description: labsat provides a wrapper around the LabSat3 TCP interface homepage: https://github.com/swift-nav/labsat
main/labsat-cli.hs view
@@ -4,9 +4,9 @@ -- | LabSat telnet interface --+import Labsat import Options.Generic import Preamble-import Labsat -- | Args --@@ -18,6 +18,8 @@ -- ^ Host IP. , port :: Int -- ^ Host port.+ , timeout :: Maybe Int+ -- ^ Command delay. } deriving (Show, Generic) instance ParseRecord Args@@ -30,3 +32,4 @@ labsatMain (ip args) (port args)+ (timeout args)
src/Labsat.hs view
@@ -1,24 +1,24 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-} module Labsat where -import Control.Concurrent.Async.Lifted (race_)-import Control.Concurrent.Lifted (threadDelay)+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 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 qualified Data.Conduit.Binary as B import Data.Conduit.Network-import Data.Text.Encoding (encodeUtf8)+import Data.Text.Encoding (encodeUtf8) import Labsat.Ctx import Labsat.Parser import Labsat.Types import Preamble-import System.IO hiding (print, putStrLn)+import System.IO hiding (print, putStrLn) --------------------------------------------------------------------------------@@ -34,9 +34,9 @@ -- | Add Labsat end-of-line delimiters and send command -- sendCmd :: MonadLabsatCtx c m => ByteString -> m ()-sendCmd s = do+sendCmd s = runResourceT $ do ad <- view lsAppData- yield (s <> "\r\r\n") $$ appSink ad+ yield (s <> "\r\r\n") =$= B.conduitFile "labsat.log" $$ appSink ad -- | Strip ANSI color codes --@@ -67,7 +67,7 @@ receiveResp :: MonadLabsatCtx c m => Parser a -> m a receiveResp p = runResourceT $ do ad <- view lsAppData- appSource ad =$= colorStripper $$ sinkParser p+ appSource ad =$= colorStripper =$= B.conduitFile "labsat.log" $$ sinkParser p -- | Receive command response, strip color codes, and log to file --@@ -84,9 +84,11 @@ -- | Send a command and parser for its response. ---command :: (MonadLabsatCtx c m) => ByteString -> Parser a -> m a+command :: MonadLabsatCtx c m => ByteString -> Parser a -> m a command c p = do+ delay <- view lsDelay sendCmd c+ traverse_ threadDelay delay receiveResp $ parseCommandAck c *> p -- | Send a command and parse for OK and the prompt@@ -99,7 +101,7 @@ debugRecv :: ByteString -> ByteString -> Int -> IO () debugRecv msg host port = runCtx $ runStatsCtx $- runLabsatCtx host port $ do+ runLabsatCtx host port Nothing $ do msg0 <- receiveResp parseUntilPrompt putStrLn "First message:" print msg0@@ -111,7 +113,7 @@ testCommand :: (MonadStatsCtx c m, Show a) => ByteString -> Int -> TransT LabsatCtx m a -> m () testCommand host port cmd =- runLabsatCtx host port $ do+ runLabsatCtx host port Nothing $ do void $ receiveResp parseFirstLabsatMsg res <- cmd print res@@ -492,15 +494,14 @@ -- | Labsat Main ---labsatMain :: MonadControl m => Text -> Int -> m ()-labsatMain ip port= do+labsatMain :: MonadControl m => Text -> Int -> Maybe Int -> m ()+labsatMain ip port timeout = do putStrLn "Labsat!" print ip print port+ print timeout -- Example runCtx $ runStatsCtx $- runLabsatCtx (encodeUtf8 ip) port $ do- void $ receiveResp parseFirstLabsatMsg- resp <- info- print resp+ runLabsatCtx (encodeUtf8 ip) port timeout $+ connectMsg >> info >> pure ()
src/Labsat/Ctx.hs view
@@ -1,7 +1,7 @@-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TemplateHaskell #-} module Labsat.Ctx where @@ -10,7 +10,11 @@ data LabsatCtx = LabsatCtx { _lsStatsCtx :: StatsCtx+ -- ^ Parent context , _lsAppData :: AppData+ -- ^ AppData for runGeneralTCPClient+ , _lsDelay :: Maybe Int+ -- ^ Command delay } $(makeClassyConstraints ''LabsatCtx [''HasStatsCtx])@@ -26,9 +30,9 @@ , HasLabsatCtx c ) -runLabsatCtx :: MonadStatsCtx c m => ByteString -> Int -> TransT LabsatCtx m a -> m a-runLabsatCtx host port action =+runLabsatCtx :: MonadStatsCtx c m => ByteString -> Int -> Maybe Int -> TransT LabsatCtx m a -> m a+runLabsatCtx host port timeout action = runGeneralTCPClient (clientSettings port host) $ \ad -> do e <- view statsCtx- runTransT (LabsatCtx e ad) action+ runTransT (LabsatCtx e ad timeout) action
src/Labsat/Parser.hs view
@@ -1,14 +1,15 @@ {-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}+{-# 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 Data.Attoparsec.ByteString.Char8 (char, decimal, double, isDigit_w8,+ isEndOfLine, scientific, signed)+import qualified Data.ByteString as BS import Labsat.Types-import Preamble hiding (takeWhile)+import Preamble hiding (takeWhile) --------------------------------------------------------------------------------