
Now I've got a situation I can't figure out how to resolve. I want to
have a set of actions which are executed sequentially, but which, before
I even start to execute the first one, have been inspected for legality
and/or plausibility. Consider this kind of sequence:
do
x <- performActionA
y <- performActionB
z <- performActionC
return $ calculateStuff x y z
Now obviously this is going to be in a monad of some kind. Were this a
regular, run-of-the-mill program I'd just use the IO monad. But what I
want to do instead is, before executing any of the perform* functions,
check that the actions desired are actually permitted (or possible)
given a set of circumstances. For example let's say it's a permissions
issue and performActionB can only be done if I'm root. If I'm not root
I don't want performActionA done because I can't complete the
transaction. (Maybe ActionA is non-reversible, say.) Or let's say this
is code that's accessing databases on the network. If the network link
to C can't be established, I don't want to screw around with A and B's
links at all -- it's too expensive, too time-consuming or whatever.
Were I programming this in C, C++, Python, Ruby, etc. I could do this in
my sleep. Functions are addresses (C/C++) or objects with an ID
(Python/Ruby) so it's possible to take them and do some kind of check
based on identities before executing things (although the scaffolding
around this would be nontrivial in any of these languages except,
possibly, Ruby). Functions in Haskell don't have this property,
however, so I can't figure out what I'd do to perform similar work. I'm
sure there's a way to do it, but I just can't see it.
--
Michael T. Richter

2007/6/25, Michael T. Richter
Now I've got a situation I can't figure out how to resolve. I want to have a set of actions which are executed sequentially, but which, before I even start to execute the first one, have been inspected for legality and/or plausibility. Consider this kind of sequence:
do x <- performActionA y <- performActionB z <- performActionC return $ calculateStuff x y z
Now obviously this is going to be in a monad of some kind. Were this a regular, run-of-the-mill program I'd just use the IO monad. But what I want to do instead is, before executing any of the perform* functions, check that the actions desired are actually permitted (or possible) given a set of circumstances. For example let's say it's a permissions issue and performActionB can only be done if I'm root. If I'm not root I don't want performActionA done because I can't complete the transaction. (Maybe ActionA is non-reversible, say.) Or let's say this is code that's accessing databases on the network. If the network link to C can't be established, I don't want to screw around with A and B's links at all -- it's too expensive, too time-consuming or whatever.
Were I programming this in C, C++, Python, Ruby, etc. I could do this in my sleep. Functions are addresses (C/C++) or objects with an ID (Python/Ruby) so it's possible to take them and do some kind of check based on identities before executing things (although the scaffolding around this would be nontrivial in any of these languages except, possibly, Ruby). Functions in Haskell don't have this property, however, so I can't figure out what I'd do to perform similar work. I'm sure there's a way to do it, but I just can't see it.
Hello, I would suggest defining your own data type an instance of monad. The sense of it would be 'sequantial IO operations which you can do some checks on'. It would have some flags and properties along with the IO computation itself. Operations (>>) and (>>=) would construct more complex computations from simple ones, and since your data type is not opaque to you, you could inspect those complex computations for properties, too. Including synergetic ones, like 'this is never done, after that has been invoked...' And then you will have to have a conventional runYourMonad function, which will be an IO computation. It could be the place, where the validity check occurs. The data type could be the list of operations, or probably a tree-like structure to account for branching. The downside is you would have to supply those flags, but you could define some lifting functions, like flag :: Flags -> IO a -> YourMonad a do flag OnlyRoot ioOperation flag someComplexFlag anotherOperation Daniil Elovkov

