[Haskell-cafe] manage effects in a DSL
Corentin Dupont
corentin.dupont at gmail.com
Wed Feb 12 16:44:17 UTC 2014
Hi guys,
so I tried to implement fully the proposition (see below).
It works well. However I find it a bit redundant. Can we reduce the
repetitions?
Perhaps I didn't understand how to write the evaluation...
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
module Main where
import Control.Monad.State
import Control.Monad.Reader
class Monad m => Nomex m where
readAccount :: m Int
class Nomex m => NomexEffect m where
writeAccount :: Int -> m ()
setVictory :: (forall n. Nomex n => n Bool) -> m ()
data Exp a where
ReadAccount :: Exp Int
WriteAccount :: Int -> Exp ()
SetVictory :: (forall m. Nomex m => m Bool) -> Exp ()
Bind :: Exp a -> (a -> Exp b) -> Exp b
Return :: a -> Exp a
instance Monad Exp where
return = Return
(>>=) = Bind
instance Nomex Exp where
readAccount = ReadAccount
instance NomexEffect Exp where
writeAccount = WriteAccount
setVictory = SetVictory
data Game = Game { victory :: (forall m. Nomex m => m Bool)
, account :: Int
}
instance Nomex (State Game) where
readAccount = gets account
instance NomexEffect (State Game) where
writeAccount n = modify $ \game -> game { account = n }
setVictory v = modify $ \game -> game { victory = v }
instance Nomex (Reader Game) where
readAccount = asks account
evaluate :: Exp a -> State Game a
evaluate (WriteAccount i) = writeAccount i
evaluate ReadAccount = readAccount
evaluate (SetVictory v) = setVictory v
evaluate (Return a) = return a
evaluate (Bind a f) = (evaluate a) >>= evaluate . f
evalNoEff :: Exp a -> Reader Game a
evalNoEff ReadAccount = readAccount
evalNoEff (Return a) = return a
evalNoEff (Bind a f) = (evalNoEff a) >>= evalNoEff . f
isVictory :: Game -> Bool
isVictory g = runReader (evalNoEff (victory g)) g
incrAccount :: NomexEffect m => m ()
incrAccount = readAccount >>= writeAccount . (+101)
winOnBigMoney :: NomexEffect m => m ()
winOnBigMoney = setVictory $ do
i <- readAccount
--writeAccount 100
return (i > 100)
play = do
winOnBigMoney
incrAccount
initGame = Game (return False) 0
main = do
let g = execState (evaluate jeu) initGame
putStrLn $ show $ isVictory g
On Mon, Feb 10, 2014 at 11:33 AM, Dominique Devriese <
dominique.devriese at cs.kuleuven.be> wrote:
> Corentin,
>
> 2014-02-10 10:48 GMT+01:00 Corentin Dupont <corentin.dupont at gmail.com>:
> > That is really interesting. In fact, I didn't have the time to experiment
> > with it, but I definitely want to (have to find some spare time!).
> > I must say I am less used to type classes.
> > At first, my concern with the technique was that two things that belong
> > together, "ReadAccount" and "WriteAccount", are separated.
>
> Yes, this separation of ReadAccount and WriteAccount into Nomex vs
> NomexEffect is how the two parts (read-only vs read-write) of the DSL
> are distinguished in this approach..
>
> > I was also confused that the evaluator is wrapped in a newtype, and that
> it
> > is an instance of Nomex.
>
> That is non-essential. You can also use
>
> instance Nomex (State Game) where
>
> but it's just cleaner with a newtype...
>
> > Beside, I suppose it is possible to factorize EvalNoEffect with Eval?
> Maybe
> > using liftEval anyway...
>
> If I understand correctly, you're asking about how to remove the
> duplication between EvalNoEffect and Eval?
>
> This is a very good question. My answer is basically that Haskell is
> missing some type-class-related features to allow for the perfect
> solution, specifically a form of local instances.
>
> The long story is that instead of the above instances of Nomex and
> NomexEffect for Eval and EvalNoEffect separately, we would like to be
> able to write the following instances:
>
> instance MonadReader Game m => Nomex m where
> readAccount = asks account
>
> instance (MonadReader Game m, MonadState Game m) => NomexEffect m where
> writeAccount n = modify $ \game -> game { account = n }
> setVictory v = modify $ \game -> game { victory = v }
>
> and then we can declare
> newtype Eval a = Eval { eval :: State Game a }
> deriving (Monad, MonadState Game, MonadReader Game)
>
> newtype EvalNoEffect a = EvalNoEffect { evalNoEffect :: Reader Game a }
> deriving (Monad, MonadReader Game)
>
> and reuse the single implementation of Nomex for both Eval and
> EvalNoEffect. However, there are various problems with this solution:
>
> * the instances are not permitted without UndecidableInstances (which
> I recommend against),
> * the derivation of MonadReader from State won't work because
> MonadReader is not treated as a superclass of MonadState in Haskell,
> despite the fact that functionality-wise it is.
>
> What is needed to solve these problems is a feature that is in my
> opinion strongly missing in Haskell: a form of local instances. This
> means that we would be able to explicitly specify what implementation
> of a certain type class should be used to satisfy a certain type class
> constraint, e.g.
>
> sort :: Ord a => [a] -> [a]
> sortBy :: forall a. (a -> a -> Bool) -> [a] -> [a]
> sortBy f = let instance ordDict :: Ord.Dict a
> ordDict = constructOrdDict f
> in sort :: Ord a => [a] -> [a]
>
> Local instances were already considered by Wadler when he proposed
> type classes, but they are problematic to combine with type inference.
> However, it seems likely that this is not an issue if we require
> sufficiently informative type annotations.
>
> For the problem above, this would allow to construct, use and lift
> (together with newtype coercions) a MonadReader dictionary for the
> State monad without necessarily having it derived automatically if
> this is not desired. Also, this would allow to write the undecidable
> instances as normal functions that need to be explicitly invoked
> instead of inferred by type inference, avoiding the
> UndecidableInstances problem.
>
> Regards
> Dominique
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20140212/d9514ca4/attachment.html>
More information about the Haskell-Cafe
mailing list