Define and use multiparam typeclass

DomainEventModule.hs

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FunctionalDependencies #-}

module Domain.UnoGame.DomainEventModule (DomainEventApply(..), DomainEventDecide(..), DomainEventEmptyState(..)) where

import Domain.UnoGame.Events.UnoGameEvents (UnoGameEvent)
import Domain.UnoGame.Commands.UnoGameCommands (UnoGameCommand)
import Domain.UnoGame.Models.UnoGameState (State(..))
import Domain.UnoGame.Events.UnoGameErrors (UnoGameError)
import qualified Domain.UnoGame.Models.UnoGameApply as UnoGameApply (apply)
import qualified Domain.UnoGame.Models.UnoGameDecide as UnoGameDecide (decide)

--https://stackoverflow.com/questions/20040224/functional-dependencies-in-haskell
class DomainEventApply event state | event -> state where
  apply :: state -> event -> state

instance DomainEventApply UnoGameEvent State where
  apply = UnoGameApply.apply


class DomainEventDecide state command error event where
  decide :: state -> command -> Either error [event]

instance DomainEventDecide State UnoGameCommand UnoGameError UnoGameEvent where
  decide = UnoGameDecide.decide


class DomainEventEmptyState state where
  _EmptyState :: state

instance DomainEventEmptyState State where
  _EmptyState = EmptyState

EventsourcingTestFramework.hs

