{-# LANGUAGE TemplateHaskell, TupleSections, RankNTypes, TypeApplications, OverloadedStrings #-}

-- |Module `TuringMachine` include type of Turing machine and useful objects
--  for working with it. This module also export other useful modules.
module TuringMachine (
    LabeledStates,
    Alphabet,
    TuringMachine,
    turingMachine,
    quadruples,
    labeledStates,
    alphabet,
    TMGetter,
    TMSetter,
    states,
    symbols,
    allStates,
    allSymbols,
    strQuadruples,
    strLabeledStates,
    strSymbols,
    strNumStates,
    strNumSymbols,
    maxNumState,
    maxNumSymbol,
    module TuringMachine.Quadruple,
    module Containers,
    module Lens,
  ) where

import TuringMachine.Quadruple
import Containers hiding (Quadruple)
import Lens

import Control.Applicative (liftA2, liftA3)
import Data.Maybe (catMaybes)
import GHC.Generics ((:.:)(Comp1, unComp1))

type LabeledStates = PrismMap String State

type Alphabet = IsoMap ShowedSymbol Symbol

data TuringMachine = TM
  { TuringMachine -> Quadruples
_quadruples :: Quadruples
  , TuringMachine -> LabeledStates
_labeledStates :: LabeledStates
  , TuringMachine -> Alphabet
_alphabet :: Alphabet
  } deriving (TuringMachine -> TuringMachine -> Bool
(TuringMachine -> TuringMachine -> Bool)
-> (TuringMachine -> TuringMachine -> Bool) -> Eq TuringMachine
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TuringMachine -> TuringMachine -> Bool
$c/= :: TuringMachine -> TuringMachine -> Bool
== :: TuringMachine -> TuringMachine -> Bool
$c== :: TuringMachine -> TuringMachine -> Bool
Eq)

turingMachine :: Quadruples -> LabeledStates -> Alphabet -> TuringMachine
turingMachine :: Quadruples -> LabeledStates -> Alphabet -> TuringMachine
turingMachine = Quadruples -> LabeledStates -> Alphabet -> TuringMachine
TM

makeLenses ''TuringMachine

maybe' :: (a -> Maybe b) -> (a -> b) -> a -> b
maybe' :: (a -> Maybe b) -> (a -> b) -> a -> b
maybe' a -> Maybe b
f a -> b
g a
x =
    case a -> Maybe b
f a
x of
        Maybe b
Nothing -> a -> b
g a
x
        Just b
y  -> b
y

instance Show TuringMachine where
    show :: TuringMachine -> String
show TuringMachine
tm =
        ((((State, Symbol), (SymbolOrMove, State)) -> String)
 -> [((State, Symbol), (SymbolOrMove, State))] -> String)
-> [((State, Symbol), (SymbolOrMove, State))]
-> (((State, Symbol), (SymbolOrMove, State)) -> String)
-> String
forall a b c. (a -> b -> c) -> b -> a -> c
flip (((State, Symbol), (SymbolOrMove, State)) -> String)
-> [((State, Symbol), (SymbolOrMove, State))] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (TuringMachine
tmTuringMachine
-> Getting
     [((State, Symbol), (SymbolOrMove, State))]
     TuringMachine
     [((State, Symbol), (SymbolOrMove, State))]
-> [((State, Symbol), (SymbolOrMove, State))]
forall s a. s -> Getting a s a -> a
^.(Quadruples
 -> Const [((State, Symbol), (SymbolOrMove, State))] Quadruples)
-> TuringMachine
-> Const [((State, Symbol), (SymbolOrMove, State))] TuringMachine
Lens' TuringMachine Quadruples
quadruples((Quadruples
  -> Const [((State, Symbol), (SymbolOrMove, State))] Quadruples)
 -> TuringMachine
 -> Const [((State, Symbol), (SymbolOrMove, State))] TuringMachine)
-> (([((State, Symbol), (SymbolOrMove, State))]
     -> Const
          [((State, Symbol), (SymbolOrMove, State))]
          [((State, Symbol), (SymbolOrMove, State))])
    -> Quadruples
    -> Const [((State, Symbol), (SymbolOrMove, State))] Quadruples)
-> Getting
     [((State, Symbol), (SymbolOrMove, State))]
     TuringMachine
     [((State, Symbol), (SymbolOrMove, State))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Quadruples -> [((State, Symbol), (SymbolOrMove, State))])
-> ([((State, Symbol), (SymbolOrMove, State))]
    -> Const
         [((State, Symbol), (SymbolOrMove, State))]
         [((State, Symbol), (SymbolOrMove, State))])
-> Quadruples
-> Const [((State, Symbol), (SymbolOrMove, State))] Quadruples
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Quadruples -> [((State, Symbol), (SymbolOrMove, State))]
forall c v. Listable c v => c -> [v]
toList) ((((State, Symbol), (SymbolOrMove, State)) -> String) -> String)
-> (((State, Symbol), (SymbolOrMove, State)) -> String) -> String
forall a b. (a -> b) -> a -> b
$
            \((State
q1, Symbol
s), (SymbolOrMove
sm, State
q2)) ->
                let q1' :: String
q1' =
                        (State -> Maybe String) -> (State -> String) -> State -> String
forall a b. (a -> Maybe b) -> (a -> b) -> a -> b
maybe'
                            ((TuringMachine
tmTuringMachine
-> Getting LabeledStates TuringMachine LabeledStates
-> LabeledStates
forall s a. s -> Getting a s a -> a
^.Getting LabeledStates TuringMachine LabeledStates
Lens' TuringMachine LabeledStates
labeledStates) LabeledStates -> State -> Maybe String
forall c k v (m :: * -> *).
(Indexable c k v, MonadFail m) =>
c -> k -> m v
!?)
                            (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (State -> Int) -> State -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> Int
numState)
                            State
q1
                    s' :: String
s'  = ShowedSymbol -> String
forall a. Show a => a -> String
show (ShowedSymbol -> String) -> ShowedSymbol -> String
forall a b. (a -> b) -> a -> b
$
                        (Symbol -> Maybe ShowedSymbol)
-> (Symbol -> ShowedSymbol) -> Symbol -> ShowedSymbol
forall a b. (a -> Maybe b) -> (a -> b) -> a -> b
maybe'
                            ((TuringMachine
tmTuringMachine
-> Getting Alphabet TuringMachine Alphabet -> Alphabet
forall s a. s -> Getting a s a -> a
^.Getting Alphabet TuringMachine Alphabet
Lens' TuringMachine Alphabet
alphabet) Alphabet -> Symbol -> Maybe ShowedSymbol
forall c k v (m :: * -> *).
(Indexable c k v, MonadFail m) =>
c -> k -> m v
!?)
                            (ShowedSymbol -> Symbol -> ShowedSymbol
forall a b. a -> b -> a
const ShowedSymbol
"?")
                            Symbol
s
                    sm' :: String
sm' = case SymbolOrMove
sm of
                        S s_ -> ShowedSymbol -> String
forall a. Show a => a -> String
show (ShowedSymbol -> String) -> ShowedSymbol -> String
forall a b. (a -> b) -> a -> b
$
                            (Symbol -> Maybe ShowedSymbol)
-> (Symbol -> ShowedSymbol) -> Symbol -> ShowedSymbol
forall a b. (a -> Maybe b) -> (a -> b) -> a -> b
maybe'
                                ((TuringMachine
tmTuringMachine
-> Getting Alphabet TuringMachine Alphabet -> Alphabet
forall s a. s -> Getting a s a -> a
^.Getting Alphabet TuringMachine Alphabet
Lens' TuringMachine Alphabet
alphabet) Alphabet -> Symbol -> Maybe ShowedSymbol
forall c k v (m :: * -> *).
(Indexable c k v, MonadFail m) =>
c -> k -> m v
!?)
                                (ShowedSymbol -> Symbol -> ShowedSymbol
forall a b. a -> b -> a
const ShowedSymbol
"?")
                                Symbol
s_
                        M m  -> Move -> String
forall a. Show a => a -> String
show Move
m
                    q2' :: String
q2' =
                        (State -> Maybe String) -> (State -> String) -> State -> String
forall a b. (a -> Maybe b) -> (a -> b) -> a -> b
maybe'
                            ((TuringMachine
tmTuringMachine
-> Getting LabeledStates TuringMachine LabeledStates
-> LabeledStates
forall s a. s -> Getting a s a -> a
^.Getting LabeledStates TuringMachine LabeledStates
Lens' TuringMachine LabeledStates
labeledStates) LabeledStates -> State -> Maybe String
forall c k v (m :: * -> *).
(Indexable c k v, MonadFail m) =>
c -> k -> m v
!?)
                            (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (State -> Int) -> State -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> Int
numState)
                            State
q2
                in  Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
q1') Char
' ' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
q1' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                    String
s'  String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s')  Char
' ' String -> ShowS
forall a. [a] -> [a] -> [a]
++
                    String
