{-# LANGUAGE MultiWayIf #-}

-- |Module `TuringMachine.Admiter` include `admit` function for detecting if
--  input Turing machine admit input string.
module TuringMachine.Admiter (
    Depth,
    Action,
    admit,
    admit',
    module TuringMachine,
  ) where

import TuringMachine

import TuringMachine.Interpreter

type Depth = Maybe Int

type Action = SymbolOrMove

admit :: MonadFail m => TuringMachine -> Depth -> (String, Int) -> m [Action]
admit :: TuringMachine -> Depth -> (String, Int) -> m [Action]
admit TuringMachine
tm Depth
depth (String
strIni, Int
posIni) =
    TuringMachine -> Depth -> WorkingState -> m [Action]
forall (m :: * -> *).
MonadFail m =>
TuringMachine -> Depth -> WorkingState -> m [Action]
admit' TuringMachine
tm Depth
depth (String -> Int -> WorkingState
initWS String
strIni Int
posIni)

admit' :: MonadFail m => TuringMachine -> Depth -> WorkingState -> m [Action]
admit' :: TuringMachine -> Depth -> WorkingState -> m [Action]
admit' = [Action] -> TuringMachine -> Depth -> WorkingState -> m [Action]
forall b (m :: * -> *).
(Eq b, Num b, MonadFail m) =>
[Action] -> TuringMachine -> Maybe b -> WorkingState -> m [Action]
go []
  where
    go :: [Action] -> TuringMachine -> Maybe b -> WorkingState -> m [Action]
go [Action]
_ TuringMachine
_ (Just b
0) WorkingState
_ =
        String -> m [Action]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Analysis depth limit reached"
    go [Action]
res TuringMachine
tm Maybe b
depth WorkingState
ws  = do
        (((State
q, Symbol
s), (Action
sm, State
q')), WorkingState
ws') <- TuringMachine -> WorkingState -> m (Quadruple, WorkingState)
forall (m :: * -> *).
MonadFail m =>
TuringMachine -> WorkingState -> m (Quadruple, WorkingState)
step TuringMachine
tm WorkingState
ws
        if  | State
q' State -> State -> Bool
forall a. Eq a => a -> a -> Bool
== State
finalState ->
                [Action] -> m [Action]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Action] -> m [Action]) -> [Action] -> m [Action]
forall a b. (a -> b) -> a -> b
$ [Action] -> [Action]
forall a. [a] -> [a]
reverse [Action]
res
            | State
q State -> State -> Bool
forall a. Eq a => a -> a -> Bool
== State
q' Bool -> Bool -> Bool
&& Symbol -> Action
forall s. s -> MoveOr s
S Symbol
s Action -> Action -> Bool
forall a. Eq a => a -> a -> Bool
== Action
sm ->
                String -> m [Action]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Loop was found"
            | Bool
otherwise ->
                [Action] -> TuringMachine -> Maybe b -> WorkingState -> m [Action]
go (Action
sm Action -> [Action] -> [Action]
forall a. a -> [a] -> [a]
: [Action]
res) TuringMachine
tm (b -> b -> b
forall a. Num a => a -> a -> a
subtract b
1 (b -> b) -> Maybe b -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe b
depth) WorkingState
ws'