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
from mTask.Interpret.Device import
withDevice,
withDevice`,
liftmTask,
liftmTaskWithOptions,
mTaskSafe,
......
......@@ -33,7 +33,12 @@ class channelSync a :: a (sds () Channels Channels) -> Task () | RWShared sds
* @param connection specification
* @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
......
......@@ -50,8 +50,11 @@ instance zero MTDeviceData where
sendMessage :: (MTMessageTo (SimpleSDSLens Channels) -> Task Channels)
sendMessage = upd o appSnd3 o flip (++) o pure
withDevice :: a (MTDevice -> Task b) -> Task b | iTask b & channelSync, iTask a
withDevice device devfun =
withDevice :: (a (MTDevice -> Task b) -> Task b) | iTask b & channelSync, iTask a
withDevice = withDevice` True
withDevice` :: Bool a (MTDevice -> Task b) -> Task b | iTask b & channelSync, iTask a
withDevice` verbose device devfun =
withShared newMap \sdsupdates->
withShared ([], [MTTSpecRequest], False) \channels->
withShared zero \dev->
......@@ -82,6 +85,10 @@ withDevice device devfun =
//Its stability has to be postponed until after cleanup
= Value a (s && length [()\\(_, Value _ True)<-vs] >= 2)
where
traceIfVerbose msg
| verbose = traceValue msg
= return msg
processChannels :: (SimpleSDSLens MTDeviceData) (SimpleSDSLens (Map UInt8 [(UInt8, String255)])) (SimpleSDSLens Channels) -> Task [MTDeviceData]
processChannels dev sdsupdates channels = forever
$ watch channels
......@@ -92,27 +99,27 @@ where
where
process :: MTMessageFro -> Task MTDeviceData
process (MTFSpec c)
= traceValue ("Received spec: " +++ toSingleLineText c)
= traceIfVerbose ("Received spec: " +++ toSingleLineText c)
>-| upd (\s->{s & deviceSpec= ?Just c}) dev
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
process (MTFTaskAck i)
= traceValue ("Task acked: " +++ toSingleLineText i)
= traceIfVerbose ("Task acked: " +++ toSingleLineText i)
>-| upd (\s->{s & deviceTasks=put i MTSAcked s.deviceTasks}) dev
process (MTFTaskPrepAck i)
= traceValue ("Taskprep acked: " +++ toSingleLineText i)
= traceIfVerbose ("Taskprep acked: " +++ toSingleLineText i)
>-| upd (\s->{s & deviceTasks=put i MTSPrepack s.deviceTasks}) dev
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
process (MTFSdsUpdate taskid sdsid 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
>-| get dev
process (MTFException exc)
= traceValue ("Received an exception: ", toSingleLineText exc)
= traceIfVerbose ("Received an exception: ", toSingleLineText exc)
>-| case exc of
//General error, just rethrow
MTERTSError = throw MTERTSError
......@@ -122,9 +129,9 @@ where
//Errors affecting all tasks
e = upd (\s->{s & deviceTasks=MTSException e <$ s.deviceTasks}) dev
process (MTFDebug s)
= traceValue ("MSG: " +++ toString s +++ "\n") >>- \_->get dev
= traceIfVerbose ("MSG: " +++ toString s +++ "\n") >>- \_->get dev
process MTFPing = get dev
process x = traceValue ("Not implemented: " +++ toSingleLineText x)
process x = traceIfVerbose ("Not implemented: " +++ toSingleLineText x)
>-| get dev
mTaskSafe :: (Task u) -> Task (Either MTException u) | type u
......@@ -196,7 +203,7 @@ where
watchShareUpstream :: UInt8 MTLens BCShareSpec -> Task ()
watchShareUpstream taskid ref share = watch ref
>>* [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
@? const NoValue
]
......@@ -216,7 +223,7 @@ where
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" @! ()
?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 dev _ _)
......
......@@ -6,9 +6,9 @@ from Data.GenEq import generic gEq
from Text.GenJSON import generic JSONEncode, generic JSONDecode, :: JSONNode
from iTasks.WF.Definition import class iTask, :: Task
from mTask.Interpret.Device import class channelSync
from mTask.Interpret.Device.Serial import :: TTYSettings
from mTask.Interpret.Device.TCP import :: TCPSettings
from mTask.Interpret.Device.MQTT import :: MQTTSettings
import mTask.Interpret.Device.Serial
import mTask.Interpret.Device.TCP
import mTask.Interpret.Device.MQTT
:: 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