quick NFA using a mock-monadic fold with Set instead of []

SetNFA.hs

import Data.Set (Set)
import qualified Data.Set as S

bindSet :: (Ord a, Ord b) => Set a -> (a -> Set b) -> Set b
bindSet s k = S.unions . S.toList $ S.map k s

foldSet :: (Ord a ) => (a -> b -> Set a) -> a -> [b] -> Set a
foldSet _ a [] = S.singleton a
foldSet f a (x:xs) = bindSet (f a x) (\fax -> foldSet f fax xs)

testNFA :: (Ord q) => NFA q s -> [s] -> Bool
testNFA (NFA i a t) = any a . S.toList . foldSet t i


data NFA q s = NFA
    { intialState :: q
    , isAccepting :: q -> Bool
    , transition  :: q -> s -> Set q
    }


data State  = Q1 | Q2 | Q3 | Q4 | Q5 deriving (Eq, Ord, Show)
data Symbol = A | B | C | D deriving (Eq, Ord, Show)

-- initial state
i = Q1

-- accept criteria
a = (`elem` [Q4,Q5])

-- state transitions
t Q1 A = S.fromList [Q2]
t Q2 A = S.fromList [Q3,Q4]
t Q2 B = S.fromList [Q1,Q2]
t Q2 C = S.fromList [Q3,Q4]
t Q3 D = S.fromList [Q5]
t Q4 A = S.fromList [Q2,Q4]
t _  _ = S.fromList []

nfa = NFA i a t