On Mon, 25 Jun 2007, Daniil Elovkov wrote:
2007/6/25, Michael T. Richter
: Now I've got a situation I can't figure out how to resolve. I want to have a set of actions which are executed sequentially, but which, before I even start to execute the first one, have been inspected for legality and/or plausibility. Consider this kind of sequence:
do x <- performActionA y <- performActionB z <- performActionC return $ calculateStuff x y z
Now obviously this is going to be in a monad of some kind. Were this a regular, run-of-the-mill program I'd just use the IO monad. But what I want to do instead is, before executing any of the perform* functions, check that the actions desired are actually permitted (or possible) given a set of circumstances. For example let's say it's a permissions issue and performActionB can only be done if I'm root. If I'm not root I don't want performActionA done because I can't complete the transaction. (Maybe ActionA is non-reversible, say.) Or let's say this is code that's accessing databases on the network. If the network link to C can't be established, I don't want to screw around with A and B's links at all -- it's too expensive, too time-consuming or whatever.
Were I programming this in C, C++, Python, Ruby, etc. I could do this in my sleep. Functions are addresses (C/C++) or objects with an ID (Python/Ruby) so it's possible to take them and do some kind of check based on identities before executing things (although the scaffolding around this would be nontrivial in any of these languages except, possibly, Ruby). Functions in Haskell don't have this property, however, so I can't figure out what I'd do to perform similar work. I'm sure there's a way to do it, but I just can't see it.
Hello, I would suggest defining your own data type an instance of monad. The sense of it would be 'sequantial IO operations which you can do some checks on'.
It would have some flags and properties along with the IO computation itself. Operations (>>) and (>>=) would construct more complex computations from simple ones, and since your data type is not opaque to you, you could inspect those complex computations for properties, too. Including synergetic ones, like 'this is never done, after that has been invoked...'
This is easier said than done. Imagine all performActions contain their checks somehow. Let performActionB take an argument.
do x <- performActionA y <- performActionB x z <- performActionC return $ calculateStuff x y z
Now performActionB and its included check depend on x. That is, the check relies formally on the result of performActionA and thus check B must be performed after performActionA.

On Mon, Jun 25, 2007 at 10:29:14AM +0200, Henning Thielemann wrote:
Imagine all performActions contain their checks somehow. Let performActionB take an argument.
do x <- performActionA y <- performActionB x z <- performActionC return $ calculateStuff x y z
Now performActionB and its included check depend on x. That is, the check relies formally on the result of performActionA and thus check B must be performed after performActionA.
IIUC, this limitation of Monads was one of the reasons why John Hughes introduced the new Arrow abstraction. Best regards Tomek

On Mon, 25 Jun 2007, Tomasz Zielonka wrote:
On Mon, Jun 25, 2007 at 10:29:14AM +0200, Henning Thielemann wrote:
Imagine all performActions contain their checks somehow. Let performActionB take an argument.
do x <- performActionA y <- performActionB x z <- performActionC return $ calculateStuff x y z
Now performActionB and its included check depend on x. That is, the check relies formally on the result of performActionA and thus check B must be performed after performActionA.
IIUC, this limitation of Monads was one of the reasons why John Hughes introduced the new Arrow abstraction.
How would this problem be solved using Arrows?

On Mon, Jun 25, 2007 at 10:58:16AM +0200, Henning Thielemann wrote:
On Mon, 25 Jun 2007, Tomasz Zielonka wrote:
On Mon, Jun 25, 2007 at 10:29:14AM +0200, Henning Thielemann wrote:
Imagine all performActions contain their checks somehow. Let performActionB take an argument.
do x <- performActionA y <- performActionB x z <- performActionC return $ calculateStuff x y z
Now performActionB and its included check depend on x. That is, the check relies formally on the result of performActionA and thus check B must be performed after performActionA.
IIUC, this limitation of Monads was one of the reasons why John Hughes introduced the new Arrow abstraction.
How would this problem be solved using Arrows?
Maybe it wouldn't. What I should say is that in a Monad the entire computation after "x <- performActionA" depends on x, even if it doesn't use it immediately. Let's expand the do-notation (for the earlier example): performActionA >>= \x -> performActionB >>= \y -> performActionC >>= \z -> return (calculateStuff x y z) If you wanted to analyze the computation without executing it, you would start at the top-level bind operator (>>=). performActionA >>= f and you would find it impossible to examine f without supplying it some argument. As a function, f is a black box. With Arrows it could be possible to inspect the structure of the computation without executing it, but it might be impossible to write some kinds of checks. Anyway, I have little experience with Arrows, so I can be wrong, and surely someone can explain it better. Best regards Tomek

