module Lib.ProcessModule

import Prelude
import Lib.Types
import Lib.Common
import Lib.Syntax
import Lib.ProcessDecl
import Lib.TopContext
import Lib.Tokenizer
import Data.SortedMap
import Lib.Parser.Impl
import Lib.Parser
import Data.List1
import Lib.Elab

-- declare internal primitives
addPrimitives : M ModContext
addPrimitives = do
  processDecl primNS (PType emptyFC "Int" Nothing)
  processDecl primNS (PType emptyFC "String" Nothing)
  processDecl primNS (PType emptyFC "Char" Nothing)
  setDef (QN primNS "PiType") emptyFC (Erased emptyFC) (PrimFn "(h0, h1) => ({ tag: \"PiType\", h0, h1 });" (S (S Z)) Nil) Nil
  top <- getTop
  let mod = MkModCtx "" top.defs (MC emptyMap Nil 0 CheckAll) top.ops Nil top.errors
  let modules = updateMap primNS mod top.modules
  -- TODO - do we clear this? Try just modules := modules, but wait until this refactor is done.
  modifyTop [ modules := modules
      ; imported := primNS :: Nil
      ; hints := emptyMap
      ; ns := ""
      ; defs := emptyMap
      ]
  pure mod

record FileSource where
  getFile : FC → String → M (String × String)

parseDecls : String → Operators → TokenList → SnocList Decl → M (List Decl × Operators)
parseDecls fn ops Nil acc = pure (acc <>> Nil, ops)
parseDecls fn ops toks@(first :: _) acc =
  case partialParse fn (sameLevel parseDecl) ops toks of
    Left (err, toks) => do
      addError err
      parseDecls fn ops (recover toks) acc
    Right (decl,ops,toks) => parseDecls fn ops toks (acc :< decl)
  where
    recover : TokenList → TokenList
    recover Nil = Nil
    -- skip to top token, but make sure there is progress
    recover (tok :: toks) = if tok.bounds.startCol == 0 && tok.bounds /= first.bounds
      then (tok :: toks)
      else recover toks

importToName : Import → List String
importToName  (MkImport fc (_,name)) = split name "."

importHints : List TopEntry → M Unit
importHints Nil = pure MkUnit
importHints (entry :: entries) = do
  when (elem Hint entry.eflags) $ \ _ => addHint entry.name
  importHints entries

-- HACK this is returning src to help render errors..
-- Maybe return module, put src and errors in module, add error for import with error, callers can sort out what they want to do?
-- The issue here is command line newt wants to report all errors (we can print that though?)  LSP wants something more subtle
processModule : FC → FileSource → List String → String → M ModContext
processModule importFC repo stk modns = do
  top <- getTop

  let (Nothing) = lookupMap' modns top.modules
    | Just mod => pure mod

  let (False) = modns == primNS
    | _ => addPrimitives
  let parts = split modns "."
  let fn = joinBy "/" parts ++ ".newt"
  -- TODO now we can pass in the module name...
  (fn,src) <- repo.getFile importFC fn
  let (Right toks) = tokenise fn src
    | Left err => throwError err

  let (Right ((nameFC, modName), ops, toks)) = partialParse fn parseModHeader top.ops toks
    | Left (err, toks) => throwError err

  log 1 $ \ _ => "scan imports for module \{modName}"
  let (True) = modns == modName
    | _ => throwError $ E nameFC "module name \{show modName} doesn't match file name \{show fn}"

  let (Right (imports, ops, toks)) = partialParse fn parseImports ops toks
    | Left (err, toks) => throwError err

  imported <- for imports $ \case
    MkImport fc (nameFC, name') => do
      when (elem name' stk) $ \ _ => error nameFC "import loop \{modns} → \{name'}"
      processModule nameFC repo (modns :: stk) name'
      pure $ name'
  processModule nameFC repo (modns :: stk) primNS
  let imported = snoc imported primNS

  putStrLn "module \{modName}"

  log 1 $ \ _ => "MODNS " ++ show modns
  top <- getTop
  (decls, ops) <- parseDecls fn top.ops toks Lin

  top <- getTop
  let freshMC = MC emptyMap Nil 0 CheckAll
  -- NOW Print and drop errors here
  -- set imported, mod, freshMC, ops  before processing
  modifyTop [ imported := imported
            ; hints := emptyMap
            ; ns := modns
            ; defs := emptyMap
            ; metaCtx := freshMC
            ; ops := ops
            ]
  for imported $ \ ns => do
    let (Just mod) = lookupMap' ns top.modules | _ => error emptyFC "namespace \{show ns} missing"
    importHints (listValues mod.modDefs)

  log 1 $ \ _ => "process Decls"
  traverse (tryProcessDecl src modns) (collectDecl decls)

  -- update modules with result, leave the rest of context in case this is top file
  top <- getTop

  let mod = MkModCtx src top.defs top.metaCtx top.ops imported top.errors

  let modules = updateMap modns mod top.modules
  modifyTop [modules := modules]

  logMetas $ reverse $ listValues top.metaCtx.metas
  -- FIXME module context should hold errors, to report in replay
  pure mod
  where
    tryProcessDecl : String → String → Decl → M Unit
    tryProcessDecl src ns decl = do
      (Left err) <- tryError $ processDecl ns decl | _ => pure MkUnit
      addError err

-- NOW TODO clear dependents too.
invalidateModule : String -> M Unit
invalidateModule modname = modifyTop [modules $= deleteMap modname]