test client works
This commit is contained in:
parent
769501684b
commit
4b841bf88c
3 changed files with 31 additions and 12 deletions
33
app/Main.hs
33
app/Main.hs
|
@ -1,35 +1,48 @@
|
|||
module Main where
|
||||
|
||||
import Control.Concurrent (forkIO)
|
||||
import Data.Aeson
|
||||
import Data.Aeson.TickLeiste
|
||||
import qualified Data.ByteString as B
|
||||
import Data.Maybe (maybe)
|
||||
import Data.TickLeiste
|
||||
import Network.WebSockets
|
||||
import System.Environment
|
||||
import System.Exit (die)
|
||||
import Text.Read
|
||||
import Data.Maybe (maybe)
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
args <- getArgs
|
||||
if length args /= 3
|
||||
-- here should be more checks, but as this client is only ment for quick
|
||||
then -- here should be more checks, but as this client is only ment for quick
|
||||
-- tests and not part of the finished project I don't care
|
||||
then die "arguments must be 'host' 'port' 'path'"
|
||||
die "arguments must be 'host' 'port' 'path'"
|
||||
else do
|
||||
runClient (args !! 0) (read $ args !! 1) (args !! 2) testClient
|
||||
|
||||
testClient :: ClientApp ()
|
||||
testClient conn = do
|
||||
forkIO $ testClientReciveLoop conn
|
||||
testClientSendLoop conn
|
||||
|
||||
-- this thing is realy cheap: we read strings!!
|
||||
-- What we should do: read ByteString and go from there
|
||||
-- and do checks if our input is clean, we do none of that.
|
||||
testClient :: ClientApp ()
|
||||
testClient conn = do
|
||||
putStr "> "
|
||||
testClientSendLoop :: ClientApp ()
|
||||
testClientSendLoop conn = do
|
||||
userInput <- getLine
|
||||
maybe
|
||||
(putStrLn "Input parse failed, maybe a Typo?")
|
||||
(\request -> do
|
||||
undefined)
|
||||
(sendTextData conn . encode)
|
||||
(readMaybe userInput :: Maybe JSONRequest)
|
||||
testClientSendLoop conn
|
||||
|
||||
|
||||
|
||||
testClientReciveLoop :: ClientApp ()
|
||||
testClientReciveLoop conn = do
|
||||
msg <- (receiveData conn :: IO B.ByteString)
|
||||
maybe
|
||||
(putStrLn "Unable to parse Server JSON: " >> print msg)
|
||||
(print)
|
||||
(decodeStrict msg :: Maybe JSONEvent)
|
||||
testClientReciveLoop conn
|
||||
|
|
|
@ -24,6 +24,8 @@ dependencies:
|
|||
- tickLeiste
|
||||
- tickLeiste-aeson
|
||||
- websockets
|
||||
- aeson
|
||||
- bytestring
|
||||
|
||||
executables:
|
||||
tickLeisteTestClient-exe:
|
||||
|
|
|
@ -31,7 +31,9 @@ executable tickLeisteTestClient-exe
|
|||
app
|
||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N
|
||||
build-depends:
|
||||
base >=4.7 && <5
|
||||
aeson
|
||||
, base >=4.7 && <5
|
||||
, bytestring
|
||||
, tickLeiste
|
||||
, tickLeiste-aeson
|
||||
, websockets
|
||||
|
@ -46,7 +48,9 @@ test-suite tickLeisteTestClient-test
|
|||
test
|
||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N
|
||||
build-depends:
|
||||
base >=4.7 && <5
|
||||
aeson
|
||||
, base >=4.7 && <5
|
||||
, bytestring
|
||||
, tickLeiste
|
||||
, tickLeiste-aeson
|
||||
, tickLeisteTestClient
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue