状态机的索引单子

Question

我决定尝试使用索引 monad 来创建类型安全的状态机。这意味着 Haskell 将拒绝编译非法状态转换。我的问题是。

我创建了一个 Door 类型并对其进行了操作。这是不可能的为它编写非法状态转换代码，例如它不能调用关闭已经关闭的门。这段代码工作正常但是我有一个问题：它可以更好吗？也许可以增强，扩展有用的东西等等
我尝试创建一个基于索引免费的 DSL monad 但我失败了。有人可以帮助我吗？

这是我的代码：

{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RebindableSyntax #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
import Control.Monad.Indexed
import Control.Monad.Indexed.Free
import Data.Coerce
import Language.Haskell.DoNotation
import Prelude hiding (Monad (..), pure)
import qualified Prelude (pure)

-- Handy Indexed container type borrowed from Sandy Maguire
newtype Indexed m i j a = Indexed { unsafeRunIndexed :: m a }
  deriving (Functor, Applicative, Monad)

instance Functor m => IxFunctor (Indexed m) where
  imap :: (a -> b) -> Indexed m i j a -> Indexed m i j b
  imap = fmap

instance Applicative m => IxPointed (Indexed m) where
  ireturn :: a -> Indexed m i i a
  ireturn = Prelude.pure

instance Applicative m => IxApplicative (Indexed m) where
  iap :: forall i j k a b. Indexed m i j (a -> b) -> Indexed m j k a -> Indexed m i k b
  iap = coerce $ (<*>) @m @a @b

instance Monad m => IxMonad (Indexed m) where
  ibind :: forall i j k a b. (a -> Indexed m j k b) -> Indexed m i j a -> Indexed m i k b
  ibind = coerce $ (=<<) @m @a @b

-- Door stuff
data DoorState = Opened | Closed deriving (Show, Eq, Ord)

newtype Door s (i :: DoorState) (j :: DoorState) a = Door
  { unsafeRunDoor :: Indexed IO i j a }
  deriving (IxFunctor, IxPointed, IxApplicative, IxMonad)

runDoor :: (forall s . Door s st1 st2 a) -> IO a
runDoor = coerce

class State (a :: DoorState) where
  state :: DoorState
instance State 'Opened where
  state = Opened
instance State 'Closed where
  state = Closed

stateM :: forall a m . (State a, Monad m) => m DoorState
stateM = return (state @a)

getState :: forall s st . State st => Door s st st DoorState
getState = coerce $ stateM @st @IO

openDoor :: Door s 'Closed 'Opened ()
openDoor = coerce $ putStrLn "open!"

closeDoor :: Door s 'Opened 'Closed ()
closeDoor = coerce $ putStrLn "close!"

ringBell :: Door s 'Closed 'Closed ()
ringBell = coerce $ putStrLn "ring!"
  
displayMessage :: String -> Door s st st ()
displayMessage = coerce . putStrLn

doorProgram :: Door s 'Closed 'Closed ()
doorProgram = do
  ringBell
  openDoor
  st <- getState
  displayMessage $ "State is: " ++ show st
  closeDoor

现在有问题的代码：

期望种类‘* -> * -> * -> *’，但‘DoorF’有种类‘DoorState -> DoorState -> * -> *’
‘IxFree’的第一个参数，即‘DoorF’
在类型‘IxFree DoorF’中
在“DoorDSL”的类型声明中

关于如何为 Door 创建免费的索引 monad DSL 有什么想法吗？

data DoorF (i :: DoorState) (j :: DoorState) next where
  Open    :: next -> DoorF 'Closed 'Opened next
  Close   :: next -> DoorF 'Opened 'Closed next
  Ring    :: next -> DoorF 'Closed 'Closed next
  Display :: String -> next -> DoorF st st next
  State   :: (DoorState -> next) -> DoorF st st next

instance Functor (DoorF i j) where
  fmap f (Open next) = Open (f next)
  fmap f (Close next) = Close (f next)
  fmap f (Ring next) = Ring (f next)
  fmap f (Display s next) = Display s (f next)
  fmap f (State nextF) = State (f . nextF)

instance IxFunctor DoorF where
  imap = fmap

type DoorDSL = IxFree DoorF

更新：夏丽瑶回答了我的问题。这是免费索引单子 DSL 的工作版本：

data Opened
data Closed

data DoorF i j next where
  Open    :: next -> DoorF Closed Opened next
  Close   :: next -> DoorF Opened Closed next
  Ring    :: next -> DoorF Closed Closed next
  Display :: String -> next -> DoorF st st next

instance Functor (DoorF i j) where
  fmap f (Open next) = Open (f next)
  fmap f (Close next) = Close (f next)
  fmap f (Ring next) = Ring (f next)
  fmap f (Display s next) = Display s (f next)

instance IxFunctor DoorF where
  imap = fmap

type DoorDSL = IxFree DoorF

open :: DoorDSL Closed Opened ()
open = Free (Open (Pure ()))

close :: DoorDSL Opened Closed ()
close = Free (Close (Pure ()))

ring :: DoorDSL Closed Closed ()
ring = Free (Ring (Pure ()))

display :: String -> DoorDSL st st ()
display msg = Free (Display msg (Pure ()))

Answer 1

错误是因为IxFree在可以泛化时是单态的。应修补 indexed-free 库以使用 PolyKinds.

同时，解决方法是将 DoorState 构造函数声明为它们自己的数据类型，而不是 DataKind：

-- Promoted DoorState without DataKind
type DoorState' = Type
data Opened
data Closed

状态机的索引单子

Indexed monads for state machines

monads

haskell

free-monad