nand2tetris/app/VMCompiler.hs

{-# LANGUAGE OverloadedStrings #-}

module Main (main) where

import           Control.Monad         (forM, forM_)
import qualified Data.Text             as T
import qualified Data.Text.IO          as TIO
import           Nand2Tetris.Hack      (AsmLine (..), HackInstruction (..),
                                        canonicalRepresentation)
import           Nand2Tetris.VM        (AnnotatedAsmLine (..),
                                        bootstrapPreamble, compileInstructions,
                                        parseInstructions)
import           Options.Applicative   (argument, execParser, fullDesc, header,
                                        help, helper, info, long, metavar,
                                        progDesc, short, some, str, strOption,
                                        (<**>))
import           System.FilePath       (takeBaseName)
import           System.IO             (IOMode (WriteMode), hPutStrLn, withFile)
import           Text.Megaparsec       (runParser)
import           Text.Megaparsec.Error (ParseErrorBundle,
                                        ShowErrorComponent (showErrorComponent),
                                        errorBundlePretty)

data Options =
  Options
  {
    inputFiles :: [FilePath],
    outputFile :: FilePath
  }

main :: IO ()
main = do
  options <- execParser opts
  parsed <- mconcat <$> forM (inputFiles options) (\fname -> do
    txt <- TIO.readFile fname
    let result = runParser (parseInstructions (T.pack . takeBaseName $ fname)) fname txt
    case result of
      Left err -> putStrLn (errorBundlePretty err) >> return []
      Right p  -> return p)
  let compiled = bootstrapPreamble <> compileInstructions parsed
  withFile (outputFile options) WriteMode $ \h -> forM_ (compiled) (\x -> TIO.hPutStrLn h (printLine x))

  where
    printLine (Comment t) = "// " <> t
    printLine (Code i)    = canonicalRepresentation (LineInstruction i)
    printLine (ALabel l)  = canonicalRepresentation (LineLabel l)

    opts = info (hackAsmOptParser <**> helper)
             ( fullDesc
            <> progDesc "Compiles Hack VM code to Hack assembly"
            <> header "vmcompiler - Hack VM compiler (nand2tetris)" )
    hackAsmOptParser = Options <$>
      some (argument str (help "Input files" )) <*>
      strOption ( long "output"
               <> short 'o'
               <> metavar "FILENAME"
               <> help "Output file" )