[Haskell-cafe] Applicative functors with branch/choice ?
Евгений Пермяков
permeakra at gmail.com
Thu Jul 26 12:40:52 CEST 2012
well... This code is both demonstration for use case and more sane
class + instance
typeclass name is selected quite randomly, may be native speaker will
select a better one
module Actuative where
import Control.Applicative
import System.IO
import System.IO.Error
-- | minimal complete definition : select
class Applicative f => Actuative f where
-- | select computation conditionally . Side effects of only one two
alternative take place
select :: f (Either a b) -- ^ selector
-> f (a -> c) -- ^ first alternative
-> f (b -> c) -- ^ second alternative
-> f c
-- | correct possible error
correct :: f (Either a b) -> f (a -> b) -> f b
correct i l = select i l (pure (\x -> x))
-- | similiar for select, but mimics ArrowChoice
branch :: f (Either a b) -> f (a -> c) -> f (b -> d) -> f (Either
c d)
branch i l r = select i (pure (\f x -> Left (f x)) <*> l) (pure (\f x
-> Right (f x)) <*> r)
-- | execute only if Left
onLeft :: f (Either a b) -> f (a -> c) -> f (Either c b)
onLeft i l = branch i l (pure (\x -> x))
-- | execute only if Right
onRight :: f (Either a b) -> f (b -> c) -> f (Either a c)
onRight i r = branch i (pure (\x -> x)) r
-- | This is streaming parser combinators for writing LR (k) grammars
newtype Parse a = Parse { runParse :: Handle -> IO a }
-- | this function is one of reasons. If EOF occurs, we should produce
result. If not, we should continue parsing. Monadic interface, however,
gives too much freedom.
next :: Parse (Maybe Char)
next = Parse $ \h -> catchIOError (fmap Just $ hGetChar h) (const $
return Nothing)
instance Functor Parse where
fmap f s = pure f <*> s
instance Applicative Parse where
pure a = Parse $ \_ -> return a
(Parse l) <*> (Parse r) = Parse $ \h -> do
lr <- l h
rr <- r h
return $ lr rr
-- instance for Actuative.
instance Actuative Parse where
select (Parse i) (Parse l) (Parse r) = Parse $ \h -> do
ir <- i h
case ir of
Left lv -> do
lr <- l h
return $ lr lv
Right rv -> do
rr <- r h
return $ rr rv
On 07/26/2012 12:48 PM, Ross Paterson wrote:
> On Wed, Jul 25, 2012 at 09:22:23PM +0100, Евгений Пермяков wrote:
>> So, it seems for me, that Applicative API should be extended with
>> typeclass for making choice what actions to execute depending on result
>> of some test (pattern matching). Is there any reasonable definition of
>> such typeclass or clear explanation, why such typeclass is unneeded?
>>
>> The possible extension may look somehow like this:
>>
>> class Applicative a => Branching a where
>> branch :: a (Either b c) -> (a b -> a d) -> (a c -> a d) -> a d
> Do you have any instances in mind?
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
More information about the Haskell-Cafe
mailing list