sm' String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
sm') Char
' ' String -> ShowS
forall a. [a] -> [a] -> [a]
++
                    String
q2' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"

type TMGetter a = Getter TuringMachine a

type TMSetter a b = Setter TuringMachine TuringMachine a b

traverseMaybe :: Applicative f => (a -> f (Maybe b)) -> [a] -> f [b]
traverseMaybe :: (a -> f (Maybe b)) -> [a] -> f [b]
traverseMaybe a -> f (Maybe b)
f = ([Maybe b] -> [b]) -> f [Maybe b] -> f [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe b] -> [b]
forall a. [Maybe a] -> [a]
catMaybes (f [Maybe b] -> f [b]) -> ([a] -> f [Maybe b]) -> [a] -> f [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f (Maybe b)) -> [a] -> f [Maybe b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f (Maybe b)
f

states :: TMSetter State (Maybe State)
states :: (State -> f (Maybe State)) -> TuringMachine -> f TuringMachine
states State -> f (Maybe State)
f TuringMachine
tm =
    (Quadruples -> LabeledStates -> Alphabet -> TuringMachine)
-> f Quadruples -> f LabeledStates -> f Alphabet -> f TuringMachine
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 Quadruples -> LabeledStates -> Alphabet -> TuringMachine
turingMachine
        (TuringMachine
tmTuringMachine
-> Getting Quadruples TuringMachine Quadruples -> Quadruples
forall s a. s -> Getting a s a -> a
^.Getting Quadruples TuringMachine Quadruples
Lens' TuringMachine Quadruples
quadruples    Quadruples -> (Quadruples -> f Quadruples) -> f Quadruples
forall a b. a -> (a -> b) -> b
& ([((State, Symbol), (SymbolOrMove, State))] -> Quadruples)
-> f [((State, Symbol), (SymbolOrMove, State))] -> f Quadruples
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [((State, Symbol), (SymbolOrMove, State))] -> Quadruples
forall c v. UnsafeListable c v => [v] -> c
fromList (f [((State, Symbol), (SymbolOrMove, State))] -> f Quadruples)
-> (Quadruples -> f [((State, Symbol), (SymbolOrMove, State))])
-> Quadruples
-> f Quadruples
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((State, Symbol), (SymbolOrMove, State))
 -> f (Maybe ((State, Symbol), (SymbolOrMove, State))))
-> [((State, Symbol), (SymbolOrMove, State))]
-> f [((State, Symbol), (SymbolOrMove, State))]
forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> [a] -> f [b]
traverseMaybe ((State, Symbol), (SymbolOrMove, State))
-> f (Maybe ((State, Symbol), (SymbolOrMove, State)))
forall t t.
((State, t), (t, State)) -> f (Maybe ((State, t), (t, State)))
updQ  ([((State, Symbol), (SymbolOrMove, State))]
 -> f [((State, Symbol), (SymbolOrMove, State))])
-> (Quadruples -> [((State, Symbol), (SymbolOrMove, State))])
-> Quadruples
-> f [((State, Symbol), (SymbolOrMove, State))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Quadruples -> [((State, Symbol), (SymbolOrMove, State))]
forall c v. Listable c v => c -> [v]
toList)
        (TuringMachine
tmTuringMachine
-> Getting LabeledStates TuringMachine LabeledStates
-> LabeledStates
forall s a. s -> Getting a s a -> a
^.Getting LabeledStates TuringMachine LabeledStates
Lens' TuringMachine LabeledStates
labeledStates LabeledStates
-> (LabeledStates -> f LabeledStates) -> f LabeledStates
forall a b. a -> (a -> b) -> b
& ([(String, State)] -> LabeledStates)
-> f [(String, State)] -> f LabeledStates
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(String, State)] -> LabeledStates
forall c v. UnsafeListable c v => [v] -> c
fromList (f [(String, State)] -> f LabeledStates)
-> (LabeledStates -> f [(String, State)])
-> LabeledStates
-> f LabeledStates
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, State) -> f (Maybe (String, State)))
-> [(String, State)] -> f [(String, State)]
forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> [a] -> f [b]
traverseMaybe (String, State) -> f (Maybe (String, State))
updLS ([(String, State)] -> f [(String, State)])
-> (LabeledStates -> [(String, State)])
-> LabeledStates
-> f [(String, State)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LabeledStates -> [(String, State)]
forall c v. Listable c v => c -> [v]
toList)
        (TuringMachine
tmTuringMachine
-> Getting Alphabet TuringMachine Alphabet -> Alphabet
forall s a. s -> Getting a s a -> a
^.Getting Alphabet TuringMachine Alphabet
Lens' TuringMachine Alphabet
alphabet      Alphabet -> (Alphabet -> f Alphabet) -> f Alphabet
forall a b. a -> (a -> b) -> b
& Alphabet -> f Alphabet
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
          where
            f' :: State -> (:.:) f Maybe State
f' = f (Maybe State) -> (:.:) f Maybe State
forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1 (f (Maybe State) -> (:.:) f Maybe State)
-> (State -> f (Maybe State)) -> State -> (:.:) f Maybe State
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> State -> f (Maybe State)
f
            updQ :: ((State, t), (t, State)) -> f (Maybe ((State, t), (t, State)))
updQ ((State
qf, t
s), (t
sm, State
qt)) = 
                (:.:) f Maybe ((State, t), (t, State))
-> f (Maybe ((State, t), (t, State)))
forall k2 (f :: k2 -> *) k1 (g :: k1 -> k2) (p :: k1).
(:.:) f g p -> f (g p)
unComp1 ((:.:) f Maybe ((State, t), (t, State))
 -> f (Maybe ((State, t), (t, State))))
-> (:.:) f Maybe ((State, t), (t, State))
-> f (Maybe ((State, t), (t, State)))
forall a b. (a -> b) -> a -> b
$ ((State, t) -> (t, State) -> ((State, t), (t, State)))
-> (:.:) f Maybe (State, t)
-> (:.:) f Maybe (t, State)
-> (:.:) f Maybe ((State, t), (t, State))
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) ((,t
s) (State -> (State, t))
-> (:.:) f Maybe State -> (:.:) f Maybe (State, t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> State -> (:.:) f Maybe State
f' State
qf) ((t
sm,) (State -> (t, State))
-> (:.:) f Maybe State -> (:.:) f Maybe (t, State)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> State -> (:.:) f Maybe State
f' State
qt)
            updLS :: (String, State) -> f (Maybe (String, State))
updLS = (:.:) f Maybe (String, State) -> f (Maybe (String, State))
forall k2 (f :: k2 -> *) k1 (g :: k1 -> k2) (p :: k1).
(:.:) f g p -> f (g p)
unComp1 ((:.:) f Maybe (String, State) -> f (Maybe (String, State)))
-> ((String, State) -> (:.:) f Maybe (String, State))
-> (String, State)
-> f (Maybe (String, State))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State -> (:.:) f Maybe State)
-> (String, State) -> (:.:) f Maybe (String, State)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse State -> (:.:) f Maybe State
f'

