From 4f2bcb0778dca37ec53ebd6ca087554c19672849 Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Fri, 24 Feb 2017 12:21:30 +0100 Subject: [PATCH] started externalizing devices --- client/main.c | 1 - miTask.icl | 54 ++++++++++++++++++++++++++++++++--------------- miTaskDevices.dcl | 21 ++++++++++++++++++ miTaskDevices.icl | 50 +++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 108 insertions(+), 18 deletions(-) create mode 100644 miTaskDevices.dcl create mode 100644 miTaskDevices.icl diff --git a/client/main.c b/client/main.c index f3dd06a..337834f 100644 --- a/client/main.c +++ b/client/main.c @@ -107,7 +107,6 @@ int main(int argc, char *argv[]){ debug("booting up"); while(true){ //Check for newetasks - write_byte('\n'); loop(); delay(50); } diff --git a/miTask.icl b/miTask.icl index 5a87999..81c765b 100644 --- a/miTask.icl +++ b/miTask.icl @@ -25,10 +25,11 @@ derive class iTask MTaskMSGRecv, MTaskMSGSend, SerTCP, UserLED :: SerTCP = SerialDevice | TCPDevice :: MTaskDevice = { - deviceTask :: Maybe TaskId, - deviceConnected :: Maybe String, - deviceName :: String, - deviceTasks :: [(String, Int)] + deviceTask :: Maybe TaskId + ,deviceChannels :: String + ,deviceName :: String + ,deviceTasks :: [(String, Int)] +// ,deviceSyncfun :: (Shared Channels) -> Task () } :: MTaskShare = { initValue :: Int, @@ -124,7 +125,7 @@ mTaskManager = anyTask @! () where createBytecode st = toMessages timeout $ toRealByteCode (unMain $ fromJust ('DM'.get mTask mTaskMap)) st - sharename i = fromJust (device.deviceConnected) +++ "-" +++ toString i + sharename i = device.deviceChannels +++ "-" +++ toString i toSDSRecords st = [{MTaskShare | initValue=toInt d1*265 + toInt d2, withTask=mTask, @@ -140,7 +141,7 @@ mTaskManager = anyTask getSDSRecord i = get sdsStore @ \l->hd [s\\s<-l | s.identifier == i] channels :: MTaskDevice -> Shared Channels - channels d = memoryShare (fromJust d.deviceConnected) ([], [], False) + channels d = memoryShare d.deviceChannels ([], [], False) viewShares :: [MTaskShare] -> Task () viewShares st = anyTask $ map viewer st @@ -166,10 +167,8 @@ mTaskManager = anyTask viewDevice :: MTaskDevice -> Task () viewDevice d = (viewInformation "Device settings" [] d - ||- (case d.deviceConnected of - Just s = viewSharedInformation "Channels" [ViewAs dropEmpty] (channels d) @! () - Nothing = viewInformation "No channels yet" [] "" @! () - )) <<@ ArrangeHorizontal + ||- viewSharedInformation "Channels" [ViewAs dropEmpty] (channels d) @! () + ) <<@ ArrangeHorizontal where dropEmpty (r,s,ss) = (filter ((=!=)MTEmpty) r,s,ss) @@ -185,11 +184,32 @@ mTaskManager = anyTask where cont :: String ((Shared Channels) -> Task ()) -> Task () cont name synfun = get randomInt - @ (\randint->{deviceConnected=Just (name +++ toString randint), deviceName=name, deviceTasks=[], deviceTask=Nothing}) + @ (\randint->{MTaskDevice | + deviceChannels=name +++ toString randint, + deviceName=name, + deviceTasks=[], + deviceTask=Nothing}) >>= \dev->appendTopLevelTask 'DM'.newMap True (let ch = channels dev in process ch -||- synfun ch) >>= \tid->upd (\l->[{dev & deviceTask=Just tid}:l]) devices @! () +// addDevice :: (Shared [MTaskDevice]) -> Task SerTCP +// addDevice devices = enterInformation "Device type" [] +// >&^ \sh->whileUnchanged sh $ \mty->case mty of +// Nothing = viewInformation "No type selected yet" [] "" @! () +// Just ty = case ty of +// TCPDevice = (enterInformation "Name" [] -&&- enterInformation "Hostname" [] -&&- enterInformation "Port" []) +// >>= \(name, (host, port))->cont name (syncNetworkChannel host port) +// SerialDevice = (enterInformation "Name" [] -&&- enterTTYSettings) +// >>= \(name, set)->cont name (syncSerialChannel set encode decode) +// where +// cont :: String ((Shared Channels) -> Task ()) -> Task () +// cont name synfun = get randomInt +// @ (\randint->{deviceChannels=name +++ toString randint, deviceName=name, deviceTasks=[], deviceTask=Nothing}) +// >>= \dev->appendTopLevelTask 'DM'.newMap True (let ch = channels dev in process ch -||- synfun ch) +// >>= \tid->upd (\l->[{dev & deviceTask=Just tid}:l]) devices +// @! () + process :: (Shared Channels) -> Task () process ch = forever (watch ch >>* [OnValue ( ifValue (not o isEmpty o fst3) @@ -209,7 +229,7 @@ mTaskManager = anyTask deviceviewer :: [MTaskDevice] -> [MTaskDeviceStatus] deviceviewer ds = [{MTaskDeviceStatus | name = d.deviceName, - connected = if (isNothing d.deviceConnected) False True, + connected = if (isNothing d.deviceTask) False True, tasks = [s +++ toString i\\(s, i)<-d.deviceTasks]}\\d<-ds] mapPar :: (a -> Task a) [a] -> Task () @@ -230,11 +250,11 @@ syncNetworkChannel server port channel = catchAll = (Ok "", Just (msgs,[],sendStopped), map encode send, False) whileConnected :: (Maybe String) String ([MTaskMSGRecv], [MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool), [String], Bool) - whileConnected Nothing acc (msgs,send,sendStopped) - = (Ok acc, Nothing, [], False) - - whileConnected (Just newData) acc (msgs,send,sendStopped) - = (Ok acc, Just (msgs ++ [decode newData],[],False), map encode send, False) + + //whileConnected Nothing acc (msgs,send,sendStopped) + //= (Ok acc, Just (msgs,[],sendStopped), map encode send, False) + whileConnected mnewData acc (msgs,send,sendStopped) + = (Ok acc, Just (msgs ++ map decode (maybeToList mnewData),[],sendStopped), map encode send, False) //| sendStopped = (Ok acc, Just (msgs ++ [decode newData],[],False), map encode send, False) // = (Ok acc, Just (msgs ++ [decode newData],[],False), [], False) diff --git a/miTaskDevices.dcl b/miTaskDevices.dcl new file mode 100644 index 0000000..05aca62 --- /dev/null +++ b/miTaskDevices.dcl @@ -0,0 +1,21 @@ +definition module miTaskDevices + +import mTask +import iTasks +import iTasksTTY + +:: Channels :== ([MTaskMSGRecv], [MTaskMSGSend], Bool) +:: TCPDevice = {hostname :: String, port :: Int} +:: SerialDevice = {settings :: TTYSettings} + +derive class iTask TCPDevice, SerialDevice + +getmTaskDevice :: Task a | mTaskDevice a + +class mTaskDevice a where + syncTask :: a (Shared Channels) -> Task () + entermTaskDevice :: Task a + viewmTaskDevice :: a -> Task a + +instance mTaskDevice TCPDevice +instance mTaskDevice SerialDevice diff --git a/miTaskDevices.icl b/miTaskDevices.icl new file mode 100644 index 0000000..1a0b3eb --- /dev/null +++ b/miTaskDevices.icl @@ -0,0 +1,50 @@ +implementation module miTaskDevices + +import mTask +import iTasks + +:: Channels :== ([MTaskMSGRecv], [MTaskMSGSend], Bool) +:: TCPDevice = {hostname :: String, port :: Int} +:: SerialDevice = {settings :: TTYSettings} + +:: DeviceType = SerialDevice | TCPDevice + +derive class iTask TCPDevice, SerialDevice, DeviceType + +getmTaskDevice :: Task a | mTaskDevice a +getmTaskDevice = enterInformation "Device type" [] + >&^ \st->whileUnchanged st $ \dt->case dt of + Nothing = viewInformation "No type selected yet" [] Nothing + Just SerialDevice = getSerialDevice @ pure + Just TCPDevice = getTDevice @ pure + >>* [OnValue (ifValue isJust fromJust)] + where + getSD :: Task SerialDevice + getSD = entermTaskDevice + getTD :: Task TCPDevice + getTD = entermTaskDevice + +instance mTaskDevice TCPDevice where + entermTaskDevice = enterInformation "" [] + viewmTaskDevice = viewInformation "" [] + syncTask d ch = catchAll ( + tcpconnect d.host d.port ch {ConnectionHandlers| + onConnect=onConnect, + whileConnected=whileConnected, + onDisconnect=onDisconnect} @! ()) + (\v->traceValue v @! ()) + where + onConnect :: String ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool), [String], Bool) + onConnect _ (msgs,send,sendStopped) = (Ok "", Just (msgs,[],sendStopped), map encode send, False) + + whileConnected :: (Maybe String) String ([MTaskMSGRecv], [MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool), [String], Bool) + whileConnected Nothing acc (msgs,send,sendStopped) = (Ok acc, Nothing, [], False) + whileConnected (Just newData) acc (msgs,send,sendStopped) = (Ok acc, Just (msgs ++ [decode newData],[],False), map encode send, False) + + onDisconnect :: String ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool)) + onDisconnect l (msgs,send,sendStopped) = (Ok l, Nothing) + +instance mTaskDevice SerialDevice where + entermTaskDevice = enterTTYSettings >>= \s->{SerialDevice|settings=s} + viewmTaskDevice = viewInformation "" [] + syncTask d ch = syncSerialSettings d.settings encode decode ch -- 2.20.1