I'm baffled. So using the Arrow abstraction (which I don't know yet) would solve this problem? How can (perfectActionB x) be checked with without ever executing performActionA which evaluates to x? This can only be done when x is a constant expression no? -----Original Message----- From: haskell-cafe-bounces@haskell.org [mailto:haskell-cafe-bounces@haskell.org] On Behalf Of Tomasz Zielonka Sent: Monday, June 25, 2007 10:43 AM To: Henning Thielemann Cc: haskell-cafe@haskell.org Subject: Re: [Haskell-cafe] Practical Haskell question. On Mon, Jun 25, 2007 at 10:29:14AM +0200, Henning Thielemann wrote:
Imagine all performActions contain their checks somehow. Let performActionB take an argument.
do x <- performActionA y <- performActionB x z <- performActionC return $ calculateStuff x y z
Now performActionB and its included check depend on x. That is, the check relies formally on the result of performActionA and thus check B must be performed after performActionA.
IIUC, this limitation of Monads was one of the reasons why John Hughes introduced the new Arrow abstraction. Best regards Tomek _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

OK, just to prevent this getting side-tracked: I'm absolutely uninterested in the results of performActionA before determining if performActionB is permitted/possible/whatever. Think more in terms of security permissions or resource availability/claiming than in terms of chaining results. I want to know before I begin to collect the results of performAction* that I will actually stand a chance at getting results at all. On Mon, 2007-25-06 at 10:58 +0200, peterv wrote:
I'm baffled. So using the Arrow abstraction (which I don't know yet) would solve this problem? How can (perfectActionB x) be checked with without ever executing performActionA which evaluates to x? This can only be done when x is a constant expression no?
-----Original Message----- From: haskell-cafe-bounces@haskell.org [mailto:haskell-cafe-bounces@haskell.org] On Behalf Of Tomasz Zielonka Sent: Monday, June 25, 2007 10:43 AM To: Henning Thielemann Cc: haskell-cafe@haskell.org Subject: Re: [Haskell-cafe] Practical Haskell question.
On Mon, Jun 25, 2007 at 10:29:14AM +0200, Henning Thielemann wrote:
Imagine all performActions contain their checks somehow. Let performActionB take an argument.
do x <- performActionA y <- performActionB x z <- performActionC return $ calculateStuff x y z
Now performActionB and its included check depend on x. That is, the check relies formally on the result of performActionA and thus check B must be performed after performActionA.
IIUC, this limitation of Monads was one of the reasons why John Hughes introduced the new Arrow abstraction.
Best regards Tomek _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
--
Michael T. Richter

2007/6/25, Michael T. Richter
OK, just to prevent this getting side-tracked: I'm absolutely uninterested in the results of performActionA before determining if performActionB is permitted/possible/whatever. Think more in terms of security permissions or resource availability/claiming than in terms of chaining results. I want to know before I begin to collect the results of performAction* that I will actually stand a chance at getting results at all.
Uh, the posts you quote were precisely about how to do that. No side-tracking going on. :-) All the best, - Benja

