modularize

diff --git a/Devices/mTaskDevice.dcl b/Devices/mTaskDevice.dcl
new file mode 100644 (file)
index 0000000..6551eb3
--- /dev/null
+++ b/Devices/mTaskDevice.dcl
@@ -0,0 +1,38 @@
+definition module Devices.mTaskDevice
+
+from Data.Maybe import :: Maybe
+import iTasks
+import Devices.mTaskSerial
+import Devices.mTaskTCP
+import mTaskInterpret
+import Generics.gCons
+import iTasksTTY
+
+derive class iTask MTaskDevice, MTaskResource, MTaskMSGRecv, MTaskMSGSend
+derive conses MTaskResource, TCPSettings
+derive consName MTaskResource, TCPSettings
+
+channels :: MTaskDevice -> Shared Channels
+
+:: Channels :== ([MTaskMSGRecv], [MTaskMSGSend], Bool)
+
+:: MTaskResource 
+       = TCPDevice TCPSettings
+       | SerialDevice TTYSettings
+
+:: MTaskDevice = {
+                deviceTask :: Maybe TaskId
+               ,deviceChannels :: String
+               ,deviceName :: String
+               ,deviceTasks :: [(String, Int)]
+               ,deviceData :: MTaskResource
+       }
+
+class MTaskDuplex a where
+       synFun :: a (Shared Channels) -> Task ()
+
+//makeDevice :: MTaskResource String -> Task MTaskDevice
+
+addDevice :: (Shared [MTaskDevice]) -> Task String
+//addDevice :: (Shared [MTaskDevice]) -> Task MTaskResource
+//addDevice :: (Shared [MTaskDevice]) -> Task ()

diff --git a/Devices/mTaskDevice.icl b/Devices/mTaskDevice.icl
new file mode 100644 (file)
index 0000000..2bd7121
--- /dev/null
+++ b/Devices/mTaskDevice.icl
@@ -0,0 +1,51 @@
+implementation module Devices.mTaskDevice
+
+import Generics.gCons
+import mTaskInterpret
+import iTasks
+import iTasksTTY
+import TTY
+import qualified Data.Map as DM
+import Utils
+
+import GenBimap
+import Devices.mTaskSerial
+import Devices.mTaskTCP
+import iTasks._Framework.Store
+
+from Data.Func import $
+
+derive class iTask MTaskDevice, MTaskResource, MTaskMSGRecv, MTaskMSGSend
+derive conses MTaskResource, TTYSettings, BaudRate, Parity, ByteSize, TCPSettings
+derive consName MTaskResource, TTYSettings, BaudRate, Parity, ByteSize, TCPSettings
+
+channels :: MTaskDevice -> Shared Channels
+channels d = memoryShare d.deviceChannels ([], [], False)
+
+makeDevice :: String MTaskResource -> Task MTaskDevice
+makeDevice name res = get randomInt @ \rand->{MTaskDevice
+               |deviceChannels=name +++ toString rand
+               ,deviceName=name
+               ,deviceTasks=[]
+               ,deviceTask=Nothing
+               ,deviceData=res}
+
+getSynFun :: MTaskResource -> ((Shared Channels) -> Task ())
+getSynFun (TCPDevice t) = synFun t
+getSynFun (SerialDevice t) = synFun t
+
+addDevice :: (Shared [MTaskDevice]) -> Task String
+addDevice devices = enterChoice "Device type" [] (map consName{|*|} deviceTypes)
+       >&^ \sh->whileUnchanged sh $ \mty->case mty of
+               Nothing = viewInformation "No type selected yet" [] ""
+               Just ty = enterInformation "Name" [] -&&- deviceSettings ty
+                       >>= \(name, settings)->makeDevice name settings
+                       >>= \dev->appendTopLevelTask 'DM'.newMap True (let ch=channels dev in getSynFun dev.deviceData ch)
+                       >>= \tid->upd (\l->[{dev & deviceTask=Just tid}:l]) devices
+                       @! ""
+       where
+               deviceSettings "SerialDevice" = getmTaskSerialDevice
+               deviceSettings "TCPDevice" = getmTaskTCPDevice
+
+deviceTypes :: [MTaskResource]
+deviceTypes = conses{|*|}

diff --git a/Devices/mTaskSerial.dcl b/Devices/mTaskSerial.dcl
new file mode 100644 (file)
index 0000000..0696979
--- /dev/null
+++ b/Devices/mTaskSerial.dcl
@@ -0,0 +1,8 @@
+definition module Devices.mTaskSerial
+
+import Devices.mTaskDevice
+import iTasks
+
+getmTaskSerialDevice :: Task MTaskResource
+
+instance MTaskDuplex TTYSettings

