From d91c6bb446d0284f096cc6cfc9a7f9ac7f8afb1e Mon Sep 17 00:00:00 2001
From: LLLL Colonq <llll@colonq>
Date: Sun, 14 Jan 2024 19:01:03 -0500
Subject: Add fig-bless

---
 fig-bless/main/Main.hs | 64 ++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 64 insertions(+)
 create mode 100644 fig-bless/main/Main.hs

(limited to 'fig-bless/main')

diff --git a/fig-bless/main/Main.hs b/fig-bless/main/Main.hs
new file mode 100644
index 0000000..c3807c7
--- /dev/null
+++ b/fig-bless/main/Main.hs
@@ -0,0 +1,64 @@
+{-# Language ApplicativeDo, ImplicitParams #-}
+
+module Main where
+
+import Fig.Prelude
+
+import Options.Applicative
+
+import Control.Exception.Safe (Handler(..), catches)
+
+import Data.Text.IO (putStrLn)
+
+import Fig.Bless
+import qualified Fig.Bless.Syntax as Syn
+
+data EvalOptions = EvalOptions
+  { src :: Text
+  , fuel :: Maybe Integer
+  }
+
+newtype Command
+  = Eval EvalOptions
+
+newtype Options = Options
+  { cmd :: Command
+  }
+
+parseEvalOptions :: Parser EvalOptions
+parseEvalOptions = do
+  fuel <- optional $ option auto (long "fuel" <> short 'f' <> metavar "N" <> help "Maximum number of terms to run")
+  src <- unwords <$> some (argument str (metavar "TERM..."))
+  pure EvalOptions{..}
+
+parseCommand :: Parser Command
+parseCommand = subparser $ mconcat
+  [ command "eval" $ info (Eval <$> parseEvalOptions) (progDesc "Evaluate a Bless program")
+  ]
+
+parseOptions :: Parser Options
+parseOptions = do
+  cmd <- parseCommand
+  pure Options{..}
+
+main :: IO ()
+main = do
+  opts <- execParser $ info (parseOptions <**> helper)
+    ( fullDesc
+    <> header "fig-bless - tools for the Bless language"
+    )
+  catches
+    ( case opts.cmd of
+        Eval eo -> do
+          prog <- parse "<input>" (programF spanning <* eof) eo.src
+          let ?term = Nothing
+          let vm = initialize eo.fuel (Dictionary mempty) arithmetic
+          vm' <- runProgram (pure . unSpanning) prog vm
+          let
+            stack :: [ValueF Spanning (Fix (ValueF Spanning))]
+            stack = vm'.stack
+          forM_ stack $ putStrLn . pretty
+    )
+    [ Handler \(e :: Syn.ParseError) -> hPutStrLn stderr $ pretty e
+    , Handler \(e :: RuntimeError Spanning) -> hPutStrLn stderr $ pretty e
+    ]
-- 
cgit v1.2.3