On Mon, 2007-25-06 at 12:19 +0300, Benja Fallenstein wrote:
2007/6/25, Michael T. Richter
: OK, just to prevent this getting side-tracked: I'm absolutely uninterested in the results of performActionA before determining if performActionB is permitted/possible/whatever. Think more in terms of security permissions or resource availability/claiming than in terms of chaining results. I want to know before I begin to collect the results of performAction* that I will actually stand a chance at getting results at all.
Uh, the posts you quote were precisely about how to do that. No side-tracking going on. :-)
It looked to me like there were people arguing about whether the "x"
returned from one action was going to be used in the next action.
Let me try and rephrase the question. :)
A conventional approach to what I'm doing would be something like this
(in bad pseudocode):
doStuff():
if checkPossible([opA, opB, opC]):
A
B
C
else:
exception "Preconditions not met"
My objection to this is its error-prone scaffolding:
1. There's no enforced link between the checking operations and the
actual operations. By mistake or by deliberate action it is
possible to put operations in the main body which have not been
checked by the guards.
2. As code evolves and changes, it is very easy to have the check
diverge from the contents of the body as well.
Now if the actions were trivial or easily reversible, an alternative
model is something like this (in bad pseudocode) where it's assumed that
each operation checks for its privileges/capabilities/whatever as part
of its operation:
doStuff2():
A
try:
B
try:
C
catch:
undoB
throw
catch:
undoA
This looks to me like Don Stuart's "executable semi-colons" and could be
coded as a pretty conventional monad (unless my eyes are deceiving me).
But if doing A, say, involved expensive operations (think: generating an
RSA key or making a database connection on a heavily-loaded server) or
if doing B involved modifying some external state that is difficult to
undo this is a less-than-ideal model. Let's say that C fails for
whatever reason (insufficient privileges, the database server is dead,
the phase of the moon is wrong for the species of chicken sacrificed at
the keyboard -- anything), then we've got time wasted in A and B has
just changed something we can't easily unchange.
So I'd like some way of getting the automated check of
permission/capability/availability/whatever done before performing the
actual actions.
Now in a language where functions are identifiable types, a solution
could look like this (among a myriad of other possible solutions):
check(Operation):
case Operation of:
A:
return checkConditionA
B:
return checkConditionB
C:
return checkConditionC
runStuff(actions):
for each action in actions:
if not check(action.left):
throw CheckFailure
for each action in actions:
action.left(action.right)
doStuff3():
actions=[(A, a_args), (B, b_args), (C, c_args)]
try:
runStuff(actions)
catch CheckFailure:
actions=nil
The check() function called here can use the identity of the action
provided plus any information provided externally (network connections
open, permissions available, etc.) to pass/fail the
capabilities/resources/whatever and the action's execution is deferred
until the check has passed. The action's check *AND* its execution is
unavailable to the programmer so there's less room for fraud and
oversight and all the other things which make programs buggy and
unreliable and such joys to work with both as a programmer and as a
user. In fact with languages as malleable as Ruby (or possibly even
Python) some of the ugly scaffolding above could be made to vanish
behind the scenes leaving pretty clean code behind. (Uglier languages
like C/C++, of course, would leave all the scaffolding lying around, but
it would still be doable.)
But of course this can't be done in Haskell this way because functions
aren't items in Haskell. There is no function equality check. My
check() function can't look like:
check :: (a->b)
check A = ...
check B = ...
check C = ...
check _ = error "no such function"
This leaves me in a position I can't think myself out of (hence the cry
for help). I'd like it to be possible to have a do block with as little
visible scaffolding as possible (ideally none) where I can do the
equivalent of doStuff3() and runStuff() from the above pseudocode.
Now here's the tricky part....
I'd ideally like to be able to do this so that it would be possible to
start with the doStuff2 implementation behind the scenes (check as you
go) and then, by changing the scaffolding behind the scenes, do the
doStuff3() implementation without touching a line of client code. In
effect I'd like to be able to change computing strategies on the fly
without the client code having to be modified. If we look at my
doStuff3() as an example, for instance, I could switch it over from a
pre-check to a check-as-you-go system pretty easily by modifying
runStuff() and the check(). runStuff() would be modified to interleave
the check with the call and check would be modified to return an undo
operation kept in an accumulator by runStuff() or nil. If nil is
returned, the list of undo operations maintained by runStuff would get
executed and the failure signalled.
Does this make more sense now? And can it be done somehow in Haskell?
--
Michael T. Richter

Michael T. Richter wrote:
It looked to me like there were people arguing about whether the "x" returned from one action was going to be used in the next action.
Let me try and rephrase the question. :)
[rephrase]
Yes, and that's an important constellation your problem description does not consider. Take the code doStuff(): if checkPossible( ?? ): x <- A if x then B else C else: exception "Preconditions not met" What should be put as argument into checkPossible? checkPossible([opA, opB, opC])? What if x happens to be always true and C is never run? What if B is possible if and only if C is not? Sequencing actions is not just putting them in a row, but also feeding the results of one action to the next ones. You have to restrict this in some way to make your goal possible.
And can it be done somehow in Haskell?
Most likely, and Haskell even tells you when your approach doesn't work without further specification :) Regards, apfelmus

On Mon, 25 Jun 2007, apfelmus wrote:
Michael T. Richter wrote:
It looked to me like there were people arguing about whether the "x" returned from one action was going to be used in the next action.
Let me try and rephrase the question. :)
[rephrase]
Yes, and that's an important constellation your problem description does not consider.
If Michael had asked for code that has to be executed _after_ the actual actions, say for cleanup, this would have been simple. If he knows that the performAction commands don't use results of former actions, then the Applicative approach described earlier in this thread would work, though without 'do' notation.