symbols :: TMSetter Symbol (Maybe Symbol)
symbols :: (Symbol -> f (Maybe Symbol)) -> TuringMachine -> f TuringMachine
symbols Symbol -> f (Maybe Symbol)
f TuringMachine
tm =
    (Quadruples -> LabeledStates -> Alphabet -> TuringMachine)
-> f Quadruples -> f LabeledStates -> f Alphabet -> f TuringMachine
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 Quadruples -> LabeledStates -> Alphabet -> TuringMachine
turingMachine
        (TuringMachine
tmTuringMachine
-> Getting Quadruples TuringMachine Quadruples -> Quadruples
forall s a. s -> Getting a s a -> a
^.Getting Quadruples TuringMachine Quadruples
Lens' TuringMachine Quadruples
quadruples    Quadruples -> (Quadruples -> f Quadruples) -> f Quadruples
forall a b. a -> (a -> b) -> b
& ([((State, Symbol), (SymbolOrMove, State))] -> Quadruples)
-> f [((State, Symbol), (SymbolOrMove, State))] -> f Quadruples
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [((State, Symbol), (SymbolOrMove, State))] -> Quadruples
forall c v. UnsafeListable c v => [v] -> c
fromList (f [((State, Symbol), (SymbolOrMove, State))] -> f Quadruples)
-> (Quadruples -> f [((State, Symbol), (SymbolOrMove, State))])
-> Quadruples
-> f Quadruples
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((State, Symbol), (SymbolOrMove, State))
 -> f (Maybe ((State, Symbol), (SymbolOrMove, State))))
