module Main

-- import Control.App
import Control.Monad.Error.Either
import Control.Monad.Error.Interface
import Control.Monad.State
import Data.List
import Data.String
import Data.Vect
import Data.IORef
-- import Lib.Elab
import Lib.Compile
import Lib.Parser
import Lib.Parser.Impl
import Lib.Prettier
import Lib.ProcessDecl
import Lib.Token
import Lib.Tokenizer
import Lib.TopContext
import Lib.Types
import Lib.Syntax
import Lib.Syntax
import System
import System.Directory
import System.File
import System.Path

fail : String -> M a
fail msg = putStrLn msg >> exitFailure

dumpContext : TopContext -> M ()
dumpContext top = do
    putStrLn "Context:"
    go top.defs
    putStrLn "---"
  where
    go : List TopEntry -> M ()
    go [] = pure ()
    go (x :: xs) = putStrLn "    \{show x}" >> go xs

writeSource : String -> M ()
writeSource fn = do
  docs <- compile
  let src = unlines $
        [ "#!/usr/bin/env node"
        ,  "const PiType = (h0, h1) => ({ tag: \"PiType\", h0, h1 })" ]
        ++ map (render 90) docs
        ++ [ "main();" ]
  Right _ <- writeFile fn src
    | Left err => fail (show err)
  Right _ <- chmodRaw fn 493 | Left err => fail (show err)
  pure ()

||| New style loader, one def at a time
processModule : String -> List String -> String -> M String
processModule base stk name = do
  top <- get
  let False := elem name top.loaded | _ => pure ""
  modify { loaded $= (name::) }
  let fn = base ++ "/" ++ name ++ ".newt"
  Right src <- readFile $ fn
    | Left err => fail (show err)
  let Right toks = tokenise src
    | Left err => fail (showError src err)

  let Right (modName, ops, toks) := partialParse parseModHeader top.ops toks
    | Left err => fail (showError src err)


  putStrLn "module \{modName}"
  let True = name == modName
    | _ => fail "ERROR at (0, 0): module name \{show modName} doesn't match file name \{show fn}"

  let Right (imports, ops, toks) := partialParse parseImports ops toks
    | Left err => fail (showError src err)

  for_ imports $ \ (MkImport fc name') => do
    -- we could use `fc` if it had a filename in it

    when (name' `elem` stk) $ error emptyFC "import loop \{show name} -> \{show name'}"
    processModule base (name :: stk) name'

  top <- get
  let Right (decls, ops, toks) := partialParse (manySame parseDecl) top.ops toks
    | Left err => fail (showError src err)
  let [] := toks
    | (x :: xs) =>
        fail (showError src (E (startBounds x.bounds) "extra toks")) -- FIXME FC from xs
  modify { ops := ops }

  putStrLn "process Decls"
  Right _ <- tryError $ traverse_ processDecl (collectDecl decls)
    | Left y => fail (showError src y)

  pure src

processFile : String -> M ()
processFile fn = do
  putStrLn "*** Process \{fn}"
  let parts = splitPath fn
  let file = fromMaybe "" $ last' parts
  let dir = fromMaybe "./" $ parent fn
  let (name,ext) = splitFileName (fromMaybe "" $ last' parts)
  putStrLn "\{show dir} \{show name} \{show ext}"

  src <- processModule dir [] name
  top <- get
  -- dumpContext top

  [] <- readIORef top.errors
    | errors => do
      for_ errors $ \err =>
        putStrLn (showError src err)
      exitFailure
  pure ()

cmdLine : List String -> M (Maybe String, List String)
cmdLine [] = pure (Nothing, [])
cmdLine ("-v" :: args) = do
  modify { verbose := True }
  cmdLine args
cmdLine ("-o" :: fn :: args) = do
  (out, files) <- cmdLine args
  pure (out <|> Just fn, files)

cmdLine (fn :: args) = do
  let True := ".newt" `isSuffixOf` fn
    | _ => error emptyFC "Bad argument \{show fn}"
  (out, files) <- cmdLine args
  pure $ (out, fn :: files)

main' : M ()
main' = do
  (arg0 :: args) <- getArgs
    | _ => error emptyFC "error reading args"
  (out, files) <- cmdLine args
  traverse_ processFile files
  case out of
    Nothing => pure ()
    Just name => writeSource name
  -- traverse_ processFile (filter (".newt" `isSuffixOf`) files) out

%export "javascript:newtMain"
main : IO ()
main = do
  -- we'll need to reset for each file, etc.
  ctx <- empty
  Right _  <- runEitherT $ runStateT ctx $ main'
    | Left (E (c, r) str) => do
        putStrLn "ERROR at (\{show c}, \{show r}): \{show str}"
        exitFailure
  putStrLn "done"