[Haskell-cafe] manage effects in a DSL
Jake McArthur
jake.mcarthur at gmail.com
Wed Feb 12 23:44:46 UTC 2014
As Chris says, you no longer need the GADT at all.
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleInstances #-}
import Control.Monad.Identity
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 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
isVictory :: Game -> Bool
isVictory = join (runReader . victory)
incrAccount :: NomexEffect m => m ()
incrAccount = readAccount >>= writeAccount . (+101)
winOnBigMoney :: NomexEffect m => m ()
winOnBigMoney = setVictory $ do
i <- readAccount
--writeAccount 100
return (i > 100)
play :: StateT Game Identity ()
play = do
winOnBigMoney
incrAccount
initGame :: Game
initGame = Game (return False) 0
main :: IO ()
main = do
let g = execState play initGame
putStrLn $ show $ isVictory g
On Wed, Feb 12, 2014 at 11:44 AM, Corentin Dupont <corentin.dupont at gmail.com
> wrote:
>
> 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/78360d97/attachment.html>
More information about the Haskell-Cafe
mailing list