-- Copyright (c) 2025, Chris Pressey, Cat's Eye Technologies.
-- This file is distributed under a 2-clause BSD license.  See LICENSES/ dir.
-- SPDX-License-Identifier: LicenseRef-BSD-2-Clause-X-UampirNexol

module Main where

import Data.Word (Word8)
import qualified Data.ByteString as BS
import System.Environment
import System.Exit
import System.IO

import Language.UampirNexol.Parser (parseProgram)
import Language.UampirNexol.Expr (typeOf, initialTEnv)
import Language.UampirNexol.Eval (evalMain)
import Language.UampirNexol.Harvester (extractRoutines)
import Language.UampirNexol.Extractor (extract, checkAndExtract, initialEEnv)
import Language.UampirNexol.CodeGen (hexDump)
import Language.UampirNexol.Serializer (serialize, processRoutines, makeRoutinesList)


data Flags = Flags {
    typeCheck :: String,
    format :: String,
    outputTo :: String
} deriving (Show, Ord, Eq)

defaultFlags = Flags{
    typeCheck = "yes",
    format = "hex",
    outputTo = "out.prg"
}

parseFlags flags ("--type-check":s:rest) =
    parseFlags flags{ typeCheck = s } rest
parseFlags flags ("--format":s:rest) =
    parseFlags flags{ format = s } rest
parseFlags flags ("--output-to":s:rest) =
    parseFlags flags{ outputTo = s } rest
parseFlags flags other = (flags, other)


main = do
    args <- getArgs
    let (flags, args') = parseFlags defaultFlags args
    case args' of
        ["parse", fileName] -> do
            programText <- readFile fileName
            case parseProgram programText of
                Left e -> do
                    abortWith $ "error: " ++ show e
                Right program -> do
                    putStrLn $ show $ program
        ["type", fileName] -> do
            programText <- readFile fileName
            case parseProgram programText of
                Left e -> do
                    abortWith $ "error: " ++ show e
                Right program -> do
                    case typeOf program initialTEnv of
                        Left e -> do
                            abortWith $ "error: " ++ e
                        Right typ -> do
                            putStrLn $ show $ typ
        ["run", fileName] -> do
            programText <- readFile fileName
            case parseProgram programText of
                Left e -> do
                    abortWith $ "error: " ++ show e
                Right program -> do
                    let result = evalMain program
                    putStrLn $ show $ result
        ["extract", fileName] -> do
            programText <- readFile fileName
            case parseProgram programText of
                Left e -> do
                    abortWith $ "error: " ++ show e
                Right program -> do
                    extracted <- case typeCheck flags of
                        "yes" ->
                            case checkAndExtract program of
                                Left e -> do
                                    abortWith $ "error: " ++ e
                                Right result -> do
                                    return result
                        "no" ->
                            return $ extract program initialEEnv
                        other ->
                            abortWith $ "illegal option: --type-check: " ++ other
                    case format flags of
                        "dump" ->
                            putStrLn $ show extracted
                        "harvest" ->
                            putStrLn $ show $ extractRoutines program
                        "serz" ->
                            putStrLn $ show $ processRoutines extracted "main" 0xc000
                        "layout" ->
                            putStrLn $ show $ makeRoutinesList extracted "main" 0xc000
                        "hex" ->
                            putStrLn $ hexDump $ serialize extracted "main" 0xc000
                        "prg" ->
                            let
                                body = serialize extracted "main" 0xc000
                                prg = [0x00, 0xc0] ++ body
                            in
                                writeBinaryFile (outputTo flags) $ prg
                        "c64bas" ->
                            let
                                prelude = [0x10, 0x08, 0xc9, 0x07, 0x9e, 0x32,
                                           0x30, 0x36, 0x31, 0x00, 0x00, 0x00]
                                baseAddr = 0x0801 + length prelude
                                c64bas = [0x01, 0x08] ++ prelude ++ serialize extracted "main" baseAddr
                            in
                                writeBinaryFile (outputTo flags) c64bas
                        "vic20bas" ->
                            let
                                prelude = [0x0b, 0x10, 0xc9, 0x07, 0x9e, 0x34,
                                           0x31, 0x30, 0x39, 0x00, 0x00, 0x00]
                                baseAddr = 0x1001 + length prelude
                                vic20bas = [0x01, 0x10] ++ prelude ++ serialize extracted "main" baseAddr
                            in
                                writeBinaryFile (outputTo flags) vic20bas
                        other ->
                            abortWith $ "illegal option: --output-format: " ++ other
        _ -> do
            abortWith $
              "Usage: uampirnexol {flags} parse <filename>\n" ++
              "       uampirnexol {flags} type <filename>\n" ++
              "       uampirnexol {flags} run <filename>\n" ++
              "       uampirnexol {flags} extract <filename>\n" ++
              "  where {flags} can be:\n" ++
              "       --type-check yes|no                         (default: yes)\n" ++
              "       --format dump|serz|hex|prg|c64bas|vic20bas  (default: hex)\n" ++
              "       --output-to <filename>                      (default: out.prg)\n"


abortWith msg = do
    hPutStrLn stderr msg
    exitWith $ ExitFailure 1


writeBinaryFile :: FilePath -> [Int] -> IO ()
writeBinaryFile filename bytes = do
    BS.writeFile filename $ BS.pack $ map intToByte bytes
    where
        intToByte :: Int -> Word8
        intToByte i
            | i >= 0 && i <= 255 = fromIntegral i
            | otherwise = error $ "Byte value out of range (0-255): '" ++ show i