Michael,
I think what you're trying to do is perfectly doable in Haskell and I think
the right tool for it is arrows, as Tomasz Zielonka mentioned before. I
suggest you take a look at the following paper which uses arrows to enforce
security levels in the code:
http://www.cis.upenn.edu/~stevez/papers/abstracts.html#LZ06a
Cheers,
Josef
On 6/25/07, Michael T. Richter
On Mon, 2007-25-06 at 12:19 +0300, Benja Fallenstein wrote:
2007/6/25, Michael T. Richter
: OK, just to prevent this getting side-tracked: I'm absolutely uninterested in the results of performActionA before determining if performActionB is permitted/possible/whatever. Think more in terms of security permissions or resource availability/claiming than in terms of chaining results. I want to know before I begin to collect the results of performAction* that I will actually stand a chance at getting results at all.
Uh, the posts you quote were precisely about how to do that. No side-tracking going on. :-)
It looked to me like there were people arguing about whether the "x" returned from one action was going to be used in the next action.
Let me try and rephrase the question. [image: :)]
A conventional approach to what I'm doing would be something like this (in bad pseudocode):
doStuff(): if checkPossible([opA, opB, opC]): A B C else: exception "Preconditions not met"
My objection to this is its error-prone scaffolding:
1. There's no enforced link between the checking operations and the actual operations. By mistake or by deliberate action it is possible to put operations in the main body which have not been checked by the guards. 2. As code evolves and changes, it is very easy to have the check diverge from the contents of the body as well.
Now if the actions were trivial or easily reversible, an alternative model is something like this (in bad pseudocode) where it's assumed that each operation checks for its privileges/capabilities/whatever as part of its operation:
doStuff2(): A try: B try: C catch: undoB throw catch: undoA
This looks to me like Don Stuart's "executable semi-colons" and could be coded as a pretty conventional monad (unless my eyes are deceiving me). But if doing A, say, involved expensive operations (think: generating an RSA key or making a database connection on a heavily-loaded server) or if doing B involved modifying some external state that is difficult to undo this is a less-than-ideal model. Let's say that C fails for whatever reason (insufficient privileges, the database server is dead, the phase of the moon is wrong for the species of chicken sacrificed at the keyboard -- anything), then we've got time wasted in A and B has just changed something we can't easily unchange.
So I'd like some way of getting the automated check of permission/capability/availability/whatever done before performing the actual actions.
Now in a language where functions are identifiable types, a solution could look like this (among a myriad of other possible solutions):
check(Operation): case Operation of: A: return checkConditionA B: return checkConditionB C: return checkConditionC
runStuff(actions): for each action in actions: if not check(action.left): throw CheckFailure for each action in actions: action.left(action.right)
doStuff3(): actions=[(A, a_args), (B, b_args), (C, c_args)] try: runStuff(actions) catch CheckFailure: actions=nil
The check() function called here can use the identity of the action provided plus any information provided externally (network connections open, permissions available, etc.) to pass/fail the capabilities/resources/whatever and the action's execution is deferred until the check has passed. The action's check *AND* its execution is unavailable to the programmer so there's less room for fraud and oversight and all the other things which make programs buggy and unreliable and such joys to work with both as a programmer and as a user. In fact with languages as malleable as Ruby (or possibly even Python) some of the ugly scaffolding above could be made to vanish behind the scenes leaving pretty clean code behind. (Uglier languages like C/C++, of course, would leave all the scaffolding lying around, but it would still be doable.)
But of course this can't be done in Haskell this way because functions aren't items in Haskell. There is no function equality check. My check() function can't look like:
check :: (a->b) check A = ... check B = ... check C = ... check _ = error "no such function"
This leaves me in a position I can't think myself out of (hence the cry for help). I'd like it to be possible to have a do block with as little visible scaffolding as possible (ideally *none*) where I can do the equivalent of doStuff3() and runStuff() from the above pseudocode.
Now here's the tricky part....
I'd ideally like to be able to do this so that it would be possible to start with the doStuff2 implementation behind the scenes (check as you go) and then, by changing the scaffolding behind the scenes, do the doStuff3() implementation *without touching a line of client code*. In effect I'd like to be able to change computing strategies on the fly without the client code having to be modified. If we look at my doStuff3() as an example, for instance, I could switch it over from a pre-check to a check-as-you-go system pretty easily by modifying runStuff() and the check(). runStuff() would be modified to interleave the check with the call and check would be modified to return an undo operation kept in an accumulator by runStuff() or nil. If nil is returned, the list of undo operations maintained by runStuff would get executed and the failure signalled.
Does this make more sense now? And can it be done somehow in Haskell?
-- *Michael T. Richter*
(*GoogleTalk:* ttmrichter@gmail.com) *Those who have learned from history are bound to helplessly watch it repeat itself. (Albert Y. C. Lai)* _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

