Как использовать индексированную монаду как FSM?

Question

Я пытаюсь создать простой конечный автомат, который изменяет состояние цвета, когда ввод действителен: Red -> Green -> Blue -> Red ...

Я хочу иметь возможность явно определять переходы между состояниями. После прочтения Что такое индексированная монада? и Стивена Дила Что я хочу знать , индексированная монада, кажется, то, что мне нужно. Пока у меня есть следующий код:

import Prelude hiding ( return )

newtype IState i o a = IState { runIState :: i -> (a, o) }

execIState :: IState i o a -> i -> o
execIState st i = snd $ runIState st i

return :: a -> IState s s a
return a = IState $ \s -> (a,s)

put :: o -> IState i o ()
put o = IState $ const ((), o)

data Red   = Red
data Green = Green
data Blue  = Blue

blueToRed :: IState Blue Red ()
blueToRed = put Red

redToGreen :: IState Red Green ()
redToGreen = put Green

greenToBlue :: IState Green Blue ()
greenToBlue = put Blue

newtype Color a = Color a

colorChange
  :: Color a
  -> Bool
  -> Color a
colorChange s@(Color c) valid = Color $ flip execIState c $ case s of
  (Color Red)   | valid -> redToGreen
  (Color Green) | valid -> greenToBlue
  (Color Blue)  | valid -> blueToRed
  _ -> return ()

Этот код выдает ошибку:

Couldn't match type `Blue' with `Green'
      Expected type: IState a Green ()
        Actual type: IState Green Blue ()
    * In the expression: greenToBlue
      In a case alternative: (Color Green) | valid -> greenToBlue
      In the second argument of `($)', namely
        `case s of
           (Color Red) | valid -> redToGreen
           (Color Green) | valid -> greenToBlue
           (Color Blue) | valid -> blueToRed
           _ -> return ()'
   |
39 |   (Color Green) | valid -> greenToBlue


Couldn't match type `Red' with `Green'
      Expected type: IState a Green ()
        Actual type: IState Blue Red ()
    * In the expression: blueToRed
      In a case alternative: (Color Blue) | valid -> blueToRed
      In the second argument of `($)', namely
        `case s of
           (Color Red) | valid -> redToGreen
           (Color Green) | valid -> greenToBlue
           (Color Blue) | valid -> blueToRed
           _ -> return ()'
   |
40 |   (Color Blue)  | valid -> blueToRed

Я понимаю, что типы Red, Green и Blue различны. Но ошибки не имеют смысла для меня, почему компилятор ожидает IState a Green (), когда greenToBlue :: IState Green Blue ()? Мне кажется, он ожидает, что все типы будут "соответствовать" первому case шаблону redToGreen. Как мне обойти это, чтобы создать мою функцию передачи состояния? Что такое индексированная монада? В посте использовались GADT, поэтому я подумал, что, возможно, это поможет, но я не смог заставить работать пример из этого поста, и раньше я не использовал GADT, просто прочитал о них.

Обратите внимание, что это очень просто для целей отладки и обучения, я планирую использовать это, когда сложность моих FSM возрастет.

Уточнение : Я хочу, чтобы компилятор выдавал ошибку, если функция передачи состояний не сохраняет структуру конечного автомата. Скажем, я определяю структуру конечного автомата как: Red -> Green -> Blue -> Red ... но если я случайно изменю свою функцию colorChange на Red -> Blue, компилятор должен выдать ошибку, поскольку это нарушает структуру конечного автомата, где Green должно следовать за Red.

Answer 1

Рекомендую, чтобы все было просто.

data Color = Red | Green | Blue

colorChange :: Color -> Bool -> Color
colorChange s     False = s
colorChange Red   _     = Green
colorChange Green _     = Blue
colorChange Blue  _     = Red