Commit 1ad3262b authored by Jurriën Stutterheim's avatar Jurriën Stutterheim
Browse files

Initial import: Tonic.Server

parents
definition module Tonic.Server
import iTasks
:: ComputationId :== [Int]
:: NodeId :== [Int]
:: ModuleName :== String
:: FunctionName :== String
:: TonicMessage =
{ computationId :: ComputationId // Abstraction from TaskId
, nodeId :: NodeId
, moduleName :: ModuleName
, functionName :: FunctionName
}
derive class iTask TonicMessage
implementation module Tonic.Server
import iTasks
from Text import class Text, instance Text String
import qualified Text as T
derive class iTask TonicMessage
debugMsg str = { TonicMessage
| computationId = []
, nodeId = []
, moduleName = "DEBUG"
, functionName = str
}
tonicServerShare :: Shared [TonicMessage]
tonicServerShare = sharedStore "tonicServerShare" []
acceptAndViewTonicTraces :: Task [TonicMessage]
acceptAndViewTonicTraces
= acceptTonicTraces tonicServerShare
||-
viewSharedInformation "Logged traces" [] tonicServerShare
acceptTonicTraces :: !(RWShared () [TonicMessage] [TonicMessage]) -> Task [String]
acceptTonicTraces tonicShare
= tcplisten 9000 True tonicShare { ConnectionHandlers
| onConnect = onConnect
, whileConnected = whileConnected
, onDisconnect = onDisconnect
}
where
onConnect :: String [TonicMessage] -> (MaybeErrorString String, Maybe [TonicMessage], [String], Bool)
onConnect host olderMessages
= (Ok "", Just [debugMsg ("Connection from " +++ host) : olderMessages], ["Welcome!"], False)
whileConnected :: (Maybe String) String [TonicMessage] -> (MaybeErrorString String, Maybe [TonicMessage], [String], Bool)
whileConnected (Just newData) oldData olderMessages
# collectedData = oldData +++ 'T'.trim newData
# (messages, leftover) = partitionMessages ('T'.split "TONIC_EOL" collectedData)
# mbTMsgs = case [msg \\ Just msg <- map (fromJSON o fromString) messages] of
[] -> Nothing
xs -> Just (xs ++ olderMessages)
= (Ok leftover, mbTMsgs, [], False)
where
partitionMessages :: [String] -> ([String], String)
partitionMessages [] = ([], "")
partitionMessages [x] = ([], x)
partitionMessages [x:y:xs]
# (msgs, leftover) = partitionMessages [y:xs]
= ([x:msgs], leftover)
whileConnected Nothing oldData olderMessages
= (Ok oldData, Nothing, [], False)
onDisconnect :: String [TonicMessage] -> (MaybeErrorString String, Maybe [TonicMessage])
onDisconnect _ lines
= (Ok "", Just [debugMsg "Disconnect" : lines])
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment