[Haskell-cafe] manage effects in a DSL
Corentin Dupont
corentin.dupont at gmail.com
Thu Feb 13 16:29:20 UTC 2014
Ho, that is great. Very elegant.
On Thu, Feb 13, 2014 at 12:44 AM, Jake McArthur <jake.mcarthur at gmail.com>wrote:
> 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/20140213/4061f33f/attachment.html>
More information about the Haskell-Cafe
mailing list