Branch.hs

import Control.Applicative ( Alternative(empty, (<|>)) )

newtype Branch s a = Branch (s -> [(a,s)])

branch :: (s -> [(a,s)]) -> Branch s a
branch = Branch

run :: Branch s a -> (s -> [(a,s)])
run (Branch f) = f

instance Functor (Branch s) where
  fmap f (Branch g) = branch $ map (\(a,s) -> (f a,s)) . g

instance Applicative (Branch s) where
  pure a = branch $ \s -> [(a,s)]
  (<*>) s1 s2 = do { f <- s1; a <- s2; return $ f a}

instance Monad (Branch s) where
  (>>=) (Branch g) f = Branch $ \s -> concat [let (Branch g') = f a in g' s' | (a,s') <- g s]

instance Alternative (Branch s) where
  empty = Branch $ const [] 
  (<|>) b1 b2 = branch $ \s -> run b1 s ++ run b2 s


save :: (s -> [a]) -> Branch s a
save f = branch $ \s -> [(a,s) | a <- f s]

branchState :: State s a -> Branch s a
branchState = branch . (return.) . runState

Effector.hs

import Data.Functor.Identity (Identity)

newtype Effector s m a = Effector (s -> m (a,s))

run :: Effector s m a -> s -> m (a,s)
run (Effector f) = f

effector :: (s -> m (a,s)) -> Effector s m a
effector = Effector

instance Functor m => Functor (Effector s m) where
  fmap f e = effector $ fmap (\(a,s) -> (f a,s)) . run e

instance Monad m => Applicative (Effector s m) where
  pure a = effector $ \s -> pure (a,s)
  e1 <*> e2 = do { f <- e1; a <- e2; return $ f a}

instance Monad m => Monad (Effector s m) where
  e >>= f = effector $ \s -> run e s >>= (\(a,s') -> run (f a) s')



eff :: Monad m => (s -> (a,s)) -> Effector s m a
eff f = effector (pure . f)

get :: Monad m => Effector s m s
get = eff $ \s -> (s,s) 

put :: Monad m => s -> Effector s m ()
put s = eff (const ((),s))

save :: Monad m => (s -> m a) -> Effector s m a
save f = effector $ \s -> f s >>= (\a -> pure (a,s))

modify :: Monad m => (s -> s) -> Effector s m ()
modify f = get >>= (put . f)

gets :: Monad m => (s -> a) -> Effector s m a
gets f = get >>= pure . f


type State s a = Effector s Identity a

type Branch s a = Effector s [] a

type Parser a = Effector String [] a

data RoseTree a = Node a [RoseTree a]

State.hs

newtype State s a = State (s -> (a,s))

state :: (s -> (a,s)) -> State s a
state = State

runState :: State s a -> (s -> (a,s))
runState (State f) = f

instance Functor (State s) where
  fmap f (State g) = State $ (\(a,s) -> (f a,s)) . g

instance Applicative (State s) where
  pure a = State $ \s -> (a,s)
  (<*>) s1 s2 = do { f <- s1; a <- s2; return $ f a}

instance Monad (State s) where
  (>>=) (State g) f = State $ \s -> let (a,s')     = g s
                                        (State g') = f a in g' s'