{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE ViewPatterns #-}
module Main
  (main)
  where

import qualified Gyehoek.ANF.Syntax as ANF
import Gyehoek.QBE (render)
import Gyehoek.Options
import qualified Data.Text.IO as TIO
import Data.Text (Text)
import Prelude hiding (readFile, (.),id)
import Control.Category
import Options.Applicative
import Control.Lens
import Data.Generics.Labels
import System.OsPath (OsPath)
import System.FilePath ((-<.>), dropExtension)
import Effectful.FileSystem
import Effectful
import Effectful.FileSystem.IO qualified as FS
import Effectful.FileSystem.IO.ByteString qualified as FB
import Gyehoek.GenSym (runGenSym, GenSym, gensym, gensym')
import qualified Gyehoek.Sexp as Sexp
import Data.Text.Lens
import Data.List (List)
import qualified Gyehoek.Scheme.Syntax as Scm
import Effectful.Exception
import qualified Gyehoek.QBE as QBE
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import System.IO (Handle)
import Data.List.NonEmpty (NonEmpty)
import qualified Cradle as C


main :: IO ()
main = do
  opts <- execParser $ info (helper <*> parser) fullDesc
  runEff . runFileSystem . runGenSym . driver $ opts



hPutStr :: FileSystem :> es => Handle -> Text -> Eff es ()
hPutStr h = FB.hPutStr h . T.encodeUtf8

hPutStrLn :: FileSystem :> es => Handle -> Text -> Eff es ()
hPutStrLn h = FB.hPutStrLn h . T.encodeUtf8

hGetContents :: FileSystem :> es => Handle -> Eff es Text
hGetContents h = T.decodeUtf8 <$> FB.hGetContents h

readFile :: FileSystem :> es => FilePath -> Eff es Text
readFile f = FS.withFile f FS.ReadMode hGetContents

readScm :: FileSystem :> es => FilePath -> Eff es (List Scm.Exp)
readScm f = (Sexp.parseSexps f <$> readFile f) >>= either error pure

toANF
  :: (GenSym :> es, FileSystem :> es)
  => FilePath -> List Scm.Exp -> Eff es (List ANF.Exp)
toANF f exps = do
  anfs <- traverse ANF.toANF exps
  case traverse Sexp.encode anfs of
    Left e -> hPutStr FS.stderr (view packed e)
    Right ss -> do
      let anf_file = f -<.> "anf"
      FS.withFile anf_file FS.WriteMode \h_anf -> do
        hPutStr h_anf ";;; -*- mode:scheme -*-\n\n"
        hPutStr h_anf $ foldr (\x y -> x <> "\n\n" <> y) "" ss
      hPutStrLn FS.stderr $ "wrote " <> T.pack anf_file
  pure anfs

toQBE
  :: (GenSym :> es, FileSystem :> es, Traversable t)
  => FilePath -> t ANF.Exp -> Eff es QBE.Program
toQBE f anfs = do
  p <- ANF.lowerProgram anfs
  let qbe_file = f -<.> "ssa"
  FS.withFile qbe_file FS.WriteMode \h -> do
    hPutStr h . render $ p
  hPutStrLn FS.stderr $ "wrote " <> T.pack qbe_file
  pure p

callQBE
  :: (GenSym :> es, FileSystem :> es, IOE :> es)
  => FilePath -> Eff es FilePath
callQBE f = do
  let asm_file = f -<.> "s"
      qbe_file = f -<.> "ssa"
  C.StdoutUntrimmed stdout <-
    C.run $ C.cmd "qbe" & C.addArgs [qbe_file]
  FS.withFile asm_file FS.WriteMode \h -> do
    hPutStr h stdout
  hPutStrLn FS.stderr $ "wrote " <> T.pack asm_file
  pure asm_file

callGCC
  :: (GenSym :> es, FileSystem :> es, IOE :> es)
  => FilePath -> List String -> Eff es FilePath
callGCC f args = do
  let asm_file = f -<.> "s"
      exe = f -<.> "out"
  C.StdoutTrimmed (T.words -> flags) <-
    C.run $ C.cmd "pkg-config"
          & C.addArgs @String ["--cflags", "--libs", "bdw-gc"]
  C.run_ $ C.cmd "cc"
         & C.addArgs flags
         & C.addArgs ["-o", exe, asm_file]
         & C.addArgs args
  hPutStrLn FS.stderr $ "wrote " <> T.pack exe
  pure exe

driver
  :: (GenSym :> es, FileSystem :> es, IOE :> es)
  => Options -> Eff es ()
driver = runGenSym . traverseOf_ (#sourceFiles . folded) \f -> do
  exps <- readScm f
  anfs <- toANF f exps
  qbe <- toQBE f anfs
  callQBE f
  callGCC f ["../runtime/target/debug/libgyehoek.a"]
  pure ()