module Gyehoek.Driver
  (main, lower_e2e, convert_e2e, parse_e2e, readScm, eval_e2e)
  where

import Gyehoek.Options
import Data.Text (Text)
import Prelude hiding (readFile)
import Options.Applicative
import Control.Lens
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)
import qualified Gyehoek.Sexp as Sexp
import qualified Gyehoek.Scheme.Syntax as Scm
import qualified Data.Text.Encoding as T
import System.IO (Handle)
import System.IO qualified as IO
import Gyehoek.CPS.Convert
import Gyehoek.CPS.Lower
import Gyehoek.CPS.Syntax qualified as Cps
import Control.Monad
import Text.Pretty.Simple (pShowNoColor)
import System.Process.Typed
import Data.Text.Encoding (encodeUtf8)
import System.Environment.Blank (getEnvDefault)
import GHC.Conc (atomically)
import qualified Data.Text.IO as TIO
import qualified Data.ByteString.Lazy as BS
import Gyehoek.CPS.Stackify (stackifyProgram)
import Text.Pretty.Simple (pShow)
import Gyehoek.Stack.VM (eval, writeObj, Obj)
import qualified Data.Text as T
import Data.List (List)
import Gyehoek.Stack.Syntax (encodeProgram)
import Effectful.Exception


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

withFile
  :: (FileSystem :> es)
  => FilePath -> FS.IOMode -> (Handle -> Eff es a) -> Eff es a
withFile "-" FS.ReadMode k = k FS.stdin
withFile "-" (FS.WriteMode; FS.AppendMode) k = k FS.stdout
withFile f m k = FS.withFile f m k

fileName :: FilePath -> FilePath
fileName "-" = "<interactive>"
fileName e = e

readScm :: FileSystem :> es => FilePath -> Eff es Scm.Program
readScm f =
  withFile f FS.ReadMode $ \h ->
    Sexp.parseSexps @Scm.CommandOrDef (fileName f) <$> hGetContents h
     >>= either error (pure . Scm.MkProgram)

inspectWasm :: IOE :> es => Text -> Eff es ()
inspectWasm wat = do
  pager_cmd <- liftIO $ getEnvDefault "PAGER" "less"
  let wasmtools_cfg
        = proc "wasm-tools" ["print", "-pf", "--print-operand-stack"
                            ,"--color", "always", "-"]
          -- & setStdin (byteStringInput . view lazy . encodeUtf8 $ wat)
          -- & setStdout byteStringOutput
          & setStdin createPipe
          & setStdout createPipe
          & setStderr inherit
  let pager_cfg = proc pager_cmd []
                & setStdin createPipe
                & setStdout inherit
                & setStderr inherit
  liftIO $ withProcessWait_ wasmtools_cfg \wasmtools -> do
    TIO.hPutStrLn (getStdin wasmtools) wat
    IO.hFlush (getStdin wasmtools)
    IO.hClose (getStdin wasmtools)
    withProcessWait_ pager_cfg \pager -> do
      t <- BS.hGetContents (getStdout wasmtools)
      BS.hPut (getStdin pager) t
      IO.hFlush (getStdin pager)
      IO.hClose (getStdin pager)

driver
  :: (GenSym :> es, FileSystem :> es, IOE :> es)
  => Options -> Eff es ()
driver opts = do
  scm <- readScm opts.sourceFile
  when opts.dumpParsed do
    hPutStrLn FS.stdout . view strict . pShowNoColor $ scm
  cps <- convertProgram scm
  when opts.dumpCPS do
    hPutStrLn FS.stdout $ Sexp.encodePretty cps ^?! _Right
  stk <- stackifyProgram cps
  if opts.dumpStackified then do
    hPutStrLn FS.stdout . encodeProgram $ stk
  else if opts.stackify then do
    eval stk & fmap writeObj
             & T.unwords
             & hPutStrLn FS.stdout
  else do
    wat <- lowerProgram cps
    withFile opts.output FS.WriteMode \h ->
      hPutStrLn h wat
    when opts.inspectWasm do
      inspectWasm wat

parse_e2e :: FilePath -> IO Scm.Program
parse_e2e = runEff . runFileSystem . readScm

convert_e2e :: FilePath -> IO Cps.Program
convert_e2e = runEff . runFileSystem . runGenSym . (convertProgram <=< readScm)

lower_e2e :: FilePath -> IO Text
lower_e2e =
  runEff . runFileSystem . runGenSym
  . (lowerProgram <=< convertProgram <=< readScm)

eval_e2e :: FilePath -> IO (List Obj)
eval_e2e fp = runEff . runFileSystem . runGenSym $ do
  stk <- stackifyProgram <=< convertProgram <=< readScm $ fp
  pure . eval $ stk