Turing machine thing in Haskell (quite literally a tape machine)

TuringMachine.hs

-- Turing machine thing in Haskell
-- (c) boxmein 2015 mit licensed blah blah
module TuringMachine
where




--
-- Tape
--




-- [1, 2, 3] 4 [5, 6, 7]
-- is this tape:
-- 3 2 1 4 5 6 7
data Tape = Tape [Int] Int [Int]
  deriving (Show)

data Pivot = Pivot Int
  deriving (Show)

moveLeft :: Tape -> Tape
moveLeft (Tape (l:ls) p rs) = Tape ls l (p:rs)
moveLeft (Tape [] p rs) = Tape [] p rs

moveRight :: Tape -> Tape
moveRight (Tape l p (r:rs)) = Tape (p:l) r rs
moveRight (Tape l p []) = Tape l p []

setPivot :: Tape -> Pivot -> Tape
setPivot (Tape ls _ rs) (Pivot p) = Tape ls p rs

getPivot :: Tape -> Pivot
getPivot (Tape _ x _) = Pivot x




--
-- State
--




-- states are like strings representing the current state of the tape machine
data State = State Tape String
  deriving (Show)

data Direction = MoveLeft | MoveRight
  deriving (Show)

type InputState = (State, Pivot)
type OutputState = (State, Pivot, Direction)




--
-- Rules
--




tapeMachine :: InputState -> OutputState

-- program the tape machine to flip every 0 to 1 and 1 to 0
tapeMachine (s, Pivot 1) = (s, Pivot 0, MoveRight)
tapeMachine (s, Pivot 0) = (s, Pivot 1, MoveRight)

tapeMachine (State t _, Pivot _) = (State t "UnhandledState!", Pivot 0, MoveRight)




--
-- Actual operation
--




moveTape :: OutputState -> InputState

moveTape (State intape str, pi, MoveLeft)  = (State tape str, getPivot tape)
  where tape = moveLeft $  setPivot intape pi

moveTape (State intape str, pi, MoveRight) = (State tape str, getPivot tape)
  where tape = moveRight $ setPivot intape pi


tick :: InputState -> InputState
tick = moveTape . tapeMachine


-- tick until the turing machine hits the left/right end of the tape
tickUntilEnd :: Maybe InputState -> Maybe InputState
tickUntilEnd Nothing = Nothing
tickUntilEnd (Just (State (Tape _ _ []) _, _)) = Nothing
tickUntilEnd (Just (State (Tape [] _ _) _, _)) = Nothing
tickUntilEnd (Just x) = Just (tick x)


-- turn an input string of ints into a Tape
-- the string looks like "0 1 2 95 10 2 1"
inputTape :: String -> Tape
inputTape str = Tape [0] pivot right
  where (pivot:right) = map readInt $ words str
        readInt x = read x :: Int



-- I wonder what this does...
notNothing :: Maybe a -> Bool
notNothing Nothing = False
notNothing (Just a) = True



main = do
    text <- getLine
    let tape = inputTape text
        initialState = State tape "lol state"
     in putStrLn . show . (takeWhile notNothing) . iterate tickUntilEnd $ Just (initialState, getPivot tape)

-- and bam! it's a turing machine!