-> [((State, Symbol), (SymbolOrMove, State))]
-> f [((State, Symbol), (SymbolOrMove, State))]
forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> [a] -> f [b]
traverseMaybe ((State, Symbol), (SymbolOrMove, State))
-> f (Maybe ((State, Symbol), (SymbolOrMove, State)))
forall t t.
((t, Symbol), (SymbolOrMove, t))
-> f (Maybe ((t, Symbol), (SymbolOrMove, t)))
updQ ([((State, Symbol), (SymbolOrMove, State))]
 -> f [((State, Symbol), (SymbolOrMove, State))])
-> (Quadruples -> [((State, Symbol), (SymbolOrMove, State))])
-> Quadruples
-> f [((State, Symbol), (SymbolOrMove, State))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Quadruples -> [((State, Symbol), (SymbolOrMove, State))]
forall c v. Listable c v => c -> [v]
toList)
        (TuringMachine
tmTuringMachine
-> Getting LabeledStates TuringMachine LabeledStates
-> LabeledStates
forall s a. s -> Getting a s a -> a
^.Getting LabeledStates TuringMachine LabeledStates
Lens' TuringMachine LabeledStates
labeledStates LabeledStates
-> (LabeledStates -> f LabeledStates) -> f LabeledStates
forall a b. a -> (a -> b) -> b
& LabeledStates -> f LabeledStates
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
        (TuringMachine
tmTuringMachine
-> Getting Alphabet TuringMachine Alphabet -> Alphabet
forall s a. s -> Getting a s a -> a
^.Getting Alphabet TuringMachine Alphabet
Lens' TuringMachine Alphabet
alphabet      Alphabet -> (Alphabet -> f Alphabet) -> f Alphabet
forall a b. a -> (a -> b) -> b
& ([(ShowedSymbol, Symbol)] -> Alphabet)
-> f [(ShowedSymbol, Symbol)] -> f Alphabet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(ShowedSymbol, Symbol)] -> Alphabet
forall c v. UnsafeListable c v => [v] -> c
fromList (f [(ShowedSymbol, Symbol)] -> f Alphabet)
-> (Alphabet -> f [(ShowedSymbol, Symbol)])
-> Alphabet
-> f Alphabet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ShowedSymbol, Symbol) -> f (Maybe (ShowedSymbol, Symbol)))
-> [(ShowedSymbol, Symbol)] -> f [(ShowedSymbol, Symbol)]
forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> [a] -> f [b]
traverseMaybe (ShowedSymbol, Symbol) -> f (Maybe (ShowedSymbol, Symbol))
updA ([(ShowedSymbol, Symbol)] -> f [(ShowedSymbol, Symbol)])
-> (Alphabet -> [(ShowedSymbol, Symbol)])
-> Alphabet
-> f [(ShowedSymbol, Symbol)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alphabet -> [(ShowedSymbol, Symbol)]
forall c v. Listable c v => c -> [v]
toList)
      where
        f' :: Symbol -> (:.:) f Maybe Symbol
