{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module TuringMachine.State (
    State,
    state,
    numState,
    startState,
    finalState,
  ) where

newtype State = Q { State -> Int
numState :: Int }
    deriving (State -> State -> Bool
(State -> State -> Bool) -> (State -> State -> Bool) -> Eq State
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: State -> State -> Bool
$c/= :: State -> State -> Bool
== :: State -> State -> Bool
$c== :: State -> State -> Bool
Eq, Eq State
Eq State
-> (State -> State -> Ordering)
-> (State -> State -> Bool)
-> (State -> State -> Bool)
-> (State -> State -> Bool)
-> (State -> State -> Bool)
-> (State -> State -> State)
-> (State -> State -> State)
-> Ord State
State -> State -> Bool
State -> State -> Ordering
State -> State -> State
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: State -> State -> State
$cmin :: State -> State -> State
max :: State -> State -> State
$cmax :: State -> State -> State
>= :: State -> State -> Bool
$c>= :: State -> State -> Bool
> :: State -> State -> Bool
$c> :: State -> State -> Bool
<= :: State -> State -> Bool
$c<= :: State -> State -> Bool
< :: State -> State -> Bool
$c< :: State -> State -> Bool
compare :: State -> State -> Ordering
$ccompare :: State -> State -> Ordering
$cp1Ord :: Eq State
Ord, Integer -> State
State -> State
State -> State -> State
(State -> State -> State)
-> (State -> State -> State)
-> (State -> State -> State)
-> (State -> State)
-> (State -> State)
-> (State -> State)
-> (Integer -> State)
-> Num State
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> State
$cfromInteger :: Integer -> State
signum :: State -> State
$csignum :: State -> State
abs :: State -> State
$cabs :: State -> State
negate :: State -> State
$cnegate :: State -> State
* :: State -> State -> State
$c* :: State -> State -> State
- :: State -> State -> State
$c- :: State -> State -> State
+ :: State -> State -> State
$c+ :: State -> State -> State
Num, Int -> State
State -> Int
State -> [State]
State -> State
State -> State -> [State]
State -> State -> State -> [State]
(State -> State)
-> (State -> State)
-> (Int -> State)
-> (State -> Int)
-> (State -> [State])
-> (State -> State -> [State])
-> (State -> State -> [State])
-> (State -> State -> State -> [State])
-> Enum State
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: State -> State -> State -> [State]
$cenumFromThenTo :: State -> State -> State -> [State]
enumFromTo :: State -> State -> [State]
$cenumFromTo :: State -> State -> [State]
enumFromThen :: State -> State -> [State]
$cenumFromThen :: State -> State -> [State]
enumFrom :: State -> [State]
$cenumFrom :: State -> [State]
fromEnum :: State -> Int
$cfromEnum :: State -> Int
toEnum :: Int -> State
$ctoEnum :: Int -> State
pred :: State -> State
$cpred :: State -> State
succ :: State -> State
$csucc :: State -> State
Enum)

instance Bounded State where
    minBound :: State
minBound = Int -> State
Q Int
0
    maxBound :: State
maxBound = Int -> State
Q Int
forall a. Bounded a => a
maxBound

state :: Int -> State
state :: Int -> State
state = Int -> State
Q

startState :: State
startState :: State
startState = Int -> State
Q Int
1

finalState :: State
finalState :: State
finalState = Int -> State
Q Int
0