{-# LANGUAGE AllowAmbiguousTypes #-}

module Utils.EventsourcingTestFramework (_Given, _When, _Then) where

import Domain.UnoGame.DomainEventModule (DomainEventApply(apply), DomainEventDecide(decide), DomainEventEmptyState(_EmptyState))
import Domain.UnoGame.Models.UnoGameState (State(EmptyState))
import Test.Hspec
import Data.Proxy

newtype ExpectedEvents evt = ExpEvt [evt]
newtype InitialState evt = IState [evt]
type ExpectedError error = error

_Given :: [event] -> InitialState event
_Given = IState

_When :: command -> InitialState event -> (command, InitialState event)
_When cmd istate = (cmd, istate)

_Then :: (DomainEventDecide state command error event, DomainEventApply event state, DomainEventEmptyState state, Show event, Show error, Eq event, Eq error) =>
          Either error [event] -> (command, InitialState event) -> IO ()
_Then expected (cmd, istate) = performPredicate _EmptyState cmd istate expResult
  where expResult = (fmap (\evt -> ExpEvt evt) expected)

performPredicate :: (DomainEventDecide state command error event, DomainEventApply event state, Show event, Show error, Eq event, Eq error) =>
                     state -> command -> InitialState event -> Either error (ExpectedEvents event) -> IO ()
performPredicate emptystate cmd (IState evts) expResult = assertEqual result expResult
  where result = decide currentState cmd
        currentState = calculCurrentState emptystate evts

assertEqual :: (Show event, Show error, Eq event, Eq error) => Either error [event] -> Either error (ExpectedEvents event) -> IO ()
assertEqual (Right result) (Right (ExpEvt expected)) = result `shouldBe` expected
assertEqual (Left err) (Left expected) = err `shouldBe` expected

calculCurrentState :: (DomainEventApply event state) => state -> [event] -> state
calculCurrentState istate evts = foldl (\currentState event -> apply currentState event ) istate evts

UnoGameSpec.hs

{-# LANGUAGE AllowAmbiguousTypes #-}


module Domain.UnoGame.UnoGameSpec where

import Test.Hspec
import Utils.EventsourcingTestFramework (_Given, _When, _Then)
import Domain.UnoGame.Commands.UnoGameCommands (UnoGameCommand(..))
import Domain.UnoGame.Events.UnoGameEvents (UnoGameEvent(..), Player(..))
import Domain.UnoGame.Models.UnoGameState (State(..))
import Domain.UnoGame.Events.UnoGameErrors (UnoGameError(GameIsAlreadyStarted))
import Domain.UnoGame.DomainEventModule
import Data.Either
import Utils.Thrush ((|>))

spec :: Spec
spec = do
  describe "Should start the game" $ do
    it "Given EmptyState, When try to StartGame, Then should GameStarted" $ do
      _Given [] |> _When _StartGame |> _Then _ExpectedGameStarted

    it "Given an already  started game, When try to StartGame, Then should return []" $ do
      _Given [_GameStarted] |> _When _StartGame |> _Then _GameIsAlreadyStarted

_GameStarted = GameStarted [Player 0]
_ExpectedGameStarted = (Right [_GameStarted]) :: Either UnoGameError [UnoGameEvent]

_StartGame = StartGame [Player 0]

_GameIsAlreadyStarted = (Left GameIsAlreadyStarted) :: Either UnoGameError [UnoGameEvent]

J'essai de définir un "framework" générique pour fournir un DSL pour mes tests de système évènementiel.
Pour ce faire j'ai défini des fonctions Given, When, Then qui s'applique sur des type paramétrique.

Mais ces types doivent avoir plusieurs contraintes, qui sont d'avoir une fonction

apply :: State -> Command -> State
decide :: Comand -> State -> [Event]
emptyState :: State

qui sont nécessaire pour fold sur les évènements initiaux pour construire l'état courant, et jouer decide sur la commande testée.

Pour ce faire j'ai défini 3 classes de types à plusieurs paramètres.

Mon soucis est que j'ai une erreur de compilation au niveau de EventsourcingTestFramework.

/Users/ugobourdon/Dev/Projects/uno-server/test/Utils/EventsourcingTestFramework.hs:29:73: error:
    • Could not deduce (DomainEventEmptyState state0)
        arising from a use of ‘emptyState’
      from the context: DomainEventDecide state command error event
        bound by the type signature for:
                   performPredicateError :: forall state command error event.
                                            DomainEventDecide state command error event =>
                                            command -> InitialState event -> error -> IO ()
        at test/Utils/EventsourcingTestFramework.hs:28:1-121
      The type variable ‘state0’ is ambiguous
      These potential instance exist:
        one instance involving out-of-scope types
        (use -fprint-potential-instances to see them all)
    • In the first argument of ‘actualState’, namely ‘emptyState’
      In the first argument of ‘decide’, namely
        ‘(actualState emptyState evts)’
      In the first argument of ‘shouldBe’, namely
        ‘(decide (actualState emptyState evts) cmd)’
   |
29 | performPredicateError cmd (IState evts) expError = (decide (actualState emptyState evts) cmd) `shouldBe` Left expError
   |

Avez-vous une idée de ce que j'ai manqué ?

Nouvel erreur de compil en séparant les typeclass :

/Users/ugobourdon/Dev/Projects/uno-server/test/Utils/EventsourcingTestFramework.hs:28:55: error:
    • Could not deduce (DomainEventDecide state0 command error0 event)
        arising from a use of ‘decide’
      from the context: (DomainEventDecide state command error event,
                         DomainEventEmptyState state)
        bound by the type signature for:
                   performPredicate :: forall state command error event.
                                       (DomainEventDecide state command error event,
                                        DomainEventEmptyState state) =>
                                       command
                                       -> InitialState event -> ExpectedEvents event -> IO ()
        at test/Utils/EventsourcingTestFramework.hs:27:1-164
      The type variables ‘state0’, ‘error0’ are ambiguous
      Relevant bindings include
        currentState :: state0
          (bound at test/Utils/EventsourcingTestFramework.hs:29:9)
        expEvts :: [event]
          (bound at test/Utils/EventsourcingTestFramework.hs:28:44)
        evts :: [event]
          (bound at test/Utils/EventsourcingTestFramework.hs:28:30)
        cmd :: command
          (bound at test/Utils/EventsourcingTestFramework.hs:28:18)
        performPredicate :: command
                            -> InitialState event -> ExpectedEvents event -> IO ()
          (bound at test/Utils/EventsourcingTestFramework.hs:28:1)
      These potential instance exist:
        one instance involving out-of-scope types
        (use -fprint-potential-instances to see them all)
    • In the first argument of ‘shouldBe’, namely
        ‘decide currentState cmd’
      In the expression: decide currentState cmd `shouldBe` Right expEvts
      In an equation for ‘performPredicate’:
          performPredicate cmd (IState evts) (ExpEvt expEvts)
            = decide currentState cmd `shouldBe` Right expEvts
            where
                currentState = actualState emptyState evts
   |
28 | performPredicate cmd (IState evts) (ExpEvt expEvts) = decide currentState cmd `shouldBe` Right expEvts
   |                                                       ^^^^^^^^^^^^^^^^^^^^^^^

/Users/ugobourdon/Dev/Projects/uno-server/test/Utils/EventsourcingTestFramework.hs:28:55: error:
    • Could not deduce (Show error0) arising from a use of ‘shouldBe’
      from the context: (DomainEventDecide state command error event,
                         DomainEventEmptyState state)
        bound by the type signature for:
                   performPredicate :: forall state command error event.
                                       (DomainEventDecide state command error event,
                                        DomainEventEmptyState state) =>
                                       command
                                       -> InitialState event -> ExpectedEvents event -> IO ()
        at test/Utils/EventsourcingTestFramework.hs:27:1-164
      The type variable ‘error0’ is ambiguous
      These potential instances exist:
        instance (Show a, Show b) => Show (Either a b)
          -- Defined in ‘Data.Either’
        instance Show Ordering -- Defined in ‘GHC.Show’
        instance Show Integer -- Defined in ‘GHC.Show’
        ...plus 23 others
        ...plus 44 instances involving out-of-scope types
        (use -fprint-potential-instances to see them all)
    • In the expression:
        decide currentState cmd `shouldBe` Right expEvts
      In an equation for ‘performPredicate’:
          performPredicate cmd (IState evts) (ExpEvt expEvts)
            = decide currentState cmd `shouldBe` Right expEvts
            where
                currentState = actualState emptyState evts
   |
28 | performPredicate cmd (IState evts) (ExpEvt expEvts) = decide currentState cmd `shouldBe` Right expEvts
   |                                                       ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

/Users/ugobourdon/Dev/Projects/uno-server/test/Utils/EventsourcingTestFramework.hs:29:24: error:
    • Could not deduce (DomainEventApply state0 event)
        arising from a use of ‘actualState’
      from the context: (DomainEventDecide state command error event,
                         DomainEventEmptyState state)
        bound by the type signature for:
                   performPredicate :: forall state command error event.
                                       (DomainEventDecide state command error event,
                                        DomainEventEmptyState state) =>
                                       command
                                       -> InitialState event -> ExpectedEvents event -> IO ()
        at test/Utils/EventsourcingTestFramework.hs:27:1-164
      The type variable ‘state0’ is ambiguous
      Relevant bindings include
        currentState :: state0
          (bound at test/Utils/EventsourcingTestFramework.hs:29:9)
        expEvts :: [event]
          (bound at test/Utils/EventsourcingTestFramework.hs:28:44)
        evts :: [event]
          (bound at test/Utils/EventsourcingTestFramework.hs:28:30)
        performPredicate :: command
                            -> InitialState event -> ExpectedEvents event -> IO ()
          (bound at test/Utils/EventsourcingTestFramework.hs:28:1)
      These potential instance exist:
        one instance involving out-of-scope types
        (use -fprint-potential-instances to see them all)
    • In the expression: actualState emptyState evts
      In an equation for ‘currentState’:
          currentState = actualState emptyState evts
      In an equation for ‘performPredicate’:
          performPredicate cmd (IState evts) (ExpEvt expEvts)
            = decide currentState cmd `shouldBe` Right expEvts
            where
                currentState = actualState emptyState evts
   |
29 |   where currentState = actualState emptyState evts
   |                        ^^^^^^^^^^^^^^^^^^^^^^^^^^^

/Users/ugobourdon/Dev/Projects/uno-server/test/Utils/EventsourcingTestFramework.hs:29:36: error:
    • Could not deduce (DomainEventEmptyState state0)
        arising from a use of ‘emptyState’
      from the context: (DomainEventDecide state command error event,
                         DomainEventEmptyState state)
        bound by the type signature for:
                   performPredicate :: forall state command error event.
                                       (DomainEventDecide state command error event,
                                        DomainEventEmptyState state) =>
                                       command
                                       -> InitialState event -> ExpectedEvents event -> IO ()
        at test/Utils/EventsourcingTestFramework.hs:27:1-164
      The type variable ‘state0’ is ambiguous
      Relevant bindings include
        currentState :: state0
          (bound at test/Utils/EventsourcingTestFramework.hs:29:9)
      These potential instance exist:
        one instance involving out-of-scope types
        (use -fprint-potential-instances to see them all)
    • In the first argument of ‘actualState’, namely ‘emptyState’
      In the expression: actualState emptyState evts
      In an equation for ‘currentState’:
          currentState = actualState emptyState evts
   |
29 |   where currentState = actualState emptyState evts

Dernière erreur de compil en date :

  • Could not deduce (DomainEventEmptyState state1)
        arising from a use of ‘emptyState’
      from the context: DomainEventEmptyState state
        bound by the type signature for:
                   _When :: forall state command event.
                            DomainEventEmptyState state =>
                            command
                            -> InitialState event -> (state, command, InitialState event)
        at test/Utils/EventsourcingTestFramework.hs:19:1-109
      Possible fix:
        add (DomainEventEmptyState state1) to the context of
          an expression type signature:
            forall state1. state1
    • In the expression: emptyState :: state
      In the expression: (emptyState :: state, x, y)
      In an equation for ‘_When’: _When x y = (emptyState :: state, x, y)
   |
20 | _When x y = (emptyState :: state, x,y)

Cette implémentation marche grâce à l'extension FunctionalDependencies.