f' = f (Maybe Symbol) -> (:.:) f Maybe Symbol
forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1 (f (Maybe Symbol) -> (:.:) f Maybe Symbol)
-> (Symbol -> f (Maybe Symbol)) -> Symbol -> (:.:) f Maybe Symbol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Symbol -> f (Maybe Symbol)
f
        updQ :: ((t, Symbol), (SymbolOrMove, t))
-> f (Maybe ((t, Symbol), (SymbolOrMove, t)))
updQ ((t
qf, Symbol
s), (m :: SymbolOrMove
m@(M Move
_), t
qt)) =
            (:.:) f Maybe ((t, Symbol), (SymbolOrMove, t))
-> f (Maybe ((t, Symbol), (SymbolOrMove, t)))
forall k2 (f :: k2 -> *) k1 (g :: k1 -> k2) (p :: k1).
(:.:) f g p -> f (g p)
unComp1 ((:.:) f Maybe ((t, Symbol), (SymbolOrMove, t))
 -> f (Maybe ((t, Symbol), (SymbolOrMove, t))))
-> (:.:) f Maybe ((t, Symbol), (SymbolOrMove, t))
-> f (Maybe ((t, Symbol), (SymbolOrMove, t)))
forall a b. (a -> b) -> a -> b
$ (,(SymbolOrMove
m, t
qt)) ((t, Symbol) -> ((t, Symbol), (SymbolOrMove, t)))
-> (Symbol -> (t, Symbol))
-> Symbol
-> ((t, Symbol), (SymbolOrMove, t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (t
qf,) (Symbol -> ((t, Symbol), (SymbolOrMove, t)))
-> (:.:) f Maybe Symbol
-> (:.:) f Maybe ((t, Symbol), (SymbolOrMove, t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Symbol -> (:.:) f Maybe Symbol
f' Symbol
s
        updQ ((t
qf, Symbol
s), (S Symbol
s', t
qt)) =
            (:.:) f Maybe ((t, Symbol), (SymbolOrMove, t))
-> f (Maybe ((t, Symbol), (SymbolOrMove, t)))
forall k2 (f :: k2 -> *) k1 (g :: k1 -> k2) (p :: k1).
(:.:) f g p -> f (g p)
unComp1 ((:.:) f Maybe ((t, Symbol), (SymbolOrMove, t))
 -> f (Maybe ((t, Symbol), (SymbolOrMove, t))))
-> (:.:) f Maybe ((t, Symbol), (SymbolOrMove, t))
-> f (Maybe ((t, Symbol), (SymbolOrMove, t)))
forall a b. (a -> b) -> a -> b
$ ((t, Symbol)
 -> (SymbolOrMove, t) -> ((t, Symbol), (SymbolOrMove, t)))
-> (:.:) f Maybe (t, Symbol)
-> (:.:) f Maybe (SymbolOrMove, t)
-> (:.:) f Maybe ((t, Symbol), (SymbolOrMove, t))
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) ((t
qf,) (Symbol -> (t, Symbol))
-> (:.:) f Maybe Symbol -> (:.:) f Maybe (t, Symbol)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Symbol -> (:.:) f Maybe Symbol
f' Symbol
s) ((,t
qt) (SymbolOrMove -> (SymbolOrMove, t))
-> (Symbol -> SymbolOrMove) -> Symbol -> (SymbolOrMove, t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Symbol -> SymbolOrMove
forall s. s -> MoveOr s
S (Symbol -> (SymbolOrMove, t))
-> (:.:) f Maybe Symbol -> (:.:) f Maybe (SymbolOrMove, t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Symbol -> (:.:) f Maybe Symbol
f' Symbol
s')
        updA :: (ShowedSymbol, Symbol) -> f (Maybe (ShowedSymbol, Symbol))
updA = (:.:) f Maybe (ShowedSymbol, Symbol)
-> f (Maybe (ShowedSymbol, Symbol))
forall k2 (f :: k2 -> *) k1 (g :: k1 -> k2) (p :: k1).
(:.:) f g p -> f (g p)
unComp1 ((:.:) f Maybe (ShowedSymbol, Symbol)
 -> f (Maybe (ShowedSymbol, Symbol)))
-> ((ShowedSymbol, Symbol) -> (:.:) f Maybe (ShowedSymbol, Symbol))
-> (ShowedSymbol, Symbol)
-> f (Maybe (ShowedSymbol, Symbol))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Symbol -> (:.:) f Maybe Symbol)
-> (ShowedSymbol, Symbol) -> (:.:) f Maybe (ShowedSymbol, Symbol)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Symbol -> (:.:) f Maybe Symbol
f'

allStates :: TMGetter (Set State)
allStates :: (Set State -> f (Set State)) -> TuringMachine -> f TuringMachine
allStates = (TuringMachine -> Set State)
-> (Set State -> f (Set State)) -> TuringMachine -> f TuringMachine
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ((TuringMachine -> Set State)
 -> (Set State -> f (Set State))
 -> TuringMachine
 -> f TuringMachine)
-> (TuringMachine -> Set State)
-> (Set State -> f (Set State))
-> TuringMachine
-> f TuringMachine
forall a b. (a -> b) -> a -> b
$ do
    Quadruples
qs <- Getting Quadruples TuringMachine Quadruples
-> TuringMachine -> Quadruples
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Quadruples TuringMachine Quadruples
Lens' TuringMachine Quadruples
quadruples
    LabeledStates
ls <- Getting LabeledStates TuringMachine LabeledStates
-> TuringMachine -> LabeledStates
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting LabeledStates TuringMachine LabeledStates
Lens' TuringMachine LabeledStates
labeledStates
    let statesFromLS :: Set State
statesFromLS = LabeledStates -> Set State
forall c v. (Valuable c v, Ord v) => c -> Set v
valuesSet LabeledStates
ls
        statesFromQ :: ((v, b), (a, v)) -> c
statesFromQ ((v
qf, b
_), (a
_, v
qt)) = [v] -> c
forall c v. UnsafeListable c v => [v] -> c
fromList [v
qf, v
qt]
    Set State -> TuringMachine -> Set State
forall (m :: * -> *) a. Monad m => a -> m a
return (Set State -> TuringMachine -> Set State)
-> Set State -> TuringMachine -> Set State
forall a b. (a -> b) -> a -> b
$ (Set State -> Set State -> Set State)
-> Set State -> [Set State] -> Set State
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Set State -> Set State -> Set State
forall c. Operable c => c -> c -> c
(\/) Set State
statesFromLS ([Set State] -> Set State) -> [Set State] -> Set State
forall a b. (a -> b) -> a -> b
$ ((State, Symbol), (SymbolOrMove, State)) -> Set State
forall c v b a. UnsafeListable c v => ((v, b), (a, v)) -> c
statesFromQ (((State, Symbol), (SymbolOrMove, State)) -> Set State)
-> [((State, Symbol), (SymbolOrMove, State))] -> [Set State]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Quadruples -> [((State, Symbol), (SymbolOrMove, State))]
forall c v. Listable c v => c -> [v]
toList Quadruples
qs

allSymbols :: TMGetter (Set Symbol)
allSymbols :: (Set Symbol -> f (Set Symbol)) -> TuringMachine -> f TuringMachine
allSymbols = (TuringMachine -> Set Symbol)
-> (Set Symbol -> f (Set Symbol))
-> TuringMachine
-> f TuringMachine
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ((TuringMachine -> Set Symbol)
 -> (Set Symbol -> f (Set Symbol))
 -> TuringMachine
 -> f TuringMachine)
-> (TuringMachine -> Set Symbol)
-> (Set Symbol -> f (Set Symbol))
-> TuringMachine
-> f TuringMachine
forall a b. (a -> b) -> a -> b
$ do
    Quadruples
qs <- Getting Quadruples TuringMachine Quadruples
-> TuringMachine -> Quadruples
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Quadruples TuringMachine Quadruples
Lens' TuringMachine Quadruples
quadruples
    Alphabet
a  <- Getting Alphabet TuringMachine Alphabet
-> TuringMachine -> Alphabet
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Alphabet TuringMachine Alphabet
Lens' TuringMachine Alphabet
alphabet
    let symbolsFromA :: Set Symbol
symbolsFromA = Alphabet -> Set Symbol
forall c v. (Valuable c v, Ord v) => c -> Set v
valuesSet Alphabet
a
        symbolsFromQ :: ((a, Symbol), (SymbolOrMove, b)) -> Set Symbol
symbolsFromQ ((a
_, Symbol
s), (SymbolOrMove
sm, b
_)) =
            forall v. UnsafeListable (Set Symbol) v => [v] -> Set Symbol
forall c v. UnsafeListable c v => [v] -> c
fromList @(Set Symbol) ([Symbol] -> Set Symbol) -> [Symbol] -> Set Symbol
forall a b. (a -> b) -> a -> b
$
                case SymbolOrMove
sm of
                    M Move
_  -> [Symbol
s]
                    S Symbol
s' -> [Symbol
s, Symbol
s']
    Set Symbol -> TuringMachine -> Set Symbol
forall (m :: * -> *) a. Monad m => a -> m a
return (Set Symbol -> TuringMachine -> Set Symbol)
-> Set Symbol -> TuringMachine -> Set Symbol
forall a b. (a -> b) -> a -> b
$ (Set Symbol -> Set Symbol -> Set Symbol)
-> Set Symbol -> [Set Symbol] -> Set Symbol
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Set Symbol -> Set Symbol -> Set Symbol
forall c. Operable c => c -> c -> c
(\/) Set Symbol
symbolsFromA ([Set Symbol] -> Set Symbol) -> [Set Symbol] -> Set Symbol
forall a b. (a -> b) -> a -> b
$ ((State, Symbol), (SymbolOrMove, State)) -> Set Symbol
forall a b. ((a, Symbol), (SymbolOrMove, b)) -> Set Symbol
symbolsFromQ (((State, Symbol), (SymbolOrMove, State)) -> Set Symbol)
-> [((State, Symbol), (SymbolOrMove, State))] -> [Set Symbol]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Quadruples -> [((State, Symbol), (SymbolOrMove, State))]
forall c v. Listable c v => c -> [v]
toList Quadruples
qs

strQuadruples :: TMGetter (Set StrQuadruple)
strQuadruples :: (Set StrQuadruple -> f (Set StrQuadruple))
-> TuringMachine -> f TuringMachine
strQuadruples = (Quadruples -> f Quadruples) -> TuringMachine -> f TuringMachine
Lens' TuringMachine Quadruples
quadruples ((Quadruples -> f Quadruples) -> TuringMachine -> f TuringMachine)
-> ((Set StrQuadruple -> f (Set StrQuadruple))
    -> Quadruples -> f Quadruples)
-> (Set StrQuadruple -> f (Set StrQuadruple))
-> TuringMachine
-> f TuringMachine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Quadruples -> Set StrQuadruple)
-> (Set StrQuadruple -> f (Set StrQuadruple))
-> Quadruples
-> f Quadruples
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ([StrQuadruple] -> Set StrQuadruple
forall c v. UnsafeListable c v => [v] -> c
fromList ([StrQuadruple] -> Set StrQuadruple)
-> (Quadruples -> [StrQuadruple]) -> Quadruples -> Set StrQuadruple
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((State, Symbol), (SymbolOrMove, State)) -> StrQuadruple)
-> [((State, Symbol), (SymbolOrMove, State))] -> [StrQuadruple]
forall a b. (a -> b) -> [a] -> [b]
map ((State, Symbol), (SymbolOrMove, State)) -> StrQuadruple
toStrQ ([((State, Symbol), (SymbolOrMove, State))] -> [StrQuadruple])
-> (Quadruples -> [((State, Symbol), (SymbolOrMove, State))])
-> Quadruples
-> [StrQuadruple]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Quadruples -> [((State, Symbol), (SymbolOrMove, State))]
forall c v. Listable c v => c -> [v]
toList)

strLabeledStates :: TMGetter (Set String)
strLabeledStates :: (Set String -> f (Set String)) -> TuringMachine -> f TuringMachine
strLabeledStates = (LabeledStates -> f LabeledStates)
-> TuringMachine -> f TuringMachine
Lens' TuringMachine LabeledStates
labeledStates ((LabeledStates -> f LabeledStates)
 -> TuringMachine -> f TuringMachine)
-> ((Set String -> f (Set String))
    -> LabeledStates -> f LabeledStates)
-> (Set String -> f (Set String))
-> TuringMachine
-> f TuringMachine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LabeledStates -> Set String)
-> (Set String -> f (Set String))
-> LabeledStates
-> f LabeledStates
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to LabeledStates -> Set String
forall c k. (Keyable c k, Ord k) => c -> Set k
keysSet

strSymbols :: TMGetter (Set String)
strSymbols :: (Set String -> f (Set String)) -> TuringMachine -> f TuringMachine
strSymbols = (Alphabet -> f Alphabet) -> TuringMachine -> f TuringMachine
Lens' TuringMachine Alphabet
alphabet ((Alphabet -> f Alphabet) -> TuringMachine -> f TuringMachine)
-> ((Set String -> f (Set String)) -> Alphabet -> f Alphabet)
-> (Set String -> f (Set String))
-> TuringMachine
-> f TuringMachine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Alphabet -> Set String)
-> (Set String -> f (Set String)) -> Alphabet -> f Alphabet
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ((ShowedSymbol -> String) -> Set ShowedSymbol -> Set String
forall c1 c2 v1 v2. Gunctor c1 c2 v1 v2 => (v1 -> v2) -> c1 -> c2
gmap (ShowedSymbol -> String
forall a. Show a => a -> String
show :: ShowedSymbol -> String) (Set ShowedSymbol -> Set String)
-> (Alphabet -> Set ShowedSymbol) -> Alphabet -> Set String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alphabet -> Set ShowedSymbol
forall c v. (Valuable c v, Ord v) => c -> Set v
valuesSet)

strNumStates :: TMGetter (Set String)
strNumStates :: (Set String -> f (Set String)) -> TuringMachine -> f TuringMachine
strNumStates = (Set State -> f (Set State)) -> TuringMachine -> f TuringMachine
TMGetter (Set State)
allStates ((Set State -> f (Set State)) -> TuringMachine -> f TuringMachine)
-> ((Set String -> f (Set String)) -> Set State -> f (Set State))
-> (Set String -> f (Set String))
-> TuringMachine
-> f TuringMachine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set State -> Set String)
-> (Set String -> f (Set String)) -> Set State -> f (Set State)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ((State -> String) -> Set State -> Set String
forall c1 c2 v1 v2. Gunctor c1 c2 v1 v2 => (v1 -> v2) -> c1 -> c2
gmap (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (State -> Int) -> State -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> Int
numState))

