-- 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.IRDump
import Language.Turmac.Backend.Turmac
import Language.Turmac.Backend.Python
-- FIXME import Language.Turmac.Backend.Kondey

--
-- Command-line flags
--

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

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

-- Note: this is a terrible little hack
splitOnCommas s =
    words [if c == ',' then ' ' else c|c <- s]

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 = splitOnCommas s } rest
parseFlags flags ("--max-steps":n:rest) =
    parseFlags flags{ maxSteps = read n } rest
parseFlags flags ("--normalize":rest) =
    parseFlags flags{ normalize = True } 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 "ir-dump" = compileToIRDump
compileTo "turmac" = compileToTurmac
compileTo "python" = compileToPython
-- FIXME compileTo "kondey" = compileToKondey
compileTo _ = error "--backend must be given when compiling, and must be one of: 'ir-dump', 'turmac', or 'python'"

--
-- 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
                        tmRules' = if (normalize flags) then normalizeRules tmRules else tmRules
                        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 ->
                    let
                        tmRules' = if (normalize flags) then normalizeRules tmRules else tmRules
                    in do
                        putStr $ compileTo (backend flags) tmRules'
                        exitWith ExitSuccess

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

        ["gentape", tapeContents] ->
            let
                symbols = splitOnCommas tapeContents
                tmRules = generateTapeWriter symbols
                tmRules' = if (normalize flags) then normalizeRules tmRules else tmRules
            in do
                putStr $ compileTo (backend flags) tmRules'
                exitWith ExitSuccess

        _ -> do
            putStrLn "Usage: turmac {flags} simulate <turmac-description-file>"
            putStrLn "       turmac {flags} compile <turmac-description-file>"
            putStrLn "       turmac {flags} gentape <comma-separated-list-of-symbols>"
            putStrLn " where flags are:"
            putStrLn "   --backend          when compiling, specifies backend to use"
            putStrLn "   --check-complete   check description is complete beforehand"
            putStrLn "   --initial-tape     when simulating, gives initial contents of tape"
            putStrLn "   --normalize        normalize symbol and state sets beforehand"
            putStrLn "   --trace            when simulating, display each step taken"
            exitWith $ ExitFailure 2