juvix/app/Main.hs

{-# LANGUAGE ApplicativeDo #-}
module Main (main) where

import MiniJuvix.Utils.Prelude
import qualified MiniJuvix.Syntax.Concrete.Parser as M
import qualified MiniJuvix.Syntax.Concrete.Scoped.Scoper as M
import qualified MiniJuvix.Syntax.Concrete.Scoped.Pretty.Ansi as M
import qualified MiniJuvix.Syntax.Concrete.Scoped.Pretty.Base as M
import Options.Applicative
import Options.Applicative.Help.Pretty
import MiniJuvix.Syntax.Concrete.Scoped.Pretty.Base (Options(_optShowNameId))

data Command =
  Scope ScopeOptions
  | Parse ParseOptions

data ScopeOptions = ScopeOptions {
  _scopeRootDir :: FilePath
  , _scopeInputFile :: FilePath
  , _scopeShowIds :: Bool
  }

data ParseOptions = ParseOptions

parseScope :: Parser ScopeOptions
parseScope = do
  _scopeRootDir <- strOption
    (long "rootDir"
     <> short 'd'
     <> metavar "DIR"
     <> value "."
     <> showDefault
     <> help "Root directory")
  _scopeInputFile <- argument str
     (metavar "MINIJUVIX_FILE"
     <> help "Path to a .mjuvix file"
     )
  _scopeShowIds <- switch
     ( long "show-name-ids"
     <> help "Show the unique number of each identifier"
     )

  pure ScopeOptions {..}

parseParse :: Parser ParseOptions
parseParse = pure ParseOptions

descr :: ParserInfo Command
descr = info (parseCommand <**> helper)
       (fullDesc
        <> progDesc "The MiniJuvix compiler."
        <> headerDoc (Just $ dullblue $ bold $ underline "MiniJuvix help")
        <> footerDoc (Just foot)
       )
  where
  foot :: Doc
  foot = bold "maintainers: " <> "jan@heliax.dev; jonathan@heliax.dev"

parseCommand :: Parser Command
parseCommand = subparser (
   command "parse" (info (Parse <$> parseParse) (progDesc "Parse some .mjuvix files"))
   <> command "scope" (info (Scope <$> parseScope) (progDesc "Parse and scope some .mjuvix files"))
                    )

mkPrettyOptions :: ScopeOptions -> M.Options
mkPrettyOptions ScopeOptions {..} = M.defaultOptions {
  _optShowNameId = _scopeShowIds
  }

go :: Command -> IO ()
go c = case c of
  Scope opts@ScopeOptions {..} -> do
    res <- M.runModuleParserIO _scopeInputFile
    case res of
      Left err -> print err
      Right m -> do
        print m
        putStrLn "\n\n"
        s <- M.scopeCheck _scopeInputFile [m]
        case s of
          Left err -> print err
          Right [r] -> M.printTopModule (mkPrettyOptions opts) r
          Right _ -> error "impossible"
  Parse _ -> putStrLn "not implemented"

main :: IO ()
main = execParser descr >>= go