{-# LANGUAGE OverloadedLabels #-}
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 ((-<.>))
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 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)


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

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
      hPutStr FS.stderr $ "wrote " <> T.pack anf_file
  pure anfs

driver :: (GenSym :> es, FileSystem :> es) => Options -> Eff es ()
driver = runGenSym . traverseOf_ (#sourceFiles . folded) \f -> do
  exps <- readScm f
  anfs <- toANF f exps
  pure ()