NfsmAccepts.hs

import Control.Error (runEitherT, left)
import Control.Monad (foldM)
import Control.Monad.Identity (runIdentity)
import qualified Data.Map.Strict as Map

type NFSM = Map.Map (Int, Char) [Int]

edges :: NFSM
edges = Map.fromList
    [ ((1, 'a'), [2, 3])
    , ((2, 'a'), [2])
    , ((3, 'b'), [4, 2])
    , ((4, 'c'), [5])
    ]

accepting :: [Int]
accepting = [5]

edges2 :: NFSM
edges2 = Map.fromList
    [ ((1, 'a'), [1])
    , ((2, 'a'), [2])
    ]

accepting2 :: [Int]
accepting2 = [2]

acceptEitherM :: Int -> NFSM -> [Int] -> [Int] -> Maybe String
acceptEitherM cur fsm done visited = either id id . runIdentity . runEitherT $
    foldM (\_ ((c, e), v) ->
      if c == cur then 
          foldM (\_ v' -> 
              case nfsmAccepts v' fsm done (c : visited) of
                  Just node -> left $ Just $ e : node
                  Nothing   -> return Nothing 
              ) Nothing v
      else return Nothing) Nothing (Map.toList fsm)

nfsmAccepts :: Int -> NFSM -> [Int] -> [Int] -> Maybe String
nfsmAccepts current fsm done visited
  | current `elem` visited = Nothing
  | current `elem` done = Just ""
  | otherwise = acceptEitherM current fsm done visited

main :: IO ()
main = do
  print $ "Test 1: " ++ show (nfsmAccepts 1 edges accepting [] == Just "abc")
  print $ "Test 2: " ++ show (nfsmAccepts 1 edges [4] [] == Just "ab")
  print $ "Test 3: " ++ show (nfsmAccepts 1 edges2 accepting2 [] == Nothing)
  print $ "Test 4: " ++ show (nfsmAccepts 1 edges2 [1] [] == Just "")