Holumbus-Distribution-0.0.1: Examples/Ports/Single.hs

-- ----------------------------------------------------------------------------
{- |
  Module     : 
  Copyright  : Copyright (C) 2008 Stefan Schmidt
  License    : MIT

  Maintainer : Stefan Schmidt (stefanschmidt@web.de)
  Stability  : experimental
  Portability: portable
  Version    : 0.1


-}
-- ----------------------------------------------------------------------------

module Main(main) where

import           Data.Binary
import qualified Data.ByteString.Lazy as B

import           Holumbus.Common.Logging
import           Holumbus.Network.Port


version :: String
version = "Holumbus-Ports Single-Demo 0.1"


type StringStream = Stream String
type StringPort   = Port String


decodeMaybe :: (Binary a) => Maybe B.ByteString -> Maybe a
decodeMaybe Nothing = Nothing
decodeMaybe (Just b) = (Just $ decode b)


decodeStringPort :: Maybe B.ByteString -> Maybe StringPort
decodeStringPort = decodeMaybe



main :: IO ()
main
  = do
    initializeLogging []
    putStrLn version
    
    putStrLn ""
    putStrLn "opening private Streams and Ports"
    
    printStreamController
    stream1 <- (newLocalStream (Just "stream1")):: IO StringStream
    stream2 <- (newLocalStream (Just "stream2")):: IO StringStream
    printStreamController
    
    testCase stream1 stream2 "Hello World"
    
    putStrLn ""
    putStrLn "closing streams..."
    closeStream stream1
    closeStream stream2
    printStreamController
    
    
    
testCase :: StringStream -> StringStream -> String -> IO ()
testCase stream1 stream2 t
  = do
    putStrLn ""
    putStrLn "Begin"

    port1   <- newPortFromStream stream1
    port2   <- newPortFromStream stream2
    
    putStrLn ""
    putStrLn $ "Sending: " ++ t
    sendWithGeneric port1 t (encode port2)
    printStreamController

    putStrLn ""
    putStrLn "Reading result..."
    msg1 <- readStreamMsg stream1
    putStrLn "Result:"
    putStrLn $ "Text: " ++ getMessageData msg1
    putStrLn $ "Msg: " ++ show msg1
    
    putStrLn ""
    putStrLn "echoing result..."
    let replyPort = decodeStringPort $ getGenericData msg1
    let text      = getMessageData msg1
    case replyPort of    
        (Nothing) ->
          do
          putStrLn "no reply port in message"
        (Just p) ->
          do
          send p ("ECHO:" ++ text)
    

    putStrLn "Reading echo..."
    msg2 <- readStreamMsg stream2
    putStrLn "Result:"
    putStrLn $ "Text: " ++ getMessageData msg2
    putStrLn $ "Msg: " ++ show msg2
        
    putStrLn ""
    putStrLn "End"