Remove fig-bless

1 files changed, 0 insertions, 144 deletions

diff --git a/fig-bless/main/Main.hs b/fig-bless/main/Main.hs
deleted file mode 100644
index f429638..0000000
--- a/fig-bless/main/Main.hs
+++ /dev/null
@@ -1,144 +0,0 @@
-{-# Language ApplicativeDo, ImplicitParams #-}
-
-module Main where
-
-import Fig.Prelude
-
-import Options.Applicative
-
-import Control.Exception.Safe (Handler(..), catches)
-
-import Data.Text.IO (putStr, putStrLn)
-import qualified Data.Text.IO as T.IO
-import qualified Data.ByteString.Lazy as B.L
-
-import qualified Data.Aeson as Aeson
-
-import Fig.Bless
-import qualified Fig.Bless.Syntax as Syn
-
-data EvalOptions = EvalOptions
-  { src :: Text
-  , fuel :: Maybe Integer
-  } deriving Show
-
-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{..}
-
-newtype TypeOptions = TypeOptions
-  { src :: Text
-  } deriving Show
-
-parseTypeOptions :: Parser TypeOptions
-parseTypeOptions = do
-  src <- unwords <$> some (argument str (metavar "TERM..."))
-  pure TypeOptions{..}
-
-data DictionaryOptions = DictionaryOptions
-  { path :: FilePath
-  , entrypoint :: Word
-  , fuel :: Maybe Integer
-  } deriving Show
-
-parseDictionaryOptions :: Parser DictionaryOptions
-parseDictionaryOptions = do
-  fuel <- optional $ option auto (long "fuel" <> short 'f' <> metavar "N" <> help "Maximum number of terms to run")
-  entrypoint <- fmap (fromMaybe "main") . optional $ strOption (long "entrypoint" <> short 'e' <> metavar "WORD" <> help "Word to evaluate")
-  path <- argument str (metavar "PATH")
-  pure DictionaryOptions{..}
-
-data Command
-  = Eval EvalOptions
-  | Type TypeOptions
-  | Dict DictionaryOptions
-  deriving Show
-
-parseCommand :: Parser Command
-parseCommand = subparser $ mconcat
-  [ command "eval" $ info (Eval <$> parseEvalOptions) (progDesc "Evaluate a Bless program")
-  , command "type" $ info (Type <$> parseTypeOptions) (progDesc "Check the type of a Bless program")
-  , command "dictionary" $ info (Dict <$> parseDictionaryOptions) (progDesc "Load and run a Bless dictionary")
-  ]
-
-data Options = Options
-  { cmd :: Command
-  , json :: Bool
-  } deriving Show
-
-parseOptions :: Parser Options
-parseOptions = do
-  json <- flag False True (long "json" <> short 'j' <> help "Write output as JSON")
-  cmd <- parseCommand
-  pure Options{..}
-
-writeError :: (MonadIO m, Pretty e, Aeson.ToJSON e) => Options -> e -> m ()
-writeError o e
-  | o.json = liftIO . putStrLn . decodeUtf8 . B.L.toStrict . Aeson.encode $ Aeson.object
-    [ "status" Aeson..= ("error" :: Text)
-    , "data" Aeson..= Aeson.object
-      [ "structure" Aeson..= e
-      , "message" Aeson..= pretty e
-      ]
-    ]
-  | otherwise = liftIO . hPutStrLn stderr $ pretty e
-
-writeEval :: (MonadIO m, Pretty t, Aeson.ToJSON t) => Options -> [ValueF t] -> [EffectF t] -> m ()
-writeEval o st ef
-  | o.json = liftIO . putStrLn . decodeUtf8 . B.L.toStrict . Aeson.encode $ Aeson.object
-    [ "status" Aeson..= ("success" :: Text)
-    , "data" Aeson..= Aeson.object
-      [ "stack" Aeson..= st
-      , "effects" Aeson..= reverse ef
-      ]
-    ]
-  | otherwise = do
-      liftIO . putStr $ "Stack:\n" <> pretty st
-      liftIO . putStr $ "Effects:\n" <> pretty (reverse ef)
-
-writeType :: (MonadIO m, Pretty e, Aeson.ToJSON e) => Options -> e -> m ()
-writeType o t
-  | o.json = liftIO . putStrLn . decodeUtf8 . B.L.toStrict . Aeson.encode $ Aeson.object
-    [ "status" Aeson..= ("error" :: Text)
-    , "data" Aeson..= t
-    ]
-  | otherwise = liftIO . hPutStrLn stderr $ pretty t
-
-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 ext = pure . unSpanning
-          _ty <- typeOfProgram (initializeEnv ext builtins) prog
-          let vm = initialize eo.fuel (Dictionary mempty) builtins
-          vm' <- runProgram ext prog vm
-          writeEval opts vm'.stack vm'.effects
-        Type to -> do
-          prog <- parse "<input>" (programF spanning <* eof) to.src
-          let ?term = Nothing
-          let ext = pure . unSpanning
-          ty <- typeOfProgram (initializeEnv ext builtins) prog
-          writeType opts ty
-        Dict o -> do
-          src <- T.IO.readFile o.path
-          dict <- parse "<input>" (dictionaryF spanning <* eof) src
-          let ?term = Nothing
-          let ext = pure . unSpanning
-          _env <- checkDictionary (initializeEnv ext builtins) dict
-          let vm = initialize o.fuel dict builtins
-          vm' <- runWord ext o.entrypoint vm
-          writeEval opts vm'.stack vm'.effects
-    )
-    [ Handler \(e :: Syn.ParseError) -> writeError opts e
-    , Handler \(e :: RuntimeError Spanning) -> writeError opts e
-    , Handler \(e :: TypeError Spanning) -> writeError opts e
-    ]