Commit 593b6a63 authored by Mart Lubbers's avatar Mart Lubbers
Browse files

add withDevice` in which you can choose the verbosity

parent 2316ad5a
Pipeline #50986 failed with stages
in 1 minute and 11 seconds
Subproject commit 780ae6bc2d37fa2a7cca6adf77f7dda1c32b65f6 Subproject commit b801ec9582f222f212de31cb22ae8d1a7005f6e2
...@@ -34,6 +34,7 @@ from mTask.Interpret.Peripheral import ...@@ -34,6 +34,7 @@ from mTask.Interpret.Peripheral import
from mTask.Interpret.Device import from mTask.Interpret.Device import
withDevice, withDevice,
withDevice`,
liftmTask, liftmTask,
liftmTaskWithOptions, liftmTaskWithOptions,
mTaskSafe, mTaskSafe,
......
...@@ -33,7 +33,12 @@ class channelSync a :: a (sds () Channels Channels) -> Task () | RWShared sds ...@@ -33,7 +33,12 @@ class channelSync a :: a (sds () Channels Channels) -> Task () | RWShared sds
* @param connection specification * @param connection specification
* @param task using the device * @param task using the device
*/ */
withDevice :: a (MTDevice -> Task b) -> Task b | iTask b & channelSync, iTask a withDevice :: (a (MTDevice -> Task b) -> Task b) | iTask b & channelSync, iTask a
/**
* Connects a device and specifies the verbosity
*/
withDevice` :: Bool a (MTDevice -> Task b) -> Task b | iTask b & channelSync, iTask a
/** /**
* Lift the mTask task to an itasks task, i.e. run it on the given device * Lift the mTask task to an itasks task, i.e. run it on the given device
......
...@@ -50,8 +50,11 @@ instance zero MTDeviceData where ...@@ -50,8 +50,11 @@ instance zero MTDeviceData where
sendMessage :: (MTMessageTo (SimpleSDSLens Channels) -> Task Channels) sendMessage :: (MTMessageTo (SimpleSDSLens Channels) -> Task Channels)
sendMessage = upd o appSnd3 o flip (++) o pure sendMessage = upd o appSnd3 o flip (++) o pure
withDevice :: a (MTDevice -> Task b) -> Task b | iTask b & channelSync, iTask a withDevice :: (a (MTDevice -> Task b) -> Task b) | iTask b & channelSync, iTask a
withDevice device devfun = withDevice = withDevice` True
withDevice` :: Bool a (MTDevice -> Task b) -> Task b | iTask b & channelSync, iTask a
withDevice` verbose device devfun =
withShared newMap \sdsupdates-> withShared newMap \sdsupdates->
withShared ([], [MTTSpecRequest], False) \channels-> withShared ([], [MTTSpecRequest], False) \channels->
withShared zero \dev-> withShared zero \dev->
...@@ -82,6 +85,10 @@ withDevice device devfun = ...@@ -82,6 +85,10 @@ withDevice device devfun =
//Its stability has to be postponed until after cleanup //Its stability has to be postponed until after cleanup
= Value a (s && length [()\\(_, Value _ True)<-vs] >= 2) = Value a (s && length [()\\(_, Value _ True)<-vs] >= 2)
where where
traceIfVerbose msg
| verbose = traceValue msg
= return msg
processChannels :: (SimpleSDSLens MTDeviceData) (SimpleSDSLens (Map UInt8 [(UInt8, String255)])) (SimpleSDSLens Channels) -> Task [MTDeviceData] processChannels :: (SimpleSDSLens MTDeviceData) (SimpleSDSLens (Map UInt8 [(UInt8, String255)])) (SimpleSDSLens Channels) -> Task [MTDeviceData]
processChannels dev sdsupdates channels = forever processChannels dev sdsupdates channels = forever
$ watch channels $ watch channels
...@@ -92,27 +99,27 @@ where ...@@ -92,27 +99,27 @@ where
where where
process :: MTMessageFro -> Task MTDeviceData process :: MTMessageFro -> Task MTDeviceData
process (MTFSpec c) process (MTFSpec c)
= traceValue ("Received spec: " +++ toSingleLineText c) = traceIfVerbose ("Received spec: " +++ toSingleLineText c)
>-| upd (\s->{s & deviceSpec= ?Just c}) dev >-| upd (\s->{s & deviceSpec= ?Just c}) dev
process (MTFTaskDelAck i) process (MTFTaskDelAck i)
= traceValue ("Task " +++ toString i +++ " deleted") = traceIfVerbose ("Task " +++ toString i +++ " deleted")
>-| upd (\s->{s & deviceIds=s.deviceIds ++ [i], deviceTasks=del i s.deviceTasks}) dev >-| upd (\s->{s & deviceIds=s.deviceIds ++ [i], deviceTasks=del i s.deviceTasks}) dev
process (MTFTaskAck i) process (MTFTaskAck i)
= traceValue ("Task acked: " +++ toSingleLineText i) = traceIfVerbose ("Task acked: " +++ toSingleLineText i)
>-| upd (\s->{s & deviceTasks=put i MTSAcked s.deviceTasks}) dev >-| upd (\s->{s & deviceTasks=put i MTSAcked s.deviceTasks}) dev
process (MTFTaskPrepAck i) process (MTFTaskPrepAck i)
= traceValue ("Taskprep acked: " +++ toSingleLineText i) = traceIfVerbose ("Taskprep acked: " +++ toSingleLineText i)
>-| upd (\s->{s & deviceTasks=put i MTSPrepack s.deviceTasks}) dev >-| upd (\s->{s & deviceTasks=put i MTSPrepack s.deviceTasks}) dev
process (MTFTaskReturn taskid mv) process (MTFTaskReturn taskid mv)
= traceValue ("Task " +++ toSingleLineText taskid +++ " returned: " +++ toSingleLineText (safePrint <$> mv)) = traceIfVerbose ("Task " +++ toSingleLineText taskid +++ " returned: " +++ toSingleLineText (safePrint <$> mv))
>-| upd (\s->{s & deviceTasks=put taskid (MTSValue mv) s.deviceTasks}) dev >-| upd (\s->{s & deviceTasks=put taskid (MTSValue mv) s.deviceTasks}) dev
process (MTFSdsUpdate taskid sdsid value) process (MTFSdsUpdate taskid sdsid value)
# value = concat [String255 (toByteCode{|*|} i)\\i<-:value] # value = concat [String255 (toByteCode{|*|} i)\\i<-:value]
= traceValue ("Received an update for sds " +++ toString sdsid +++ " from task " +++ toString taskid +++ " with value: " +++ safePrint value) = traceIfVerbose ("Received an update for sds " +++ toString sdsid +++ " from task " +++ toString taskid +++ " with value: " +++ safePrint value)
>-| upd (alter (fmap \l->l ++ [(sdsid, value)]) taskid) sdsupdates >-| upd (alter (fmap \l->l ++ [(sdsid, value)]) taskid) sdsupdates
>-| get dev >-| get dev
process (MTFException exc) process (MTFException exc)
= traceValue ("Received an exception: ", toSingleLineText exc) = traceIfVerbose ("Received an exception: ", toSingleLineText exc)
>-| case exc of >-| case exc of
//General error, just rethrow //General error, just rethrow
MTERTSError = throw MTERTSError MTERTSError = throw MTERTSError
...@@ -122,9 +129,9 @@ where ...@@ -122,9 +129,9 @@ where
//Errors affecting all tasks //Errors affecting all tasks
e = upd (\s->{s & deviceTasks=MTSException e <$ s.deviceTasks}) dev e = upd (\s->{s & deviceTasks=MTSException e <$ s.deviceTasks}) dev
process (MTFDebug s) process (MTFDebug s)
= traceValue ("MSG: " +++ toString s +++ "\n") >>- \_->get dev = traceIfVerbose ("MSG: " +++ toString s +++ "\n") >>- \_->get dev
process MTFPing = get dev process MTFPing = get dev
process x = traceValue ("Not implemented: " +++ toSingleLineText x) process x = traceIfVerbose ("Not implemented: " +++ toSingleLineText x)
>-| get dev >-| get dev
mTaskSafe :: (Task u) -> Task (Either MTException u) | type u mTaskSafe :: (Task u) -> Task (Either MTException u) | type u
...@@ -196,7 +203,7 @@ where ...@@ -196,7 +203,7 @@ where
watchShareUpstream :: UInt8 MTLens BCShareSpec -> Task () watchShareUpstream :: UInt8 MTLens BCShareSpec -> Task ()
watchShareUpstream taskid ref share = watch ref watchShareUpstream taskid ref share = watch ref
>>* [OnValue $ ifValue ((<>)share.bcs_value) $ const >>* [OnValue $ ifValue ((<>)share.bcs_value) $ const
$ traceValue "Watching the upstream share" >-| whileUnchanged ref $ traceIfVerbose "Watching the upstream share" >-| whileUnchanged ref
\v->sendMessage (MTTSdsUpdate taskid share.bcs_ident v) channels \v->sendMessage (MTTSdsUpdate taskid share.bcs_ident v) channels
@? const NoValue @? const NoValue
] ]
...@@ -216,7 +223,7 @@ where ...@@ -216,7 +223,7 @@ where
applyDownstreamUpdate sdsid value = case find (\(_, sh)->sh.bcs_ident==sdsid) (zip2 mayberefs shares) of applyDownstreamUpdate sdsid value = case find (\(_, sh)->sh.bcs_ident==sdsid) (zip2 mayberefs shares) of
?None = traceValue "Huh? I got a share update for an unknown share" @! () ?None = traceValue "Huh? I got a share update for an unknown share" @! ()
?Just (?None, _) = traceValue "Huh? I got a share update for a non iTasks share" @! () ?Just (?None, _) = traceValue "Huh? I got a share update for a non iTasks share" @! ()
?Just (?Just ref, _) = traceValue "Found the sds, updating" >>- \_->upd (const value) ref @! () ?Just (?Just ref, _) = traceIfVerbose "Found the sds, updating" >>- \_->upd (const value) ref @! ()
deviceSpecification :: MTDevice -> Task MTDeviceSpec deviceSpecification :: MTDevice -> Task MTDeviceSpec
deviceSpecification (MTDevice dev _ _) deviceSpecification (MTDevice dev _ _)
......
...@@ -6,9 +6,9 @@ from Data.GenEq import generic gEq ...@@ -6,9 +6,9 @@ from Data.GenEq import generic gEq
from Text.GenJSON import generic JSONEncode, generic JSONDecode, :: JSONNode from Text.GenJSON import generic JSONEncode, generic JSONDecode, :: JSONNode
from iTasks.WF.Definition import class iTask, :: Task from iTasks.WF.Definition import class iTask, :: Task
from mTask.Interpret.Device import class channelSync from mTask.Interpret.Device import class channelSync
from mTask.Interpret.Device.Serial import :: TTYSettings import mTask.Interpret.Device.Serial
from mTask.Interpret.Device.TCP import :: TCPSettings import mTask.Interpret.Device.TCP
from mTask.Interpret.Device.MQTT import :: MQTTSettings import mTask.Interpret.Device.MQTT
:: MTD = TCP TCPSettings | Serial TTYSettings | MQTT MQTTSettings :: MTD = TCP TCPSettings | Serial TTYSettings | MQTT MQTTSettings
......
Supports Markdown
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