{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE OrPatterns #-}
module Main
  (main)
  where

import Gyehoek.Options
import qualified Data.Text.IO as TIO
import Data.Text (Text)
import Prelude hiding (readFile)
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 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
import Gyehoek.CPS.Convert
import Gyehoek.CPS.Lower
import Data.Foldable
import qualified Gyehoek.Scheme.Syntax
import Gyehoek.CPS.Syntax
import Data.Maybe (fromMaybe)


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

readScm :: FileSystem :> es => FilePath -> Eff es Scm.Exp
readScm f =
  withFile f FS.ReadMode $ \h ->
    Sexp.parseSexps f <$> hGetContents h
     >>= either error wrap
  where
    wrap [x] = pure x
    wrap xs = pure . Gyehoek.Scheme.Syntax.ExpBegin $ xs

driver
  :: (GenSym :> es, FileSystem :> es, IOE :> es)
  => Options -> Eff es ()
driver opts = do
  scm <- readScm opts.sourceFile
  cps <- convert scm (pure . Halt1)
  wat <- lower cps
  withFile opts.output FS.WriteMode \h ->
    hPutStr h wat