-- 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 Main where

import Data.Char (digitToInt)
import Data.List (intercalate)
import System.Environment
import System.Exit

import Language.Turmac.Model
import Language.Turmac.IR
import Language.Turmac.Parser
import Language.Turmac.Analyzer (isComplete)
import Language.Turmac.Simulator
import Language.Turmac.GenTape
import Language.Turmac.Normalizer
import Language.Turmac.Backend.Python
import Language.Turmac.Backend.Turmac
import Language.Turmac.Backend.IRDump

--
-- Command-line flags
--

data Flags = Flags {
    backend :: String,
    checkComplete :: Bool,
    initialTape :: [Symbol],
    maxSteps :: Integer,
    trace :: Bool
} deriving (Show, Ord, Eq)

defaultFlags = Flags{
    backend = "",
    checkComplete = False,
    initialTape = [],
    maxSteps = 0,
    trace = False
}

parseFlags flags ("--backend":s:rest) =
    parseFlags flags{ backend = s } rest
parseFlags flags ("--check-complete":rest) =
    parseFlags flags{ checkComplete = True } rest
parseFlags flags ("--initial-tape":s:rest) =
    parseFlags flags{ initialTape = words [if c == ',' then ' ' else c|c <- s] } rest
parseFlags flags ("--max-steps":n:rest) =
    parseFlags flags{ maxSteps = read n } rest
parseFlags flags ("--trace":rest) =
    parseFlags flags{ trace = True } rest
parseFlags flags other = (flags, other)

--
-- Parse to IR
--

parse :: Bool -> String -> Either String [TMRule]
parse True input =
    let rules = parseRules input
    in if null rules
       then Left "No valid rules found in input"
       else if not (isComplete rules)
            then Left "Incomplete Turmac description: missing state-symbol combinations"
            else Right $ rules
parse False input = Right $ parseRules input

compileTo :: String -> ([TMRule] -> String)
compileTo "python" = compileToPython
compileTo "turmac" = compileToTurmac
compileTo "normalized-turmac" = compileToNormalizedTurmac
compileTo "ir-dump" = compileToIRDump
compileTo _ = error "--backend must be given when compiling, and must be one of: 'python', 'turmac', 'ir-dump'"

--
-- Driver
--

main = do
    args <- getArgs
    let (flags, args') = parseFlags defaultFlags args
    case args' of
        ["simulate", fileName] -> do
            turmacText <- readFile fileName
            case parse (checkComplete flags) turmacText of
                Right tmRules ->
                    let
                        config = initConfigurationWithInput (initialTape flags)
                        (configs, finalConfig) = simulate tmRules config
                    in do
                        case trace flags of
                            True -> do
                                putStrLn "Simulation History:"
                                mapM_ (putStrLn . show) configs
                                putStrLn "\nFinal Configuration:"
                            False -> do
                                return ()
                        putStrLn $ (show finalConfig) ++ ", Halted: " ++ show (tmHalted finalConfig)
                        exitWith ExitSuccess

        ["compile", fileName] -> do
            turmacText <- readFile fileName
            case parse (checkComplete flags) turmacText of
                Right tmRules -> do
                    putStr $ compileTo (backend flags) tmRules
                    exitWith ExitSuccess

                Left errMsg -> do
                    putStrLn $ "Error parsing input file: " ++ errMsg
                    exitWith $ ExitFailure 1

        ["gentape", str] -> do
            putStr $ generateTapeWriter str
            exitWith ExitSuccess

        _ -> do
            putStrLn "Usage: turmac {flags} simulate <turmac-description-file>"
            putStrLn "       turmac {flags} compile <turmac-description-file>"
            putStrLn "       turmac {flags} gentape <string-of-digits>"
            putStrLn " where flags are:"
            putStrLn "   --backend        : when compiling, specifies backend to use"
            putStrLn "   --check-complete : check description is complete beforehand"
            putStrLn "   --initial-tape   : comma-seperated symbols initially on tape"
            putStrLn "   --trace          : when simulating, display each step taken"
            exitWith $ ExitFailure 2