DFA.hs

import Data.List (find)

-- A state in a deterministic finite automaton.
data State a = State Accept (a -> State a) | Trap

-- Indicates whether a state is an accept state.
data Accept = Accept | Reject

-- Determines whether the implicit DFA starting at the given state recognizes
-- the given string.
accepts :: Eq a => State a -> [a] -> Bool
accepts (State Accept _) [] = True
accepts (State _ transition) (x:xs) = accepts (transition x) xs
accepts _ _ = False

-- Returns the state associated with the first list containing the given symbol.
transitions :: Eq a => [([a], State a)] -> a -> State a
transitions = flip $ \symbol -> maybe Trap snd . find (elem symbol . fst)

-- Start state of a DFA that recognizes strings representing unsigned decimal
-- numbers divisible by two or three.
divisibleByTwoOrThree :: State Char
divisibleByTwoOrThree = State Reject $ transitions [("0", leadingZero)
                                                   ,("369", divisibleByThree)
                                                   ,("4", oneModThreeEven)
                                                   ,("17", oneModThreeOdd)
                                                   ,("28", twoModThreeEven)
                                                   ,("5", twoModThreeOdd)]

-- First digit is zero. Further input is rejected.
leadingZero :: State Char
leadingZero = State Accept $ const Trap

-- Divisible by 3 because sum of digits is divisible by 3.
divisibleByThree :: State Char
divisibleByThree = State Accept $ transitions [("0369", divisibleByThree)
                                              ,("4", oneModThreeEven)
                                              ,("17", oneModThreeOdd)
                                              ,("28", twoModThreeEven)
                                              ,("5", twoModThreeOdd)]

-- Even number, sum of digits congruent to 1 modulo 3.
oneModThreeEven :: State Char
oneModThreeEven = State Accept $ transitions [("258", divisibleByThree)
                                             ,("06", oneModThreeEven)
                                             ,("39", oneModThreeOdd)
                                             ,("4", twoModThreeEven)
                                             ,("17", twoModThreeOdd)]

-- Odd number, sum of digits congruent to 1 modulo 3.
oneModThreeOdd :: State Char
oneModThreeOdd = State Reject $ transitions [("258", divisibleByThree)
                                            ,("06", oneModThreeEven)
                                            ,("39", oneModThreeOdd)
                                            ,("4", twoModThreeEven)
                                            ,("17", twoModThreeOdd)]

-- Even number, sum of digits congruent to 2 modulo 3.
twoModThreeEven :: State Char
twoModThreeEven = State Accept $ transitions [("147", divisibleByThree)
                                             ,("28", oneModThreeEven)
                                             ,("5", oneModThreeOdd)
                                             ,("06", twoModThreeEven)
                                             ,("39", twoModThreeOdd)]

-- Odd number, sum of digits congruent to 2 modulo 3.
twoModThreeOdd :: State Char
twoModThreeOdd = State Reject $ transitions [("147", divisibleByThree)
                                            ,("28", oneModThreeEven)
                                            ,("5", oneModThreeOdd)
                                            ,("06", twoModThreeEven)
                                            ,("39", twoModThreeOdd)]