-- SPDX-FileCopyrightText: Chris Pressey, the creator of this work, has dedicated it to the public domain.
-- For more information, please refer to <https://unlicense.org/>
-- SPDX-License-Identifier: Unlicense

module Language.Turmac.Model where

import Data.Char (isSpace)


type StateId = String
type Symbol = String
type Direction = Int

type TMRule = (StateId, Symbol, Symbol, StateId, Direction)

start = "S0"
blank = "_"

-- | Represents the infinite tape of the Turing machine
-- For efficiency, we only store cells that we have visited, and that are
-- not blank (unless they are still needed because they appear between
-- non-blank cells that we have visited).
data Tape = Tape
    { leftCells :: [Symbol]      -- Cells to the left of head (reversed)
    , currentCell :: Symbol      -- Cell under head
    , rightCells :: [Symbol]     -- Cells to the right of head
    } deriving (Eq)

instance Show Tape where
    show t = "[" ++ (showTape $ getTapeContents t) ++ "]"

-- | Helper functions for tape visualization
showTape [] = ""
showTape [sym] = sym
showTape (sym:rest) = sym ++ "," ++ showTape rest

stripLeftBlanks :: [Symbol] -> [Symbol]
stripLeftBlanks tape@(cell:rest) = if cell == blank then stripLeftBlanks rest else tape
stripLeftBlanks other = other

stripRightBlanks :: [Symbol] -> [Symbol]
stripRightBlanks = reverse . stripLeftBlanks . reverse

getTapeContents :: Tape -> [Symbol]
getTapeContents Tape{ leftCells=lc, currentCell=cc, rightCells=rc } =
    stripLeftBlanks (reverse lc) ++ [cc] ++ stripRightBlanks rc

-- | A configuration is the complete instantaneous state of the TM
data Configuration = Configuration
    { tmTape :: Tape
    , tmPos :: Integer         -- position of tape head relative to start
    , tmState :: StateId       -- this could be a halt state
    } deriving (Eq)

instance Show Configuration where
    show c = "State: " ++ (tmState c) ++ ", Tape: " ++ show (tmTape c)

isHaltState ('@':_) = True
isHaltState _ = False

isHalted (Configuration _ _ state) = isHaltState state

-- | Initialize an empty tape with all zeros
emptyTape :: Tape
emptyTape = Tape [] blank []

-- | Initialize a tape with given input symbols
initTape :: [Symbol] -> Tape
initTape [] = emptyTape
initTape (x:xs) = Tape [] x xs

-- | Move tape head left
moveLeft :: Tape -> Tape
moveLeft (Tape (l:ls) c rs) = Tape ls l (c:rs)
moveLeft (Tape [] c rs) = Tape [] blank (c:rs)  -- Extend with zero

-- | Move tape head right
moveRight :: Tape -> Tape
moveRight (Tape ls c (r:rs)) = Tape (c:ls) r rs
moveRight (Tape ls c []) = Tape (c:ls) blank []  -- Extend with zero

-- | Write symbol at current position
writeSymbol :: Symbol -> Tape -> Tape
writeSymbol sym (Tape ls _ rs) = Tape ls sym rs

-- | Read current symbol
readSymbol :: Tape -> Symbol
readSymbol = currentCell

-- | Initialize TM state with empty tape
initConfiguration :: Configuration
initConfiguration = Configuration emptyTape 0 start

-- | Initialize TM state with input
initConfigurationWithInput :: [Symbol] -> Configuration
initConfigurationWithInput input = Configuration (initTape input) 0 start