git @ Cat's Eye Technologies Argyle / master src / Main.hs
master

Tree @master (Download .tar.gz)

Main.hs @masterraw · history · blame

-- Copyright (c) 2024, 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-Argyle

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

module Main where

import System.Environment (getArgs)
import System.Exit
import System.IO
import Data.Char (isSpace)
import Data.Maybe (fromMaybe)

import Language.Argyle.Parser (sexprToConsList, sexprToAST, sexprToABT)
import Language.Argyle.Value (ABT, showValue, unparseABT)
import qualified Language.Argyle.Tests.Runner as TestRunner
import qualified Language.Argyle.Interpreter as I
import qualified Language.Argyle.Sexpr2ConsList as S
import Language.Argyle.REPL (repl)

main :: IO ()
main = do
    args <- getArgs
    case args of
        ["parse", filename] -> do
            source <- readFile filename
            showParses source
        ["eval", filename] -> do
            abt <- readABTfrom filename
            case I.runEval abt of
                Left err -> do
                    abortWith $ "Error: " ++ err
                Right value -> do
                    putStrLn $ showValue value
        ["repl"] -> do
            repl
        ["test"] -> do
            passed <- TestRunner.runAllTests
            if not passed
                then exitWith $ ExitFailure 1
                else exitSuccess
        _ ->
            usage

showParses :: String -> IO ()
showParses source = case S.parse source of
    S.Complete conslist remainder -> do
        putStrLn $ show conslist
        case sexprToAST source of
            Left err -> abortWith $ "AST Error: " ++ err
            Right ast -> do
                putStrLn $ show ast
                case sexprToABT source of
                    Left err -> abortWith $ "ABT Error: " ++ err
                    Right abt -> do
                        putStrLn $ unparseABT [] abt
                        putStrLn $ show abt
    S.Incomplete count _ ->
        abortWith $ "Incomplete expression: missing " ++ show count ++ " closing parentheses"
    S.Error err ->
        abortWith $ "Parse error: " ++ show err

readABTfrom :: FilePath -> IO ABT
readABTfrom filename = do
    input <- readFile filename
    case S.parse input of
        S.Complete _ remainder | not (all isSpace remainder) ->
            abortWith $ "Unexpected characters after expression: " ++ remainder
        S.Complete _ _ ->
            case sexprToABT input of
                Left err -> abortWith $ "Error: " ++ err
                Right abt -> return abt
        S.Incomplete count _ ->
            abortWith $ "Incomplete expression: missing " ++ show count ++ " closing parentheses"
        S.Error err ->
            abortWith $ "Parse error: " ++ show err

usage :: IO ()
usage = abortWith
    (
        "Usage:\n" ++
        "    argyle parse <filename>\n" ++
        "    argyle eval <filename>\n" ++
        "    argyle repl\n" ++
        "    argyle test\n"
    )

abortWith :: String -> IO a
abortWith msg = do
    hPutStrLn stderr msg
    exitWith $ ExitFailure 1