diff --git a/Devices/mTaskSerial.icl b/Devices/mTaskSerial.icl
new file mode 100644 (file)
index 0000000..59f86b4
--- /dev/null
+++ b/Devices/mTaskSerial.icl
@@ -0,0 +1,12 @@
+implementation module Devices.mTaskSerial
+
+import Devices.mTaskDevice
+import TTY
+import iTasks
+
+getmTaskSerialDevice :: Task MTaskResource
+getmTaskSerialDevice = SerialDevice <$> enterTTYSettings
+
+instance MTaskDuplex TTYSettings where
+       synFun :: TTYSettings (Shared Channels) -> Task ()
+       synFun settings channels = syncSerialChannel settings encode decode channels

diff --git a/Devices/mTaskTCP.dcl b/Devices/mTaskTCP.dcl
new file mode 100644 (file)
index 0000000..627fedf
--- /dev/null
+++ b/Devices/mTaskTCP.dcl
@@ -0,0 +1,10 @@
+definition module Devices.mTaskTCP
+
+import Devices.mTaskDevice
+import iTasks
+
+:: TCPSettings = {host :: String, port :: Int}
+derive class iTask TCPSettings
+
+getmTaskTCPDevice :: Task MTaskResource
+instance MTaskDuplex TCPSettings

diff --git a/Devices/mTaskTCP.icl b/Devices/mTaskTCP.icl
new file mode 100644 (file)
index 0000000..bf05e05
--- /dev/null
+++ b/Devices/mTaskTCP.icl
@@ -0,0 +1,28 @@
+implementation module Devices.mTaskTCP
+
+import Devices.mTaskDevice
+import iTasks
+
+derive class iTask TCPSettings
+
+getmTaskTCPDevice :: Task MTaskResource
+getmTaskTCPDevice = TCPDevice <$> enterInformation "Settings" []
+
+instance MTaskDuplex TCPSettings where
+       synFun :: TCPSettings (Shared Channels) -> Task ()
+       synFun s channels =  catchAll (
+               tcpconnect s.host s.port channels {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)

diff --git a/Generics/gCons.dcl b/Generics/gCons.dcl
index 7877e11..ad99042 100644 (file)
--- a/Generics/gCons.dcl
+++ b/Generics/gCons.dcl
@@ -10,10 +10,10 @@ definition module Generics.gCons
 import StdGeneric
 
 generic consName a :: a -> String
-derive consName CONS of {gcd_name},UNIT,PAIR,EITHER,OBJECT,RECORD,FIELD,Int,Bool,Char,String,(->),[]
+derive consName CONS of {gcd_name},UNIT,PAIR,EITHER,OBJECT,RECORD,FIELD,Int,Bool,Char,String,(),(,),(,,),(,,,),(,,,,),(->),[]
 
 generic consIndex a :: a -> Int
-derive consIndex CONS of {gcd_index},UNIT,PAIR,EITHER,OBJECT,Int,Bool,Char,String,[]
+derive consIndex CONS of {gcd_index},UNIT,PAIR,EITHER,OBJECT,Int,Bool,Char,String,(),(,),(,,),(,,,),(,,,,),[]
 
 generic conses a :: [a]
-derive conses CONS,UNIT,PAIR,EITHER,OBJECT,FIELD,RECORD,Int,Bool,Char,Real,String,(),{},{!},[],[! ],[ !],[!!],(->)
+derive conses CONS,UNIT,PAIR,EITHER,OBJECT,FIELD,RECORD,Int,Bool,Char,Real,String,(),(,),(,,),(,,,),(,,,,),{},{!},[],[! ],[ !],[!!],(->)

diff --git a/Generics/gCons.icl b/Generics/gCons.icl
index fc4debc..6f0ceb3 100644 (file)
--- a/Generics/gCons.icl
+++ b/Generics/gCons.icl
@@ -8,6 +8,7 @@ implementation module Generics.gCons
 */
 
 import StdEnv, StdGeneric, GenBimap, _SystemStrictLists
+import Data.List
 
 generic consName a :: a -> String
 consName{|CONS of {gcd_name}|} f x = gcd_name
@@ -23,6 +24,11 @@ consName{|Bool|}       b = toString b
 consName{|Char|}       c = toString c
 consName{|String|}     s = s
 consName{|[]|} _ _ = "[]"
+consName{|()|} _ = "()"
+consName{|(,)|} _ _ _ = "(,)"
+consName{|(,,)|}  _ _ _ _ = "(,,)"
+consName{|(,,,)|}  _ _ _ _ _ = "(,,,)"
+consName{|(,,,,)|}  _ _ _ _ _ _ = "(,,,,)"
 consName{|(->)|}   f g x = g (x undef)
 
 generic consIndex a :: a -> Int
@@ -37,6 +43,11 @@ consIndex{|Bool|} b = if b 1 0
 consIndex{|Char|} c = toInt c
 consIndex{|String|} _ = 0
 consIndex{|[]|} _ _ = 0
+consIndex{|()|} _ = 0
+consIndex{|(,)|} _ _ _ = 0
+consIndex{|(,,)|}  _ _ _ _ = 0
+consIndex{|(,,,)|}  _ _ _ _ _ = 0
+consIndex{|(,,,,)|}  _ _ _ _ _ _ = 0
 
 generic conses a :: [a]
 conses{|CONS|} f = [CONS (hd f)]
@@ -55,7 +66,11 @@ conses{|[]|} _ = [[ ]]
 conses{|[!]|} _ = [[!]]
 conses{|[ !]|} _ = [[ !]]
 conses{|[!!]|} _ = [[!!]]
+conses{|()|} = [()]
+conses{|(,)|} f g = zip2 f g
+conses{|(,,)|}  f g h = zip3 f g h
+conses{|(,,,)|}  f g h i = zip4 f g h i
+conses{|(,,,,)|}  f g h i j = zip5 f g h i j
 conses{|{}|} _ = [{}]
 conses{|{!}|} _ = [{!}]
-conses{|()|} = [()]
 conses{|(->)|} _ _ = [const undef]

diff --git a/Makefile b/Makefile
index e0d65c9..7b0fe31 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -31,7 +31,7 @@ CleanSerial/Clean\ System\ Files/TTY.o:
 client/mTaskSymbols.h: mTaskMakeSymbols
        ./$< -nr > $@
 
-%: %.icl $(wildcard *.[id]cl)
+%: %.icl $(wildcard */*.[id]cl *.[id]cl)
        $(CLM) $(CLMLIBS) $(CLMFLAGS) $(basename $<) -o $@
 
 clean:

diff --git a/Utils.dcl b/Utils.dcl
new file mode 100644 (file)
index 0000000..cda8a7a
--- /dev/null
+++ b/Utils.dcl
@@ -0,0 +1,5 @@
+definition module Utils
+
+import iTasks
+
+memoryShare :: String a -> Shared a | iTask a

diff --git a/Utils.icl b/Utils.icl
new file mode 100644 (file)
index 0000000..3a9be2c
--- /dev/null
+++ b/Utils.icl
@@ -0,0 +1,8 @@
+implementation module Utils
+
+import iTasks
+import iTasks._Framework.Store
+from Data.Func import $
+
+memoryShare :: String a -> Shared a | iTask a
+memoryShare s d = sdsFocus s $ memoryStore "" $ Just d

diff --git a/miTask.icl b/miTask.icl
index 81c765b..6c80f05 100644 (file)
--- a/miTask.icl
+++ b/miTask.icl
@@ -5,6 +5,7 @@ from StdFunc import flip
 
 import iTasks
 import mTask
+import Devices.mTaskDevice
 
 from Text import class Text(startsWith,concat,split,join), instance Text String
 
@@ -19,18 +20,8 @@ import iTasks._Framework.Store
 
 import TTY, iTasksTTY
 
-derive class iTask MTaskMSGRecv, MTaskMSGSend, SerTCP, UserLED
+derive class iTask UserLED
 
-:: Channels :== ([MTaskMSGRecv], [MTaskMSGSend], Bool)
-
-:: SerTCP = SerialDevice | TCPDevice
-:: MTaskDevice = {
-                deviceTask :: Maybe TaskId
-               ,deviceChannels :: String
-               ,deviceName :: String
-               ,deviceTasks :: [(String, Int)]
-//             ,deviceSyncfun :: (Shared Channels) -> Task ()
-       }
 :: MTaskShare = {
                initValue :: Int,
                withTask :: String,
@@ -85,7 +76,7 @@ bc3 :: UserLED -> Main (ByteCode () Stmt)
 bc3 d = {main = ledOff d}
 
 :: MTaskDeviceStatus = {connected :: Bool, name :: String, tasks :: [String]}
-derive class iTask MTaskDeviceStatus, MTaskDevice, MTaskShare, BCState
+derive class iTask MTaskDeviceStatus, MTaskShare, BCState
 
 mTaskManager :: Task ()
 mTaskManager = anyTask 
@@ -140,9 +131,6 @@ mTaskManager = anyTask
                getSDSRecord :: Int -> Task MTaskShare
                getSDSRecord i = get sdsStore @ \l->hd [s\\s<-l | s.identifier == i]
 
-               channels :: MTaskDevice -> Shared Channels
-               channels d = memoryShare d.deviceChannels ([], [], False)
-
                viewShares :: [MTaskShare] -> Task ()
                viewShares st = anyTask $ map viewer st
                        where
@@ -172,26 +160,6 @@ mTaskManager = anyTask
                        where
                                dropEmpty (r,s,ss) = (filter ((=!=)MTEmpty) r,s,ss)
 
-               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->{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" []

diff --git a/miTaskDevices.dcl b/miTaskDevices.dcl
deleted file mode 100644 (file)
index 05aca62..0000000
--- a/miTaskDevices.dcl
+++ /dev/null
@@ -1,21 +0,0 @@
-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
deleted file mode 100644 (file)
index 1a0b3eb..0000000
--- a/miTaskDevices.icl
+++ /dev/null
@@ -1,50 +0,0 @@
-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