How can I encode and enforce legal FSM state transitions with a type system?

Question

Suppose I have a type Thing with a state property A | B | C,
and legal state transitions are A->B, A->C, C->A.

I could write:

transitionToA :: Thing -> Maybe Thing

which would return Nothing if Thing was in a state which cannot transition to A.

But I'd like to define my type, and the transition functions in such a way that transitions can only be called on appropriate types.

An option is to create separate types AThing BThing CThing but that doesn't seem maintainable in complex cases.

Another approach is to encode each state as it's own type:

data A = A Thing
data B = B Thing
data C = C Thing

and

transitionCToA :: C Thing -> A Thing

This seems cleaner to me. But it occurred to me that A,B,C are then functors where all of Things functions could be mapped except the transition functions.

With typeclasses I could create somthing like:

class ToA t where  
    toA :: t -> A Thing

Which seems cleaner still.

Are there other preferred approaches that would work in Haskell and PureScript?

Answer 1

Here's a fairly simple way that uses a (potentially phantom) type parameter to track which state a Thing is in:

{-# LANGUAGE DataKinds, KindSignatures #-}
-- note: not exporting the constructors of Thing
module Thing (Thing, transAB, transAC, transCA) where

data State = A | B | C
data Thing (s :: State) = {- elided; can even be a data family instead -}

transAB :: Thing A -> Thing B
transAC :: Thing A -> Thing C
transCA :: Thing C -> Thing A

transAB = {- elided -}
transAC = {- elided -}
transCA = {- elided -}

Answer 2

You could use a type class (available in PureScript) along with phantom types as John suggested, but using the type class as a final encoding of the type of paths:

data A -- States at the type level
data B
data C

class Path p where
  ab :: p A B -- One-step paths
  ac :: p A C
  ca :: p C A
  trans :: forall a b c. p c b -> p b a -> p c a -- Joining paths
  refl :: forall a. p a a

Now you can create a type of valid paths:

type ValidPath a b = forall p. (Path p) => p a b

roundTrip :: ValidPath A A
roundTrip = trans ca ac

Paths can only be constructed by using the one-step paths you provide.

You can write instances to use your paths, but importantly, any instance has to respect the valid transitions at the type level.

For example, here is an interpretation which calculates lengths of paths:

newtype Length = Length Int

instance pathLength :: Path Length where
  ab = Length 1
  ac = Length 1
  ca = Length 1
  trans (Length n) (Length m) = Length (n + m)
  refl = Length 0

Answer 3

Since your goal is to prevent developers from performing illegal transitions, you may want to look into phantom types. Phantom types allow you to model type-safe transitions without leveraging more advanced features of the type system; as such they are portable to many languages.

Here's a PureScript encoding of your above problem:

foreign import data A :: *
foreign import data B :: *
foreign import data C :: *

data Thing a = Thing

transitionToA :: Thing C -> Thing A

Phantom types work well to model valid state transitions when you have the property that two different states cannot transition to the same state (unless all states can transition to that state). You can workaround this limitation by using type classes (class CanTransitionToA a where trans :: Thing a -> Thing A), but at this point, you should investigate other approaches.

Answer 4

If you want to store a list of transitions so that you can process it later, you can do something like this:

{-# LANGUAGE DataKinds, GADTs, KindSignatures, PolyKinds #-}

data State = A | B | C
data Edge (a :: State) (b :: State) where
    EdgeAB :: Edge A B
    EdgeAC :: Edge A C
    EdgeCA :: Edge C A

data Domino (f :: k -> k -> *) (a :: k) (b :: k)  where
    I :: Domino f a a
    (:>>:) :: f a b -> Domino f b c -> Domino f a c

infixr :>>:

example :: Domino Edge A B
example = EdgeAC :>>: EdgeCA :>>: EdgeAB :>>: I

You can turn that into an instance of Path by writing a concatenation function for Domino:

{-# LANGUAGE FlexibleInstances #-}
instance Path (Domino Edge) where
    ab = EdgeAB :>>: I
    ac = EdgeAC :>>: I
    ca = EdgeCA :>>: I

    refl = I
    trans I es' = es'
    trans (e :>>: es) es' = e :>>: (es `trans` es')

In fact, this makes me wonder if Hackage already has a package that defines "indexed monoids":

class IMonoid (m :: k -> k -> *) where
    imempty :: m a a
    imappend :: m a b -> m b c -> m a c

instance IMonoid (Domino e) where
    imempty = I
    imappend I es' = es'
    imappend (e :>>: es) es' = e :>>: (es `imappend` es')