Hello Michael, Monday, June 25, 2007, 2:10:28 PM, you wrote:
Does this make more sense now? And can it be done somehow in Haskell?
runCheckedCode = checkBeforeRun [actionA x y, actionB z t, actionC] actionA x y b | b = -- check conditions | otherwise = -- perform action -- Best regards, Bulat mailto:Bulat.Ziganshin@gmail.com

As others have explained, you can't analyse your do-constructs, because functions are opaque -- at the value level. The canonical option would indeed seem to be to use arrows (or applicative functors), instead of monads. ------ If you want to stick to monads, there is another possibility: carry around the necessary checks *at the type level*. Below is a sketch of how you could do this. Things to note: - Uses HList http://homepages.cwi.nl/~ralf/HList/. - Deciding which checks to perform happens statically, so it will check for any actions that are mentioned, even if they are not actually performed: actionX >>= \ b -> if b then actionY else actionZ will perform checks necessary for actionZ, even if actionX happens to return True. - First draft; may contain sharp edges (or outright errors). There are some possibilities for generalisation: e.g. do it over an arbitrary monad, instead of IO. ------8<------ module CheckIO where import Control.Monad.Error import HList ( (:*:) , (.*.) , HNil ( HNil ) , HOccurs ) data CheckIO labels x = CheckIO (IO x) instance Monad (CheckIO l) where return = CheckIO . return (CheckIO a) >>= h = CheckIO $ a >>= ((\ (CheckIO x) -> x) . h) fail = CheckIO . fail instance Functor (CheckIO l) where fmap f (CheckIO a) = CheckIO (fmap f a) withCheck :: (HOccurs label labels) => IO x -> label -> CheckIO labels x withCheck = flip (const CheckIO) class Check label where check :: label -> ErrorT String IO () -- |label| argument is for type inference only class Checks c where performChecks :: c -> ErrorT String IO () -- |c| argument is for type inference only instance Checks HNil where performChecks _ = return () instance (Check label,Checks rest) => Checks (label :*: rest) where performChecks _ = check (undefined :: label) >> performChecks (undefined :: rest) runWithChecks :: forall labels x. (Checks labels) => CheckIO labels x -> labels -> ErrorT String IO x runWithChecks (CheckIO q) _ = performChecks (undefined :: labels) >> liftIO q -- End of general CheckIO code; the following example use would actually go in a different module. -- Component actions data Root = Root instance Check Root where check _ = do liftIO $ putStrLn "Root privileges required. Enter root password:" pw <- liftIO getLine if pw == "myRootPassword" then return () else throwError "No root." actionA :: (HOccurs Root labels) => CheckIO labels () actionA = putStrLn "Enter a string:" `withCheck` Root data Database = Database instance Check Database where check _ = liftIO $ putStrLn "Database is ok." actionB :: (HOccurs Database labels) => CheckIO labels String actionB = getLine `withCheck` Database data Connection = Connection instance Check Connection where check _ = do liftIO $ putStrLn "Connection up?" x <- liftIO getLine if x == "yes" then return () else throwError "No connection." actionC :: (HOccurs Connection labels) => String -> CheckIO labels () actionC x = putStrLn (reverse x) `withCheck` Connection -- Composed action main :: ErrorT String IO () main = action `runWithChecks` (Connection .*. Database .*. Root .*. HNil) action :: (HOccurs Root labels,HOccurs Connection labels,HOccurs Database labels) => CheckIO labels () action = do actionA x <- actionB actionC x ------>8------ Kind regards, Arie

I wrote:
If you want to stick to monads, there is another possibility: carry around the necessary checks *at the type level*. Below is a sketch of how you could do this.
Importantly, the given code still requires you to specify the checks "by hand", when running the action; it only checks that you didn't forget a necessary check. Perhaps someone can improve this, so it derives the necessary checks automatically? Greetings, Arie

On Mon, 25 Jun 2007, Michael T. Richter wrote:
OK, just to prevent this getting side-tracked: I'm absolutely uninterested in the results of performActionA before determining if performActionB is permitted/possible/whatever. Think more in terms of security permissions or resource availability/claiming than in terms of chaining results.
We have understood this.
I want to know before I begin to collect the results of performAction* that I will actually stand a chance at getting results at all.
It's irrelevant, what you want. :-) In principle you can write 'performActionB x' and the monad concept urges you to handle this even if you know, that the check that is integrated in performActionB will not depend on x. Wouter gave you another example which shows the problem. If there is a monad which handles your problem, then you can write do b <- performActionA if b then performActionB else performActionC You see that only one of the checks B or C can be performed, and this depends on the result of performActionA. Btw. I'm interested how you solve this problem in C++ in an elegant way.

