content: {-# LANGUAGE BangPatterns #-}
  {-# LANGUAGE GADTs #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# OPTIONS_GHC -Wno-unused-do-bind #-}
  
  module Build
    ( fromExposed,
      fromPaths,
      fromMainModules,
      fromRepl,
      Artifacts (..),
      Root (..),
      Module (..),
      CachedInterface (..),
      ReplArtifacts (..),
      DocsGoal (..),
      getRootNames,
      Source (..),
      Sources,
    )
  where
  
  import AST.Canonical qualified as Can
  import AST.Optimized qualified as Opt
  import AST.Source qualified as Src
  import AbsoluteSrcDir (AbsoluteSrcDir (..))
  import AbsoluteSrcDir qualified
  import Compile qualified
  import Control.Concurrent (forkIO)
  import Control.Concurrent.MVar
  import Control.Monad (filterM)
  import Data.ByteString qualified as B
  import Data.ByteString.Internal (ByteString)
  import Data.Char qualified as Char
  import Data.Graph qualified as Graph
  import Data.List qualified as List
  import Data.Map (Map)
  import Data.Map.Strict ((!))
  import Data.Map.Strict qualified as Map
  import Data.Map.Utils qualified as Map
  import Data.Maybe qualified as Maybe
  import Data.Name qualified as Name
  import Data.NonEmptyList qualified as NE
  import Data.OneOrMore qualified as OneOrMore
  import Data.Set qualified as Set
  import Directories qualified as Dirs
  import File qualified
  import Gren.Details qualified as Details
  import Gren.Docs qualified as Docs
  import Gren.Interface qualified as I
  import Gren.ModuleName qualified as ModuleName
  import Gren.Outline qualified as Outline
  import Gren.Package qualified as Pkg
  import Gren.Platform qualified as P
  import Json.Encode qualified as E
  import Parse.Module qualified as Parse
  import Reporting qualified
  import Reporting.Annotation qualified as A
  import Reporting.Error qualified as Error
  import Reporting.Error.Docs qualified as EDocs
  import Reporting.Error.Import qualified as Import
  import Reporting.Error.Syntax qualified as Syntax
  import Reporting.Exit qualified as Exit
  import Reporting.Render.Type.Localizer qualified as L
  import System.Directory qualified as Dir
  import System.FilePath ((<.>))
  import System.FilePath qualified as FP
  
  -- ENVIRONMENT
  
  data Env = Env
    { _key :: Reporting.BKey,
      _root :: FilePath,
      _project :: Parse.ProjectType,
      _platform :: P.Platform,
      _srcDirs :: [AbsoluteSrcDir],
      _locals :: Map.Map ModuleName.Raw Details.Local,
      _foreigns :: Map.Map ModuleName.Raw Details.Foreign
    }
  
  makeEnv :: Reporting.BKey -> FilePath -> Details.Details -> IO Env
  makeEnv key root (Details.Details _ validOutline _ locals foreigns _) =
    case validOutline of
      Details.ValidApp platform givenSrcDirs ->
        do
          srcDirs <- traverse (Outline.toAbsoluteSrcDir root) (NE.toList givenSrcDirs)
          return $ Env key root Parse.Application platform srcDirs locals foreigns
      Details.ValidPkg platform pkg _ ->
        do
          srcDir <- Outline.toAbsoluteSrcDir root (Outline.RelativeSrcDir "src")
          return $ Env key root (Parse.Package pkg) platform [srcDir] locals foreigns
  
  -- FORK
  
  -- PERF try using IORef semephore on file crawl phase?
  -- described in Chapter 13 of Parallel and Concurrent Programming in Haskell by Simon Marlow
  -- https://www.oreilly.com/library/view/parallel-and-concurrent/9781449335939/ch13.html#sec_conc-par-overhead
  --
  fork :: IO a -> IO (MVar a)
  fork work =
    do
      mvar <- newEmptyMVar
      _ <- forkIO $ putMVar mvar =<< work
      return mvar
  
  forkWithKey :: (k -> a -> IO b) -> Map.Map k a -> IO (Map.Map k (MVar b))
  forkWithKey func dict =
    Map.traverseWithKey (\k v -> fork (func k v)) dict
  
  -- FROM EXPOSED
  
  data Source = Source
    { _source_path :: FilePath,
      _source_data :: ByteString
    }
    deriving (Show)
  
  type Sources = Map ModuleName.Raw Source
  
  fromExposed :: Reporting.Style -> FilePath -> Details.Details -> Sources -> DocsGoal docs -> NE.List ModuleName.Raw -> IO (Either Exit.BuildProblem docs)
  fromExposed style root details sources docsGoal exposed@(NE.List e es) =
    Reporting.trackBuild style $ \key ->
      do
        env <- makeEnv key root details
        dmvar <- Details.loadInterfaces root details
  
        -- crawl
        mvar <- newEmptyMVar
        let docsNeed = toDocsNeed docsGoal
        roots <- Map.fromKeysA (fork . crawlModule env mvar sources docsNeed) (e : es)
        putMVar mvar roots
        mapM_ readMVar roots
        statuses <- traverse readMVar =<< readMVar mvar
  
        -- compile
        midpoint <- checkMidpoint dmvar statuses
        case midpoint of
          Left problem ->
            return (Left (Exit.BuildProjectProblem problem))
          Right foreigns ->
            do
              rmvar <- newEmptyMVar
              resultMVars <- forkWithKey (checkModule env foreigns rmvar) statuses
              putMVar rmvar resultMVars
              results <- traverse readMVar resultMVars
              writeDetails root details results
              finalizeExposed root docsGoal exposed results
  
  -- FROM PATHS
  
  data Artifacts = Artifacts
    { _name :: Pkg.Name,
      _deps :: Dependencies,
      _roots :: NE.List Root,
      _modules :: [Module]
    }
  
  data Module
    = Fresh ModuleName.Raw I.Interface Opt.LocalGraph
    | Cached ModuleName.Raw Bool (MVar CachedInterface)
  
  type Dependencies =
    Map.Map ModuleName.Canonical I.DependencyInterface
  
  fromPaths :: Reporting.Style -> FilePath -> Details.Details -> Sources -> NE.List FilePath -> IO (Either Exit.BuildProblem Artifacts)
  fromPaths style root details sources paths =
    Reporting.trackBuild style $ \key ->
      do
        env <- makeEnv key root details
  
        elroots <- findRoots env paths
        case elroots of
          Left problem ->
            return (Left (Exit.BuildProjectProblem problem))
          Right lroots ->
            do
              -- crawl
              dmvar <- Details.loadInterfaces root details
              smvar <- newMVar Map.empty
              srootMVars <- traverse (fork . crawlRoot env smvar sources) lroots
              sroots <- traverse readMVar srootMVars
              statuses <- traverse readMVar =<< readMVar smvar
  
              midpoint <- checkMidpointAndRoots dmvar statuses sroots
              case midpoint of
                Left problem ->
                  return (Left (Exit.BuildProjectProblem problem))
                Right foreigns ->
                  do
                    -- compile
                    rmvar <- newEmptyMVar
                    resultsMVars <- forkWithKey (checkModule env foreigns rmvar) statuses
                    putMVar rmvar resultsMVars
                    rrootMVars <- traverse (fork . checkRoot) sroots
                    results <- traverse readMVar resultsMVars
                    writeDetails root details results
                    toArtifacts env foreigns results <$> traverse readMVar rrootMVars
  
  fromMainModules :: Reporting.Style -> FilePath -> Details.Details -> Sources -> NE.List ModuleName.Raw -> IO (Either Exit.BuildProblem Artifacts)
  fromMainModules style root details sources rootModules =
    Reporting.trackBuild style $ \key ->
      do
        env <- makeEnv key root details
  
        -- crawl
        dmvar <- Details.loadInterfaces root details
        smvar <- newMVar Map.empty
        srootMVars <- traverse (fork . crawlRootModule env smvar sources) rootModules
        sroots <- traverse readMVar srootMVars
        statuses <- traverse readMVar =<< readMVar smvar
  
        midpoint <- checkMidpointAndRoots dmvar statuses sroots
        case midpoint of
          Left problem ->
            return (Left (Exit.BuildProjectProblem problem))
          Right foreigns ->
            do
              -- compile
              rmvar <- newEmptyMVar
              resultsMVars <- forkWithKey (checkModule env foreigns rmvar) statuses
              putMVar rmvar resultsMVars
              rrootMVars <- traverse (fork . checkRoot) sroots
              results <- traverse readMVar resultsMVars
              writeDetails root details results
              toArtifacts env foreigns results <$> traverse readMVar rrootMVars
  
  -- GET ROOT NAMES
  
  getRootNames :: Artifacts -> NE.List ModuleName.Raw
  getRootNames (Artifacts _ _ roots _) =
    fmap getRootName roots
  
  getRootName :: Root -> ModuleName.Raw
  getRootName root =
    case root of
      Inside name -> name
      Outside name _ _ -> name
  
  -- CRAWL
  
  type StatusDict =
    Map.Map ModuleName.Raw (MVar Status)
  
  data Status
    = SCached Details.Local
    | SChanged Details.Local B.ByteString Src.Module DocsNeed
    | SBadImport Import.Problem
    | SBadSyntax FilePath B.ByteString Syntax.Error
    | SForeign Pkg.Name
    | SKernel
  
  crawlDeps :: Env -> MVar StatusDict -> Sources -> [ModuleName.Raw] -> a -> IO a
  crawlDeps env mvar sources deps blockedValue =
    do
      statusDict <- takeMVar mvar
      let depsDict = Map.fromKeys (\_ -> ()) deps
      let newsDict = Map.difference depsDict statusDict
      statuses <- Map.traverseWithKey crawlNew newsDict
      putMVar mvar (Map.union statuses statusDict)
      mapM_ readMVar statuses
      return blockedValue
    where
      crawlNew name () = fork (crawlModule env mvar sources (DocsNeed False) name)
  
  crawlRootModuleHelp :: Env -> MVar StatusDict -> Sources -> DocsNeed -> ModuleName.Raw -> IO Status
  crawlRootModuleHelp env@(Env _ _ _ _ _ locals _) mvar sources docsNeed name =
    case Map.lookup name sources of
      Just source ->
        if Name.isKernel name
          then return $ SBadImport Import.NotFound
          else case Map.lookup name locals of
            Nothing ->
              crawlFile env mvar sources docsNeed name source
            Just local@(Details.Local _ deps _) ->
              crawlDeps env mvar sources deps (SCached local)
      Nothing ->
        return $ SBadImport Import.NotFound
  
  crawlModule :: Env -> MVar StatusDict -> Sources -> DocsNeed -> ModuleName.Raw -> IO Status
  crawlModule env@(Env _ _ projectType _ _ locals foreigns) mvar sources docsNeed name =
    case Map.lookup name sources of
      Just source ->
        case Map.lookup name foreigns of
          Just (Details.Foreign dep deps) ->
            return $ SBadImport $ Import.Ambiguous (_source_path source) [] dep deps
          Nothing ->
            if Name.isKernel name
              then
                if Parse.isKernel projectType
                  then return SKernel
                  else return $ SBadImport Import.NotFound
              else case Map.lookup name locals of
                Nothing ->
                  crawlFile env mvar sources docsNeed name source
                Just local@(Details.Local _ deps _) ->
                  crawlDeps env mvar sources deps (SCached local)
      Nothing ->
        case Map.lookup name foreigns of
          Just (Details.Foreign dep deps) ->
            case deps of
              [] ->
                return $ SForeign dep
              d : ds ->
                return $ SBadImport $ Import.AmbiguousForeign dep d ds
          Nothing ->
            return $ SBadImport Import.NotFound
  
  crawlFile :: Env -> MVar StatusDict -> Sources -> DocsNeed -> ModuleName.Raw -> Source -> IO Status
  crawlFile env@(Env _ _ projectType _ _ _ _) mvar sources docsNeed expectedName (Source path source) =
    case Parse.fromByteString projectType source of
      Left err ->
        return $ SBadSyntax path source err
      Right modul@(Src.Module maybeActualName _ _ imports values _ _ _ _ _ _) ->
        case maybeActualName of
          Nothing ->
            return $ SBadSyntax path source (Syntax.ModuleNameUnspecified expectedName)
          Just name@(A.At _ actualName) ->
            if expectedName == actualName
              then
                let deps = map (Src.getImportName . snd) imports
                    local = Details.Local path deps (any (isMain . snd) values)
                 in crawlDeps env mvar sources deps (SChanged local source modul docsNeed)
              else return $ SBadSyntax path source (Syntax.ModuleNameMismatch expectedName name)
  
  isMain :: A.Located Src.Value -> Bool
  isMain (A.At _ (Src.Value (A.At _ name) _ _ _ _)) =
    name == Name._main
  
  -- CHECK MODULE
  
  type ResultDict =
    Map.Map ModuleName.Raw (MVar Result)
  
  data Result
    = RNew !Details.Local !I.Interface !Opt.LocalGraph !(Maybe Docs.Module)
    | RSame !Details.Local !I.Interface !Opt.LocalGraph !(Maybe Docs.Module)
    | RCached Bool (MVar CachedInterface)
    | RNotFound Import.Problem
    | RProblem Error.Module
    | RBlocked
    | RForeign I.Interface
    | RKernel
  
  data CachedInterface
    = Unneeded
    | Loaded I.Interface
    | Corrupted
  
  checkModule :: Env -> Dependencies -> MVar ResultDict -> ModuleName.Raw -> Status -> IO Result
  checkModule env@(Env _ root projectType _ _ _ _) foreigns resultsMVar name status =
    case status of
      SCached local@(Details.Local path deps hasMain) ->
        do
          results <- readMVar resultsMVar
          depsStatus <- checkDeps root results deps
          case depsStatus of
            DepsChange ifaces ->
              do
                source <- File.readUtf8 path
                case Parse.fromByteString projectType source of
                  Right modul -> compile env (DocsNeed False) local source ifaces modul
                  Left err ->
                    return $
                      RProblem $
                        Error.Module name path source (Error.BadSyntax err)
            DepsSame _ _ ->
              do
                mvar <- newMVar Unneeded
                return (RCached hasMain mvar)
            DepsBlock ->
              return RBlocked
            DepsNotFound problems ->
              do
                source <- File.readUtf8 path
                return $
                  RProblem $
                    Error.Module name path source $
                      case Parse.fromByteString projectType source of
                        Right (Src.Module _ _ _ imports _ _ _ _ _ _ _) ->
                          Error.BadImports (toImportErrors env results imports problems)
                        Left err ->
                          Error.BadSyntax err
      SChanged local@(Details.Local path deps _) source modul@(Src.Module _ _ _ imports _ _ _ _ _ _ _) docsNeed ->
        do
          results <- readMVar resultsMVar
          depsStatus <- checkDeps root results deps
          case depsStatus of
            DepsChange ifaces ->
              compile env docsNeed local source ifaces modul
            DepsSame same cached ->
              do
                maybeLoaded <- loadInterfaces root same cached
                case maybeLoaded of
                  Nothing -> return RBlocked
                  Just ifaces -> compile env docsNeed local source ifaces modul
            DepsBlock ->
              return RBlocked
            DepsNotFound problems ->
              return $
                RProblem $
                  Error.Module name path source $
                    Error.BadImports (toImportErrors env results imports problems)
      SBadImport importProblem ->
        return (RNotFound importProblem)
      SBadSyntax path source err ->
        return $
          RProblem $
            Error.Module name path source $
              Error.BadSyntax err
      SForeign home ->
        case foreigns ! ModuleName.Canonical home name of
          I.Public iface -> return (RForeign iface)
          I.Private _ _ _ -> error $ "mistakenly seeing private interface for " ++ Pkg.toChars home ++ " " ++ ModuleName.toChars name
      SKernel ->
        return RKernel
  
  -- CHECK DEPS
  
  data DepsStatus
    = DepsChange (Map.Map ModuleName.Raw I.Interface)
    | DepsSame [Dep] [CDep]
    | DepsBlock
    | DepsNotFound (NE.List (ModuleName.Raw, Import.Problem))
  
  checkDeps :: FilePath -> ResultDict -> [ModuleName.Raw] -> IO DepsStatus
  checkDeps root results deps =
    checkDepsHelp root results deps [] [] [] [] False
  
  type Dep = (ModuleName.Raw, I.Interface)
  
  type CDep = (ModuleName.Raw, MVar CachedInterface)
  
  checkDepsHelp :: FilePath -> ResultDict -> [ModuleName.Raw] -> [Dep] -> [Dep] -> [CDep] -> [(ModuleName.Raw, Import.Problem)] -> Bool -> IO DepsStatus
  checkDepsHelp root results deps new same cached importProblems isBlocked =
    case deps of
      dep : otherDeps ->
        do
          result <- readMVar (results ! dep)
          case result of
            RNew _ iface _ _ ->
              checkDepsHelp root results otherDeps ((dep, iface) : new) same cached importProblems isBlocked
            RSame _ iface _ _ ->
              checkDepsHelp root results otherDeps new ((dep, iface) : same) cached importProblems isBlocked
            RCached _ mvar ->
              checkDepsHelp root results otherDeps new same ((dep, mvar) : cached) importProblems isBlocked
            RNotFound prob ->
              checkDepsHelp root results otherDeps new same cached ((dep, prob) : importProblems) True
            RProblem _ ->
              checkDepsHelp root results otherDeps new same cached importProblems True
            RBlocked ->
              checkDepsHelp root results otherDeps new same cached importProblems True
            RForeign iface ->
              checkDepsHelp root results otherDeps new ((dep, iface) : same) cached importProblems isBlocked
            RKernel ->
              checkDepsHelp root results otherDeps new same cached importProblems isBlocked
      [] ->
        case reverse importProblems of
          p : ps ->
            return $ DepsNotFound (NE.List p ps)
          [] ->
            if isBlocked
              then return DepsBlock
              else
                if null new
                  then return $ DepsSame same cached
                  else do
                    maybeLoaded <- loadInterfaces root same cached
                    case maybeLoaded of
                      Nothing -> return DepsBlock
                      Just ifaces -> return $ DepsChange $ Map.union (Map.fromList new) ifaces
  
  -- TO IMPORT ERROR
  
  toImportErrors :: Env -> ResultDict -> [([Src.Comment], Src.Import)] -> NE.List (ModuleName.Raw, Import.Problem) -> NE.List Import.Error
  toImportErrors (Env _ _ _ _ _ locals foreigns) results imports problems =
    let knownModules =
          Set.unions
            [ Map.keysSet foreigns,
              Map.keysSet locals,
              Map.keysSet results
            ]
  
        unimportedModules =
          Set.difference knownModules (Set.fromList (map (Src.getImportName . snd) imports))
  
        regionDict =
          Map.fromList (map (\(_, Src.Import (A.At region name) _ _ _ _) -> (name, region)) imports)
  
        toError (name, problem) =
          Import.Error (regionDict ! name) name unimportedModules problem
     in fmap toError problems
  
  -- LOAD CACHED INTERFACES
  
  loadInterfaces :: FilePath -> [Dep] -> [CDep] -> IO (Maybe (Map.Map ModuleName.Raw I.Interface))
  loadInterfaces root same cached =
    do
      loading <- traverse (fork . loadInterface root) cached
      maybeLoaded <- traverse readMVar loading
      case sequence maybeLoaded of
        Nothing ->
          return Nothing
        Just loaded ->
          return $ Just $ Map.union (Map.fromList loaded) (Map.fromList same)
  
  loadInterface :: FilePath -> CDep -> IO (Maybe Dep)
  loadInterface root (name, ciMvar) =
    do
      cachedInterface <- takeMVar ciMvar
      case cachedInterface of
        Corrupted ->
          do
            putMVar ciMvar cachedInterface
            return Nothing
        Loaded iface ->
          do
            putMVar ciMvar cachedInterface
            return (Just (name, iface))
        Unneeded ->
          do
            maybeIface <- File.readBinary (Dirs.greni root name)
            case maybeIface of
              Nothing ->
                do
                  putMVar ciMvar Corrupted
                  return Nothing
              Just iface ->
                do
                  putMVar ciMvar (Loaded iface)
                  return (Just (name, iface))
  
  -- CHECK PROJECT
  
  checkMidpoint :: MVar (Maybe Dependencies) -> Map.Map ModuleName.Raw Status -> IO (Either Exit.BuildProjectProblem Dependencies)
  checkMidpoint dmvar statuses =
    case checkForCycles statuses of
      Nothing ->
        do
          maybeForeigns <- readMVar dmvar
          case maybeForeigns of
            Nothing -> return (Left Exit.BP_CannotLoadDependencies)
            Just fs -> return (Right fs)
      Just (NE.List name names) ->
        do
          _ <- readMVar dmvar
          return (Left (Exit.BP_Cycle name names))
  
  checkMidpointAndRoots :: MVar (Maybe Dependencies) -> Map.Map ModuleName.Raw Status -> NE.List RootStatus -> IO (Either Exit.BuildProjectProblem Dependencies)
  checkMidpointAndRoots dmvar statuses sroots =
    case checkForCycles statuses of
      Nothing ->
        case checkUniqueRoots statuses sroots of
          Nothing ->
            do
              maybeForeigns <- readMVar dmvar
              case maybeForeigns of
                Nothing -> return (Left Exit.BP_CannotLoadDependencies)
                Just fs -> return (Right fs)
          Just problem ->
            do
              _ <- readMVar dmvar
              return (Left problem)
      Just (NE.List name names) ->
        do
          _ <- readMVar dmvar
          return (Left (Exit.BP_Cycle name names))
  
  -- CHECK FOR CYCLES
  
  checkForCycles :: Map.Map ModuleName.Raw Status -> Maybe (NE.List ModuleName.Raw)
  checkForCycles modules =
    let !graph = Map.foldrWithKey addToGraph [] modules
        !sccs = Graph.stronglyConnComp graph
     in checkForCyclesHelp sccs
  
  checkForCyclesHelp :: [Graph.SCC ModuleName.Raw] -> Maybe (NE.List ModuleName.Raw)
  checkForCyclesHelp sccs =
    case sccs of
      [] ->
        Nothing
      scc : otherSccs ->
        case scc of
          Graph.AcyclicSCC _ -> checkForCyclesHelp otherSccs
          Graph.CyclicSCC [] -> checkForCyclesHelp otherSccs
          Graph.CyclicSCC (m : ms) -> Just (NE.List m ms)
  
  type Node =
    (ModuleName.Raw, ModuleName.Raw, [ModuleName.Raw])
  
  addToGraph :: ModuleName.Raw -> Status -> [Node] -> [Node]
  addToGraph name status graph =
    let dependencies =
          case status of
            SCached (Details.Local _ deps _) -> deps
            SChanged (Details.Local _ deps _) _ _ _ -> deps
            SBadImport _ -> []
            SBadSyntax _ _ _ -> []
            SForeign _ -> []
            SKernel -> []
     in (name, name, dependencies) : graph
  
  -- CHECK UNIQUE ROOTS
  
  checkUniqueRoots :: Map.Map ModuleName.Raw Status -> NE.List RootStatus -> Maybe Exit.BuildProjectProblem
  checkUniqueRoots insides sroots =
    let outsidesDict =
          Map.fromListWith OneOrMore.more (Maybe.mapMaybe rootStatusToNamePathPair (NE.toList sroots))
     in case Map.traverseWithKey checkOutside outsidesDict of
          Left problem ->
            Just problem
          Right outsides ->
            case sequence_ (Map.intersectionWithKey checkInside outsides insides) of
              Right () -> Nothing
              Left problem -> Just problem
  
  rootStatusToNamePathPair :: RootStatus -> Maybe (ModuleName.Raw, OneOrMore.OneOrMore FilePath)
  rootStatusToNamePathPair sroot =
    case sroot of
      SInside _ -> Nothing
  
  checkOutside :: ModuleName.Raw -> OneOrMore.OneOrMore FilePath -> Either Exit.BuildProjectProblem FilePath
  checkOutside name paths =
    case OneOrMore.destruct NE.List paths of
      NE.List p [] -> Right p
      NE.List p1 (p2 : _) -> Left (Exit.BP_RootNameDuplicate name p1 p2)
  
  checkInside :: ModuleName.Raw -> FilePath -> Status -> Either Exit.BuildProjectProblem ()
  checkInside name p1 status =
    case status of
      SCached (Details.Local p2 _ _) -> Left (Exit.BP_RootNameDuplicate name p1 p2)
      SChanged (Details.Local p2 _ _) _ _ _ -> Left (Exit.BP_RootNameDuplicate name p1 p2)
      SBadImport _ -> Right ()
      SBadSyntax _ _ _ -> Right ()
      SForeign _ -> Right ()
      SKernel -> Right ()
  
  -- COMPILE MODULE
  
  compile :: Env -> DocsNeed -> Details.Local -> B.ByteString -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> IO Result
  compile (Env key root projectType platform _ _ _) docsNeed (Details.Local path deps main) source ifaces modul =
    let pkg = projectTypeToPkg projectType
     in case Compile.compile platform pkg ifaces modul of
          Right (Compile.Artifacts canonical annotations objects) ->
            case makeDocs docsNeed canonical of
              Left err ->
                return $
                  RProblem $
                    Error.Module (Src.getName modul) path source (Error.BadDocs err)
              Right docs ->
                do
                  let name = Src.getName modul
                  let iface = I.fromModule pkg canonical annotations
                  let greni = Dirs.greni root name
                  File.writeBinary (Dirs.greno root name) objects
                  maybeOldi <- File.readBinary greni
                  case maybeOldi of
                    Just oldi | oldi == iface ->
                      do
                        -- iface should be fully forced by equality check
                        Reporting.report key Reporting.BDone
                        let local = Details.Local path deps main
                        return (RSame local iface objects docs)
                    _ ->
                      do
                        -- iface may be lazy still
                        File.writeBinary greni iface
                        Reporting.report key Reporting.BDone
                        let local = Details.Local path deps main
                        return (RNew local iface objects docs)
          Left err ->
            return $
              RProblem $
                Error.Module (Src.getName modul) path source err
  
  projectTypeToPkg :: Parse.ProjectType -> Pkg.Name
  projectTypeToPkg projectType =
    case projectType of
      Parse.Package pkg -> pkg
      Parse.Application -> Pkg.dummyName
  
  -- WRITE DETAILS
  
  writeDetails :: FilePath -> Details.Details -> Map.Map ModuleName.Raw Result -> IO ()
  writeDetails root (Details.Details time outline buildID locals foreigns extras) results =
    File.writeBinary (Dirs.details root) $
      Details.Details time outline buildID (Map.foldrWithKey addNewLocal locals results) foreigns extras
  
  addNewLocal :: ModuleName.Raw -> Result -> Map.Map ModuleName.Raw Details.Local -> Map.Map ModuleName.Raw Details.Local
  addNewLocal name result locals =
    case result of
      RNew local _ _ _ -> Map.insert name local locals
      RSame local _ _ _ -> Map.insert name local locals
      RCached _ _ -> locals
      RNotFound _ -> locals
      RProblem _ -> locals
      RBlocked -> locals
      RForeign _ -> locals
      RKernel -> locals
  
  -- FINALIZE EXPOSED
  
  finalizeExposed :: FilePath -> DocsGoal docs -> NE.List ModuleName.Raw -> Map.Map ModuleName.Raw Result -> IO (Either Exit.BuildProblem docs)
  finalizeExposed root docsGoal exposed results =
    case foldr (addImportProblems results) [] (NE.toList exposed) of
      p : ps ->
        return $ Left $ Exit.BuildProjectProblem (Exit.BP_MissingExposed (NE.List p ps))
      [] ->
        case Map.foldr addErrors [] results of
          [] -> Right <$> finalizeDocs docsGoal results
          e : es -> return $ Left $ Exit.BuildBadModules root e es
  
  addErrors :: Result -> [Error.Module] -> [Error.Module]
  addErrors result errors =
    case result of
      RNew _ _ _ _ -> errors
      RSame _ _ _ _ -> errors
      RCached _ _ -> errors
      RNotFound _ -> errors
      RProblem e -> e : errors
      RBlocked -> errors
      RForeign _ -> errors
      RKernel -> errors
  
  addImportProblems :: Map.Map ModuleName.Raw Result -> ModuleName.Raw -> [(ModuleName.Raw, Import.Problem)] -> [(ModuleName.Raw, Import.Problem)]
  addImportProblems results name problems =
    case results ! name of
      RNew _ _ _ _ -> problems
      RSame _ _ _ _ -> problems
      RCached _ _ -> problems
      RNotFound p -> (name, p) : problems
      RProblem _ -> problems
      RBlocked -> problems
      RForeign _ -> problems
      RKernel -> problems
  
  -- DOCS
  
  data DocsGoal a where
    KeepDocs :: DocsGoal Docs.Documentation
    WriteDocs :: FilePath -> DocsGoal ()
    IgnoreDocs :: DocsGoal ()
  
  newtype DocsNeed = DocsNeed Bool
  
  toDocsNeed :: DocsGoal a -> DocsNeed
  toDocsNeed goal =
    case goal of
      IgnoreDocs -> DocsNeed False
      WriteDocs _ -> DocsNeed True
      KeepDocs -> DocsNeed True
  
  makeDocs :: DocsNeed -> Can.Module -> Either EDocs.Error (Maybe Docs.Module)
  makeDocs (DocsNeed isNeeded) modul =
    if isNeeded
      then case Docs.fromModule modul of
        Right docs -> Right (Just docs)
        Left err -> Left err
      else Right Nothing
  
  finalizeDocs :: DocsGoal docs -> Map.Map ModuleName.Raw Result -> IO docs
  finalizeDocs goal results =
    case goal of
      KeepDocs ->
        return $ Map.mapMaybe toDocs results
      WriteDocs path ->
        E.writeUgly path $ Docs.encode $ Map.mapMaybe toDocs results
      IgnoreDocs ->
        return ()
  
  toDocs :: Result -> Maybe Docs.Module
  toDocs result =
    case result of
      RNew _ _ _ d -> d
      RSame _ _ _ d -> d
      RCached _ _ -> Nothing
      RNotFound _ -> Nothing
      RProblem _ -> Nothing
      RBlocked -> Nothing
      RForeign _ -> Nothing
      RKernel -> Nothing
  
  --------------------------------------------------------------------------------
  ------ NOW FOR SOME REPL STUFF -------------------------------------------------
  --------------------------------------------------------------------------------
  
  -- FROM REPL
  
  data ReplArtifacts = ReplArtifacts
    { _repl_home :: ModuleName.Canonical,
      _repl_modules :: [Module],
      _repl_localizer :: L.Localizer,
      _repl_annotations :: Map.Map Name.Name Can.Annotation
    }
  
  fromRepl :: FilePath -> Details.Details -> Sources -> B.ByteString -> IO (Either Exit.Repl ReplArtifacts)
  fromRepl root details rootSources source =
    do
      env@(Env _ _ projectType _ _ _ _) <- makeEnv Reporting.ignorer root details
      case Parse.fromByteString projectType source of
        Left syntaxError ->
          return $ Left $ Exit.ReplBadInput source $ Error.BadSyntax syntaxError
        Right modul@(Src.Module _ _ _ imports _ _ _ _ _ _ _) ->
          do
            dmvar <- Details.loadInterfaces root details
  
            let deps = map (Src.getImportName . snd) imports
            mvar <- newMVar Map.empty
            crawlDeps env mvar rootSources deps ()
  
            statuses <- traverse readMVar =<< readMVar mvar
            midpoint <- checkMidpoint dmvar statuses
  
            case midpoint of
              Left problem ->
                return $ Left $ Exit.ReplProjectProblem problem
              Right foreigns ->
                do
                  rmvar <- newEmptyMVar
                  resultMVars <- forkWithKey (checkModule env foreigns rmvar) statuses
                  putMVar rmvar resultMVars
                  results <- traverse readMVar resultMVars
                  writeDetails root details results
                  depsStatus <- checkDeps root resultMVars deps
                  finalizeReplArtifacts env source modul depsStatus resultMVars results
  
  finalizeReplArtifacts :: Env -> B.ByteString -> Src.Module -> DepsStatus -> ResultDict -> Map.Map ModuleName.Raw Result -> IO (Either Exit.Repl ReplArtifacts)
  finalizeReplArtifacts env@(Env _ root projectType platform _ _ _) source modul@(Src.Module _ _ _ imports _ _ _ _ _ _ _) depsStatus resultMVars results =
    let pkg =
          projectTypeToPkg projectType
  
        compileInput ifaces =
          case Compile.compile platform pkg ifaces modul of
            Right (Compile.Artifacts canonical annotations objects) ->
              let h = Can._name canonical
                  m = Fresh (Src.getName modul) (I.fromModule pkg canonical annotations) objects
                  ms = Map.foldrWithKey addInside [] results
               in return $ Right $ ReplArtifacts h (m : ms) (L.fromModule modul) annotations
            Left errors ->
              return $ Left $ Exit.ReplBadInput source errors
     in case depsStatus of
          DepsChange ifaces ->
            compileInput ifaces
          DepsSame same cached ->
            do
              maybeLoaded <- loadInterfaces root same cached
              case maybeLoaded of
                Just ifaces -> compileInput ifaces
                Nothing -> return $ Left Exit.ReplBadCache
          DepsBlock ->
            case Map.foldr addErrors [] results of
              [] -> return $ Left Exit.ReplBlocked
              e : es -> return $ Left $ Exit.ReplBadLocalDeps root e es
          DepsNotFound problems ->
            return $
              Left $
                Exit.ReplBadInput source $
                  Error.BadImports $
                    toImportErrors env resultMVars imports problems
  
  --------------------------------------------------------------------------------
  --------------------------------------------------------------------------------
  ------ AFTER THIS, EVERYTHING IS ABOUT HANDLING MODULES GIVEN BY FILEPATH ------
  --------------------------------------------------------------------------------
  --------------------------------------------------------------------------------
  
  -- FIND ROOT
  
  data RootLocation
    = LInside ModuleName.Raw
    | LOutside FilePath
  
  findRoots :: Env -> NE.List FilePath -> IO (Either Exit.BuildProjectProblem (NE.List RootLocation))
  findRoots env paths =
    do
      mvars <- traverse (fork . getRootInfo env) paths
      einfos <- traverse readMVar mvars
      return $ checkRoots =<< sequence einfos
  
  checkRoots :: NE.List RootInfo -> Either Exit.BuildProjectProblem (NE.List RootLocation)
  checkRoots infos =
    let toOneOrMore loc@(RootInfo absolute _ _) =
          (absolute, OneOrMore.one loc)
  
        fromOneOrMore loc locs =
          case locs of
            [] -> Right ()
            loc2 : _ -> Left (Exit.BP_MainPathDuplicate (_relative loc) (_relative loc2))
     in fmap (\_ -> fmap _location infos) $
          traverse (OneOrMore.destruct fromOneOrMore) $
            Map.fromListWith OneOrMore.more $
              map toOneOrMore (NE.toList infos)
  
  -- ROOT INFO
  
  data RootInfo = RootInfo
    { _absolute :: FilePath,
      _relative :: FilePath,
      _location :: RootLocation
    }
  
  getRootInfo :: Env -> FilePath -> IO (Either Exit.BuildProjectProblem RootInfo)
  getRootInfo env path =
    do
      exists <- File.exists path
      if exists
        then getRootInfoHelp env path =<< Dir.canonicalizePath path
        else return (Left (Exit.BP_PathUnknown path))
  
  getRootInfoHelp :: Env -> FilePath -> FilePath -> IO (Either Exit.BuildProjectProblem RootInfo)
  getRootInfoHelp (Env _ _ _ _ srcDirs _ _) path absolutePath =
    let (dirs, file) = FP.splitFileName absolutePath
        (final, ext) = FP.splitExtension file
     in if ext /= ".gren"
          then return $ Left $ Exit.BP_WithBadExtension path
          else
            let absoluteSegments = FP.splitDirectories dirs ++ [final]
             in case Maybe.mapMaybe (isInsideSrcDirByPath absoluteSegments) srcDirs of
                  [] ->
                    return $ Right $ RootInfo absolutePath path (LOutside path)
                  [(_, Right names)] ->
                    do
                      let name = Name.fromChars (List.intercalate "." names)
                      matchingDirs <- filterM (isInsideSrcDirByName names) srcDirs
                      case matchingDirs of
                        d1 : d2 : _ ->
                          do
                            let p1 = AbsoluteSrcDir.addRelative d1 (FP.joinPath names <.> "gren")
                            let p2 = AbsoluteSrcDir.addRelative d2 (FP.joinPath names <.> "gren")
                            return $ Left $ Exit.BP_RootNameDuplicate name p1 p2
                        _ ->
                          return $ Right $ RootInfo absolutePath path (LInside name)
                  [(s, Left names)] ->
                    return $ Left $ Exit.BP_RootNameInvalid path s names
                  (s1, _) : (s2, _) : _ ->
                    return $ Left $ Exit.BP_WithAmbiguousSrcDir path s1 s2
  
  isInsideSrcDirByName :: [String] -> AbsoluteSrcDir -> IO Bool
  isInsideSrcDirByName names srcDir =
    File.exists (AbsoluteSrcDir.addRelative srcDir (FP.joinPath names <.> "gren"))
  
  isInsideSrcDirByPath :: [String] -> AbsoluteSrcDir -> Maybe (FilePath, Either [String] [String])
  isInsideSrcDirByPath segments (AbsoluteSrcDir srcDir) =
    case dropPrefix (FP.splitDirectories srcDir) segments of
      Nothing ->
        Nothing
      Just names ->
        if all isGoodName names
          then Just (srcDir, Right names)
          else Just (srcDir, Left names)
  
  isGoodName :: [Char] -> Bool
  isGoodName name =
    case name of
      [] ->
        False
      char : chars ->
        Char.isUpper char && all (\c -> Char.isAlphaNum c || c == '_') chars
  
  -- INVARIANT: Dir.canonicalizePath has been run on both inputs
  --
  dropPrefix :: [FilePath] -> [FilePath] -> Maybe [FilePath]
  dropPrefix roots paths =
    case roots of
      [] ->
        Just paths
      r : rs ->
        case paths of
          [] -> Nothing
          p : ps -> if r == p then dropPrefix rs ps else Nothing
  
  -- CRAWL ROOTS
  
  newtype RootStatus
    = SInside ModuleName.Raw
  
  crawlRoot :: Env -> MVar StatusDict -> Sources -> RootLocation -> IO RootStatus
  crawlRoot env mvar sources root =
    case root of
      LInside name ->
        crawlRootModule env mvar sources name
      LOutside _ ->
        error "Bad assumption"
  
  crawlRootModule :: Env -> MVar StatusDict -> Sources -> ModuleName.Raw -> IO RootStatus
  crawlRootModule env mvar sources root =
    do
      statusMVar <- newEmptyMVar
      statusDict <- takeMVar mvar
      putMVar mvar (Map.insert root statusMVar statusDict)
      putMVar statusMVar =<< crawlRootModuleHelp env mvar sources (DocsNeed False) root
      return (SInside root)
  
  -- CHECK ROOTS
  
  newtype RootResult
    = RInside ModuleName.Raw
  
  checkRoot :: RootStatus -> IO RootResult
  checkRoot rootStatus =
    case rootStatus of
      SInside name ->
        return (RInside name)
  
  -- TO ARTIFACTS
  
  data Root
    = Inside ModuleName.Raw
    | Outside ModuleName.Raw I.Interface Opt.LocalGraph
  
  toArtifacts :: Env -> Dependencies -> Map.Map ModuleName.Raw Result -> NE.List RootResult -> Either Exit.BuildProblem Artifacts
  toArtifacts (Env _ root projectType _ _ _ _) foreigns results rootResults =
    case gatherProblemsOrMains results rootResults of
      Left (NE.List e es) ->
        Left (Exit.BuildBadModules root e es)
      Right roots ->
        Right $
          Artifacts (projectTypeToPkg projectType) foreigns roots $
            Map.foldrWithKey addInside (foldr addOutside [] rootResults) results
  
  gatherProblemsOrMains :: Map.Map ModuleName.Raw Result -> NE.List RootResult -> Either (NE.List Error.Module) (NE.List Root)
  gatherProblemsOrMains results (NE.List rootResult rootResults) =
    let addResult result (es, roots) =
          case result of
            RInside n -> (es, Inside n : roots)
  
        errors = Map.foldr addErrors [] results
     in case (rootResult, foldr addResult (errors, []) rootResults) of
          (RInside n, ([], ms)) -> Right (NE.List (Inside n) ms)
          (RInside _, (e : es, _)) -> Left (NE.List e es)
  
  addInside :: ModuleName.Raw -> Result -> [Module] -> [Module]
  addInside name result modules =
    case result of
      RNew _ iface objs _ -> Fresh name iface objs : modules
      RSame _ iface objs _ -> Fresh name iface objs : modules
      RCached main mvar -> Cached name main mvar : modules
      RNotFound _ -> error (badInside name)
      RProblem _ -> error (badInside name)
      RBlocked -> error (badInside name)
      RForeign _ -> modules
      RKernel -> modules
  
  badInside :: ModuleName.Raw -> [Char]
  badInside name =
    "Error from `" ++ Name.toChars name ++ "` should have been reported already."
  
  addOutside :: RootResult -> [Module] -> [Module]
  addOutside root modules =
    case root of
      RInside _ -> modules
  