ntrip-client 0.1.2 → 0.1.3
raw patch · 3 files changed
+39/−28 lines, 3 filesdep +exceptionsdep +lifted-asyncdep +monad-controldep −async
Dependencies added: exceptions, lifted-async, monad-control
Dependencies removed: async
Files
- main/ntrip-client.hs +3/−7
- ntrip-client.cabal +5/−3
- src/Network/Ntrip/Client.hs +31/−18
main/ntrip-client.hs view
@@ -15,13 +15,9 @@ instance ParseRecord Args -output :: ByteString -> IO ()-output bs = do- hPut stdout bs- hFlush stdout- main :: IO () main = do args <- getRecord "NTRIP Client"- runNtrip (url args) sourceNull (mapM_ output)-+ runNtrip (url args) sourceNull $ mapM_ $ \bs -> do+ hPut stdout bs+ hFlush stdout
ntrip-client.cabal view
@@ -1,5 +1,5 @@ name: ntrip-client-version: 0.1.2+version: 0.1.3 synopsis: NTRIP client. description: Networked Transport of RTCM via Internet Protocol client. license: BSD3@@ -15,8 +15,7 @@ exposed-modules: Network.Ntrip.Client ghc-options: -Wall default-language: Haskell2010- build-depends: async- , attoparsec+ build-depends: attoparsec , base >= 4.7 && < 5 , base64-bytestring , basic-prelude@@ -24,8 +23,11 @@ , case-insensitive , conduit , conduit-extra+ , exceptions , http-types , lens+ , lifted-async+ , monad-control , uri-bytestring executable ntrip-client
src/Network/Ntrip/Client.hs view
@@ -1,28 +1,41 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} module Network.Ntrip.Client where -import BasicPrelude hiding (intercalate, tail)-import Control.Concurrent.Async-import Control.Lens-import Data.Attoparsec.ByteString-import Data.Attoparsec.ByteString.Char8 (decimal, endOfLine, isEndOfLine)-import Data.ByteString-import Data.ByteString.Base64-import Data.CaseInsensitive-import Data.Conduit-import Data.Conduit.Attoparsec-import Data.Conduit.Network-import Network.HTTP.Types-import URI.ByteString+import BasicPrelude hiding (intercalate, tail)+import Control.Concurrent.Async.Lifted+import Control.Lens+import Control.Monad.Catch+import Control.Monad.Trans.Control+import Data.Attoparsec.ByteString+import Data.Attoparsec.ByteString.Char8 (decimal, endOfLine, isEndOfLine)+import Data.ByteString+import Data.ByteString.Base64+import Data.CaseInsensitive+import Data.Conduit+import Data.Conduit.Attoparsec+import Data.Conduit.Network+import Network.HTTP.Types+import URI.ByteString -tcpClient :: ByteString -> Int -> Source IO ByteString -> Sink ByteString IO () -> IO ()+type MonadNtrip m =+ ( MonadBaseControl IO m+ , MonadIO m+ , MonadThrow m+ )++type SourceByteString m = Source m ByteString+type SinkByteString m = Sink ByteString m ()++tcpClient :: MonadNtrip m => ByteString -> Int -> SourceByteString m -> SinkByteString m -> m () tcpClient host port source sink =- runTCPClient (clientSettings port host) $ \ad ->+ runGeneralTCPClient (clientSettings port host) $ \ad -> void $ concurrently (source $$ appSink ad) (appSource ad $$ sink) -sourceNtrip :: ByteString -> ByteString -> ByteString -> Source IO ByteString -> Source IO ByteString+sourceNtrip :: MonadNtrip m => ByteString -> ByteString -> ByteString -> SourceByteString m -> SourceByteString m sourceNtrip path user password source = do yield $ intercalate "\r\n" [ methodGet <> " " <> path <> " HTTP/1.0"@@ -47,14 +60,14 @@ parseCode = decimal <* takeSpace parseMessage = takeEndOfLine1 <* endOfLine -sinkNtrip :: Sink ByteString IO () -> Sink ByteString IO ()+sinkNtrip :: MonadNtrip m => SinkByteString m -> SinkByteString m sinkNtrip sink = do (format, status) <- sinkParser parseNtrip unless (format == "ICY") $ throwIO $ userError "Unsupported format" unless (status == status200) $ throwIO $ userError "Bad status" sink -runNtrip :: ByteString -> Source IO ByteString -> Sink ByteString IO () -> IO ()+runNtrip :: MonadNtrip m => ByteString -> SourceByteString m -> SinkByteString m -> m () runNtrip url source sink = do uri <- either (throwIO . userError . textToString . show) return $ parseURI strictURIParserOptions url auth <- maybe (throwIO $ userError "Bad authority") return $ uri ^. authorityL