I'm trying to generalize one step of state machine computations by using sub-state machines.
Problem X is that I want some of the state machine functions to have different implementations based on some value A
, that is only known at runtime.
My current (not-working) solution is this:
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
module Lib
( someFunc
) where
import qualified Control.Monad.State as S
import Data.Kind (Type)
import GHC.Generics
newtype Key = Key { unKey :: Int }
data Created
data InProcess
data Processed
data First
data Second
class SMachine t m where
data SState t m s :: Type
createEntity :: Key -> m (SState t m Created)
processEntity :: SState t m Created -> m (SState t m Processed)
data EntityType = First | Second
type FakeState = S.State EntityType
instance SMachine First FakeState where
data SState First FakeState s where
Created1 :: { created1Key :: Key } -> SState First FakeState Created
Processed1 :: { processed1Key :: Key } -> SState First FakeState Processed
createEntity k = do
S.put First
return $ Created1 k
processEntity Created1 {..} = do
S.put First
return $ Processed1 created1Key
instance SMachine Second FakeState where
data SState Second FakeState s where
Created2 :: { created2Key :: Key } -> SState Second FakeState Created
Processed2 :: { processed2Key :: Key } -> SState Second FakeState Processed
createEntity k = do
S.put Second
return $ Created2 k
processEntity Created2 {..} = do
S.put Second
return $ Processed2 created2Key
data EntityState s where
Created :: { createdKey :: Key } -> EntityState Created
InProcess :: { inProcessKey :: Key } -> EntityState InProcess
Processed :: { processedKey :: Key } -> EntityState Processed
class MetaMachine m where
type State m :: Type -> Type
createNewEntity :: Key -> m (State m Created)
delegateEntity :: (SMachine t m) => State m Created -> (Key -> m (SState t m Created)) -> m (State m InProcess)
delegateEntity2 :: (SMachine t m) => State m InProcess -> (SState t m Created -> m (SState t m Processed)) -> m (State m Processed)
instance MetaMachine FakeState where
type State FakeState = EntityState
createNewEntity key = return $ Created key
delegateEntity Created {..} f = do
-- let's imagine that we saved it somewhere
delegatedEntity <- f createdKey
return $ InProcess createdKey
delegateEntity2 InProcess {..} f = do
-- let's imagine we retrieved stored entity
en <- S.get
delegatedEntity <- case en of
First -> return $ Created1 inProcessKey
Second -> return $ Created2 inProcessKey
f delegatedEntity
return $ Processed inProcessKey
The problem here is this part:
delegatedEntity <- case en of
First -> return $ Created1 inProcessKey
Second -> return $ Created2 inProcessKey
f delegatedEntity
GHC rightfully says:
Couldn't match type ‘Second’ with ‘First’
Expected type: S.StateT
EntityType
Data.Functor.Identity.Identity
(SState First FakeState Created)
Actual type: S.StateT
EntityType
Data.Functor.Identity.Identity
(SState Second FakeState Created)
• In the expression: return $ Created2 inProcessKey
In a case alternative: Second -> return $ Created2 inProcessKey
In a stmt of a 'do' block:
delegatedEntity <- case en of
First -> return $ Created1 inProcessKey
Second -> return $ Created2 inProcessKey
So, the question is: Can I fix this, somehow, or maybe there is a better solution?
Any help would be appreciated.