Hi Peter,
2007/6/25, peterv
I'm baffled. So using the Arrow abstraction (which I don't know yet) would solve this problem? How can (perfectActionB x) be checked with without ever executing performActionA which evaluates to x? This can only be done when x is a constant expression no?
Arrows separate the action -- 'performActionB' -- from the argument -- 'x', so you can look at the action before you have to compute the argument to it. Of course, this means that you can no longer compute the action from the argument -- that is, 'if x then performActionB else performActionC' is something you can't directly do; you have to use a choice primitive instead, which explicitly says "use one of these two arrows depending on what value this argument is," which then lets the library check these two arrows before actually applying them to an argument. - Benja

Benja Fallenstein wrote:
Hi Peter,
2007/6/25, peterv
: I'm baffled. So using the Arrow abstraction (which I don't know yet) would solve this problem? How can (perfectActionB x) be checked with without ever executing performActionA which evaluates to x? This can only be done when x is a constant expression no?
Arrows separate the action -- 'performActionB' -- from the argument -- 'x', so you can look at the action before you have to compute the argument to it. Of course, this means that you can no longer compute the action from the argument -- that is, 'if x then performActionB else performActionC' is something you can't directly do; you have to use a choice primitive instead, which explicitly says "use one of these two arrows depending on what value this argument is," which then lets the library check these two arrows before actually applying them to an argument.
Well, arrows can't solve the problem as well iff performActionB may be permissible _depending_ on x, i.e. performActionB x = if x then pickFlowers else eraseHardDrive There's no way to check whether performActionB is permissible for a given run without executing performActionA for the permissibility of B depends on the output of A. But I think that Michael had conditions in mind that can be checked before executing any of the actions. Of course, the simplest way is to check manually: do if i'mRoot then do x <- performActionA y <- performActionB z <- performActionC return $ calculateStuff x y z else cry "gimme root" but you could still write performActionA somewhere without having checked/established root permission. This can be solved by using a custom monad newtype Sudo a = Sudo { act :: IO a } deriving (Functor,Monad,MonadIO) which has the following operations performActionA :: Sudo Int performActionB :: Sudo String etc. and that can only be run with sudo :: Sudo a -> IO (Either String a) sudo m = do b <- makeMeRoot if b then liftM Right $ act m else return $ Left "Could not become Root" Putting Sudo into a module and making it abstract ensures that you can't break the invariant that stuff of type "Sudo a" will either be run as root or not at all. Regards, apfelmus

There is a related discussion, with a lot of pointers, in a recent D.Piponi blog post: http://sigfpe.blogspot.com/2007/04/homeland-security-threat-level- monad.html On 25/06/2007, at 10:58, peterv wrote:
I'm baffled. So using the Arrow abstraction (which I don't know yet) would solve this problem? How can (perfectActionB x) be checked with without ever executing performActionA which evaluates to x? This can only be done when x is a constant expression no?
-----Original Message----- From: haskell-cafe-bounces@haskell.org [mailto:haskell-cafe-bounces@haskell.org] On Behalf Of Tomasz Zielonka Sent: Monday, June 25, 2007 10:43 AM To: Henning Thielemann Cc: haskell-cafe@haskell.org Subject: Re: [Haskell-cafe] Practical Haskell question.
On Mon, Jun 25, 2007 at 10:29:14AM +0200, Henning Thielemann wrote:
Imagine all performActions contain their checks somehow. Let performActionB take an argument.
do x <- performActionA y <- performActionB x z <- performActionC return $ calculateStuff x y z
Now performActionB and its included check depend on x. That is, the check relies formally on the result of performActionA and thus check B must be performed after performActionA.
IIUC, this limitation of Monads was one of the reasons why John Hughes introduced the new Arrow abstraction.
Best regards Tomek _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

