[DFA] Deterministic Finite Automata in Haskell

DFA.hs

module DFA where

import Data.Maybe  (fromJust)

data Transition i a = Transition a (State i a)
                      deriving (Show, Read, Eq)

data State i a = State
                 { identifier     :: i
                 , isFinalState   :: Bool
                 , adjacentStates :: [Transition i a]
                 }
                 deriving (Show, Read, Eq)

-- transition to a state s by c
transition :: (Eq a) => State i a -> a -> Maybe (State i a)
transition (State _ _ []) c = Nothing
transition (State _ _ ((Transition c' s):ss)) c
    | c == c'   = Just s
    | otherwise = transition (State u u ss) c
    where u = undefined

-- check if a DFA accepts a word
accepts :: (Eq i, Eq a) => State i a -> [a] -> Bool
accepts (State _ True _) []  = True
accepts (State _ False _) [] = False
accepts s (c:cs)
    | s' == Nothing = False
    | otherwise     = accepts (fromJust s') cs
    where s' = s `transition` c

-- log transitions
logTransitions' :: (Show i, Show a, Eq i, Eq a) => State i a -> [a] -> IO ()
logTransitions' (State i True _) []  = putStrLn "Accepted"
logTransitions' (State i False _) [] = putStrLn "Failed, not a final state"
logTransitions' s (c:cs)
    | s' == Nothing = putStrLn $ "No possible transition by " ++ (show c)
    | otherwise     = do putStrLn $ "Transitioned by " ++ (show c) ++ " to state " ++ (show i)
                         logTransitions' s'' cs
    where s' = s `transition` c
          s''@(State i _ _) = fromJust s'

logTransitions :: (Show i, Show a, Eq i, Eq a) => State i a -> [a] -> IO ()
logTransitions s@(State i _ _) cs = do putStrLn $ "Started at state " ++ (show i)
                                       logTransitions' s cs

TestDFA.hs

import DFA

-- DFA for binary numbers divisible by 2
divisibleTwoDFA :: State String Char
divisibleTwoDFA = s0
    where s0 = State "s0" True  [Transition '0' s0, Transition '1' s1]
          s1 = State "s1" False [Transition '0' s0, Transition '1' s1]

-- DFA for a*b*
abDFA :: State String Char
abDFA = s0
    where s0 = State "s0" True [Transition 'a' s1, Transition 'b' s2]
          s1 = State "s1" True [Transition 'a' s1, Transition 'b' s2]
          s2 = State "s2" True [Transition 'b' s2]

-- DFA for (00*) + (11*)
zeroesOrOnesDFA :: State String Char
zeroesOrOnesDFA = s0
    where s0 = State "s0" False [Transition '0' s2, Transition '1' s1]
          s1 = State "s1" True  [Transition '0' s3, Transition '0' s1]
          s2 = State "s2" True  [Transition '0' s2, Transition '1' s3]
          s3 = State "s3" False [Transition '0' s3, Transition '1' s3]

-- DFA for (ba*) + (ab + ba)*
moreAsBsDFA :: State String Char
moreAsBsDFA = s0
    where s0 = State "s0" True  [Transition 'a' s5, Transition 'b' s1]
          s1 = State "s1" True  [Transition 'a' s2]
          s2 = State "s2" True  [Transition 'a' s3, Transition 'b' s7]
          s3 = State "s3" True  [Transition 'a' s4, Transition 'b' s6]
          s4 = State "s4" True  [Transition 'a' s4]
          s5 = State "s5" False [Transition 'b' s6]
          s6 = State "s6" True  [Transition 'a' s5, Transition 'b' s7]
          s7 = State "s7" False [Transition 'a' s6]