strNumSymbols :: TMGetter (Set String)
strNumSymbols :: (Set String -> f (Set String)) -> TuringMachine -> f TuringMachine
strNumSymbols = (Set Symbol -> f (Set Symbol)) -> TuringMachine -> f TuringMachine
TMGetter (Set Symbol)
allSymbols ((Set Symbol -> f (Set Symbol))
 -> TuringMachine -> f TuringMachine)
-> ((Set String -> f (Set String)) -> Set Symbol -> f (Set Symbol))
-> (Set String -> f (Set String))
-> TuringMachine
-> f TuringMachine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set Symbol -> Set String)
-> (Set String -> f (Set String)) -> Set Symbol -> f (Set Symbol)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ((Symbol -> String) -> Set Symbol -> Set String
forall c1 c2 v1 v2. Gunctor c1 c2 v1 v2 => (v1 -> v2) -> c1 -> c2
gmap (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (Symbol -> Int) -> Symbol -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Int
numSymbol))

maxNumState :: TMGetter Int
maxNumState :: (Int -> f Int) -> TuringMachine -> f TuringMachine
maxNumState = (Quadruples -> f Quadruples) -> TuringMachine -> f TuringMachine
Lens' TuringMachine Quadruples
quadruples ((Quadruples -> f Quadruples) -> TuringMachine -> f TuringMachine)
-> ((Int -> f Int) -> Quadruples -> f Quadruples)
-> (Int -> f Int)
-> TuringMachine
-> f TuringMachine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Quadruples -> Int) -> (Int -> f Int) -> Quadruples -> f Quadruples
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> (Quadruples -> [Int]) -> Quadruples -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((State, Symbol), (SymbolOrMove, State)) -> Int)
-> [((State, Symbol), (SymbolOrMove, State))] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ((State, Symbol), (SymbolOrMove, State)) -> Int
forall b a. ((State, b), (a, State)) -> Int
maxN ([((State, Symbol), (SymbolOrMove, State))] -> [Int])
-> (Quadruples -> [((State, Symbol), (SymbolOrMove, State))])
-> Quadruples
-> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Quadruples -> [((State, Symbol), (SymbolOrMove, State))]
forall c v. Listable c v => c -> [v]
toList) where
    maxN :: ((State, b), (a, State)) -> Int