Hi Michael, On 25 Jun 2007, at 06:39, Michael T. Richter wrote:
do x <- performActionA y <- performActionB z <- performActionC return $ calculateStuff x y z
I don't know about you're exact example, but here's what I'd do. Control.Monad has functions like when, unless, and guard that you can use to check whether the "precondition" holds. I find an "ifM" combinator quite useful sometimes: ifM :: Monad m => m Bool -> m a -> m a -> ma ifM cond thenBranch elseBranch = do b <- cond if cond then thenBranch else elseBranch If everything checks out, you can then execute your A, B, and C actions. I don't think you really want arrows here. The right idiom is applicative functors (see Control.Applicative). You could then write the above as: calculateStuff <$> x <*> y <*> z Hope this helps, Wouter

Wouter Swierstra wrote:
I don't think you really want arrows here. The right idiom is applicative functors (see Control.Applicative). You could then write the above as:
calculateStuff <$> x <*> y <*> z
I think you mean calculateStuff <$> performActionA <*> performActionB <*> performActionC Regards, apfelmus

Micheal, I think you mean
do
x <- if .. then ..
else ..
y <- if ... then..
else...
etc etc
On 6/25/07, Michael T. Richter
Now I've got a situation I can't figure out how to resolve. I want to have a set of actions which are executed sequentially, but which, before I even *start* to execute the first one, have been inspected for legality and/or plausibility. Consider this kind of sequence:
do x <- performActionA y <- performActionB z <- performActionC return $ calculateStuff x y z
Now obviously this is going to be in a monad of some kind. Were this a regular, run-of-the-mill program I'd just use the IO monad. But what I want to do instead is, before executing any of the perform* functions, check that the actions desired are actually *permitted* (or possible) given a set of circumstances. For example let's say it's a permissions issue and performActionB can only be done if I'm root. If I'm not root I don't want performActionA done because I can't complete the transaction. (Maybe ActionA is non-reversible, say.) Or let's say this is code that's accessing databases on the network. If the network link to C can't be established, I don't want to screw around with A and B's links at all -- it's too expensive, too time-consuming or whatever.
Were I programming this in C, C++, Python, Ruby, etc. I could do this in my sleep. Functions are addresses (C/C++) or objects with an ID (Python/Ruby) so it's possible to take them and do some kind of check based on identities before executing things (although the scaffolding around this would be nontrivial in any of these languages except, possibly, Ruby). Functions in Haskell don't have this property, however, so I can't figure out what I'd do to perform similar work. I'm sure there's a way to do it, but I just can't see it.
-- *Michael T. Richter*
(*GoogleTalk:* ttmrichter@gmail.com) *I'm not schooled in the science of human factors, but I suspect surprise is not an element of a robust user interface. (Chip Rosenthal)* _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

Now I've got a situation I can't figure out how to resolve. I want to have a set of actions which are executed sequentially, but which, before I even start to execute the first one, have been inspected for legality and/or plausibility. Consider this kind of sequence:
do x <- performActionA y <- performActionB z <- performActionC return $ calculateStuff x y z
as has been pointed out, there is an issue as to whether the conditions for legality can depend on runtime information. if they don't, you could try to express the capabilities needed by each of the actions in their types, and collect the types when composing the actions. i first saw this trick used for type-based bytecode verification in The Functions of Java Bytecode Mark P. Jones. In Proceedings of the OOPSLA '98 workshop on Formal Underpinnings of Java, Vancouver, BC, Canada, October 1998. http://web.cecs.pdx.edu/~mpj/pubs/funJava.html but i'm sure that somewhere in the wealth of HList work, there'll be something similar, updated for todays ghc!-) if the conditions are static, but their validity might depend on runtime info, you'd need to map the types expressing the capabilities required back down to functions checking their availability, and execute those checks before running the composed actions. if the conditions themselves might change as actions are computed at runtime, you might still be able to use a transaction-based approach: only execute the actions in a sandbox at first, so that you can abandon the transaction if any of the actions in it fail, and commit to the transaction (turning the sandbox changes into real changes) only if all actions in it succeed. in a way, you're executing the transaction twice, once only to check it will go through, then again for the actual updates. hth, claus
participants (14)
-
apfelmus
-
Arie Peterson
-
Benja Fallenstein
-
Bulat Ziganshin
-
Claus Reinke
-
Dan Mead
-
Daniil Elovkov
-
Henning Thielemann
-
Josef Svenningsson
-
Michael T. Richter
-
Pepe Iborra
-
peterv
-
Tomasz Zielonka
-
Wouter Swierstra