-- Copyright © 2013 Cameron White 
-- All rights reserved.
-- 
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions
-- are met:
-- 1. Redistributions of source code must retain the above copyright
--    notice, this list of conditions and the following disclaimer.
-- 2. Redistributions in binary form must reproduce the above copyright
--    notice, this list of conditions and the following disclaimer in the
--    documentation and/or other materials provided with the distribution.
-- 3. Neither the name of the project nor the names of its contributors
--    may be used to endorse or promote products derived from this software
--    without specific prior written permission.
-- 
-- THIS SOFTWARE IS PROVIDED BY THE PROJECT AND CONTRIBUTORS ``AS IS'' AND
-- ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-- ARE DISCLAIMED.  IN NO EVENT SHALL THE PROJECT OR CONTRIBUTORS BE LIABLE
-- FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
-- LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
-- OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
-- SUCH DAMAGE.
module NFA (NFA(NFA), states, symbols, delta, start,
           final, path, paths, accept) where

import Text.Printf (printf, IsChar)
import Data.Set (Set)
import qualified Data.Set as Set

data NFA q s = NFA {
    states  :: Set q,
    symbols :: Set s,
    delta   :: q -> s -> Set q,
    start   :: q,
    final   :: Set q
    }

instance (Show q, Show s) => Show (NFA q s) where
    show (NFA states symbols delta start final) =
        printf "(Q=%s,Σ=%s,δ=%s,q=%s,F=%s)"
            (show $ states') (show $ symbols') 
            (show relations) (show start) (show $ final')
            where relations = [(q, s, delta' q s)| q<-states', s<-symbols']
                  states' = Set.toList states
                  symbols' = Set.toList symbols
                  final' = Set.toList final
                  delta' q s = Set.toList $ delta q s

path :: Ord q => NFA q s -> [s] -> [q]
path nfa ss | null qss = []
            | otherwise = head qss
    where qss = paths nfa ss

paths :: Ord q => NFA q s -> [s] -> [[q]]
paths nfa ss = paths' nfa (start nfa) ss

paths' :: Ord q => NFA q s -> q -> [s] -> [[q]]
paths' nfa q [] =
    [Set.toList $ (Set.singleton q) `Set.intersection` (final nfa)]

paths' nfa q (s:ss) = map (q:) qss' 
    where q1s  = (delta nfa) q s;
          qss  = concatMap (\q1 -> paths' nfa q1 ss) (Set.toList q1s);
          qss' = filter (/=[]) qss;

accept :: Ord q => NFA q s -> [s] -> Bool
accept nfa ss = not . null $ paths nfa ss 