maxN ((State
qs, b
_), (a
_, State
qf)) = (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int -> Int -> Int) -> (State -> Int) -> State -> State -> Int
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` State -> Int
numState) State
qs State
qf

maxNumSymbol :: TMGetter Int
maxNumSymbol :: (Int -> f Int) -> TuringMachine -> f TuringMachine
maxNumSymbol = (Quadruples -> f Quadruples) -> TuringMachine -> f TuringMachine
Lens' TuringMachine Quadruples
quadruples ((Quadruples -> f Quadruples) -> TuringMachine -> f TuringMachine)
-> ((Int -> f Int) -> Quadruples -> f Quadruples)
-> (Int -> f Int)
-> TuringMachine
-> f TuringMachine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Quadruples -> Int) -> (Int -> f Int) -> Quadruples -> f Quadruples
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> (Quadruples -> [Int]) -> Quadruples -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((State, Symbol), (SymbolOrMove, State)) -> Int)
-> [((State, Symbol), (SymbolOrMove, State))] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ((State, Symbol), (SymbolOrMove, State)) -> Int
forall a b. ((a, Symbol), (SymbolOrMove, b)) -> Int
maxM ([((State, Symbol), (SymbolOrMove, State))] -> [Int])
-> (Quadruples -> [((State, Symbol), (SymbolOrMove, State))])
-> Quadruples
-> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Quadruples -> [((State, Symbol), (SymbolOrMove, State))]
forall c v. Listable c v => c -> [v]
toList) where
    maxM :: ((a, Symbol), (SymbolOrMove, b)) -> Int
maxM ((a
_, Symbol
s), (M Move
_, b
_)) = Symbol -> Int
numSymbol Symbol
s
    maxM ((a
_, Symbol
s), (S Symbol
s', b
_)) = (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int -> Int -> Int) -> (Symbol -> Int) -> Symbol -> Symbol -> Int
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Symbol -> Int
numSymbol) Symbol
s Symbol
s'