content: 
  module Language.PureScript.Docs.Collect
    ( collectDocs
    ) where
  
  import Protolude hiding (check)
  
  import Control.Arrow ((&&&))
  import Data.Aeson.BetterErrors qualified as ABE
  import Data.ByteString qualified as BS
  import Data.Map qualified as Map
  import Data.Set qualified as Set
  import Data.Text qualified as T
  import Data.Text.IO qualified as TIO
  import System.FilePath ((</>))
  import System.IO.UTF8 (readUTF8FileT, readUTF8FilesT)
  
  import Language.PureScript.Docs.Convert.ReExports (updateReExports)
  import Language.PureScript.Docs.Prim (primModules)
  import Language.PureScript.Docs.Types (InPackage(..), Module(..), asModule, displayPackageError, ignorePackage)
  
  import Language.PureScript.AST qualified as P
  import Language.PureScript.CST qualified as P
  import Language.PureScript.Crash qualified as P
  import Language.PureScript.Errors qualified as P
  import Language.PureScript.Externs qualified as P
  import Language.PureScript.Make qualified as P
  import Language.PureScript.Names qualified as P
  import Language.PureScript.Options qualified as P
  
  import Web.Bower.PackageMeta (PackageName)
  
  -- |
  -- Given a compiler output directory, a list of input PureScript source files,
  -- and a list of dependency PureScript source files, produce documentation for
  -- the input files in the intermediate documentation format. Note that
  -- dependency files are not included in the result.
  --
  -- If the output directory is not up to date with respect to the provided input
  -- and dependency files, the files will be built as if with just the "docs"
  -- codegen target, i.e. "purs compile --codegen docs".
  --
  collectDocs ::
    forall m.
    (MonadError P.MultipleErrors m, MonadIO m) =>
    FilePath ->
    [FilePath] ->
    [(PackageName, FilePath)] ->
    m ([(FilePath, Module)], Map P.ModuleName PackageName)
  collectDocs outputDir inputFiles depsFiles = do
    (modulePaths, modulesDeps) <- getModulePackageInfo inputFiles depsFiles
    externs <- compileForDocs outputDir (map fst modulePaths)
  
    let (withPackage, shouldKeep) =
          packageDiscriminators modulesDeps
    let go =
          operateAndRetag identity modName $ \mns -> do
            docsModules <- traverse (liftIO . parseDocsJsonFile outputDir) mns
            addReExports withPackage docsModules externs
  
    docsModules <- go modulePaths
    pure (filter (shouldKeep . modName . snd) docsModules, modulesDeps)
  
    where
    packageDiscriminators modulesDeps =
      let
        shouldKeep mn = isLocal mn && not (P.isBuiltinModuleName mn)
  
        withPackage :: P.ModuleName -> InPackage P.ModuleName
        withPackage mn =
          case Map.lookup mn modulesDeps of
            Just pkgName -> FromDep pkgName mn
            Nothing -> Local mn
  
        isLocal :: P.ModuleName -> Bool
        isLocal = not . flip Map.member modulesDeps
      in
        (withPackage, shouldKeep)
  
  -- |
  -- Compile with just the 'docs' codegen target, writing results into the given
  -- output directory.
  --
  compileForDocs ::
    forall m.
    (MonadError P.MultipleErrors m, MonadIO m) =>
    FilePath ->
    [FilePath] ->
    m [P.ExternsFile]
  compileForDocs outputDir inputFiles = do
    result <- liftIO $ do
      moduleFiles <- readUTF8FilesT inputFiles
      fmap fst $ P.runMake testOptions $ do
        ms <- P.parseModulesFromFiles identity moduleFiles
        let filePathMap = Map.fromList $ map (\(fp, pm) -> (P.getModuleName $ P.resPartial pm, Right fp)) ms
        foreigns <- P.inferForeignModules filePathMap
        let makeActions =
              (P.buildMakeActions outputDir filePathMap foreigns False)
                { P.progress = liftIO . TIO.hPutStr stdout . (<> "\n") . P.renderProgressMessage "Compiling documentation for "
                }
        P.make makeActions (map snd ms)
    either throwError return result
  
    where
    testOptions :: P.Options
    testOptions = P.defaultOptions { P.optionsCodegenTargets = Set.singleton P.Docs }
  
  parseDocsJsonFile :: FilePath -> P.ModuleName -> IO Module
  parseDocsJsonFile outputDir mn =
    let
      filePath = outputDir </> T.unpack (P.runModuleName mn) </> "docs.json"
    in do
      str <- BS.readFile filePath
      case ABE.parseStrict asModule str of
        Right m -> pure m
        Left err -> P.internalError $
          "Failed to decode: " ++ filePath ++
          intercalate "\n" (map T.unpack (ABE.displayError displayPackageError err))
  
  addReExports ::
    (MonadError P.MultipleErrors m) =>
    (P.ModuleName -> InPackage P.ModuleName) ->
    [Module] ->
    [P.ExternsFile] ->
    m [Module]
  addReExports withPackage docsModules externs = do
    -- We add the Prim docs modules here, so that docs generation is still
    -- possible if the modules we are generating docs for re-export things from
    -- Prim submodules. Note that the Prim modules do not exist as
    -- @Language.PureScript.Module@ values because they do not contain anything
    -- that exists at runtime. However, we have pre-constructed
    -- @Language.PureScript.Docs.Types.Module@ values for them, which we use
    -- here.
    let moduleMap =
          Map.fromList
            (map (modName &&& identity)
                 (docsModules ++ primModules))
  
    let withReExports = updateReExports externs withPackage moduleMap
    pure (Map.elems withReExports)
  
  -- |
  -- Perform an operation on a list of things which are tagged, and reassociate
  -- the things with their tags afterwards.
  --
  operateAndRetag ::
    forall m a b key tag.
    Monad m =>
    Ord key =>
    Show key =>
    (a -> key) ->
    (b -> key) ->
    ([a] -> m [b]) ->
    [(tag, a)] ->
    m [(tag, b)]
  operateAndRetag keyA keyB operation input =
    map retag <$> operation (map snd input)
    where
    tags :: Map key tag
    tags = Map.fromList $ map (\(tag, a) -> (keyA a, tag)) input
  
    findTag :: key -> tag
    findTag key =
      case Map.lookup key tags of
        Just tag -> tag
        Nothing -> P.internalError ("Missing tag for: " ++ show key)
  
    retag :: b -> (tag, b)
    retag b = (findTag (keyB b), b)
  
  -- |
  -- Given:
  --
  --    * A list of local source files
  --    * A list of source files from external dependencies, together with their
  --      package names
  --
  -- This function does the following:
  --
  --    * Partially parse all of the input and dependency source files to get
  --      the module name of each module
  --    * Associate each dependency module with its package name, thereby
  --      distinguishing these from local modules
  --    * Return the file paths paired with the names of the modules they
  --      contain, and a Map of module names to package names for modules which
  --      come from dependencies. If a module does not exist in the map, it can
  --      safely be
  --      assumed to be local.
  getModulePackageInfo ::
    (MonadError P.MultipleErrors m, MonadIO m) =>
    [FilePath]
    -> [(PackageName, FilePath)]
    -> m ([(FilePath, P.ModuleName)], Map P.ModuleName PackageName)
  getModulePackageInfo inputFiles depsFiles = do
    inputFiles' <- traverse (readFileAs . Local) inputFiles
    depsFiles'  <- traverse (readFileAs . uncurry FromDep) depsFiles
  
    moduleNames <- getModuleNames (inputFiles' ++ depsFiles')
  
    let mnMap =
          Map.fromList $
            mapMaybe (\(pkgPath, mn) -> (mn,) <$> getPkgName pkgPath) moduleNames
  
    pure (map (first ignorePackage) moduleNames, mnMap)
  
    where
    getModuleNames ::
      (MonadError P.MultipleErrors m) =>
      [(InPackage FilePath, Text)]
      -> m [(InPackage FilePath, P.ModuleName)]
    getModuleNames =
      fmap (map (second (P.getModuleName . P.resPartial)))
      . either throwError return
      . P.parseModulesFromFiles ignorePackage
  
    getPkgName = \case
      Local _ -> Nothing
      FromDep pkgName _ -> Just pkgName
  
    readFileAs ::
      (MonadIO m) =>
      InPackage FilePath ->
      m (InPackage FilePath, Text)
    readFileAs fi =
      liftIO . fmap (fi,) $ readUTF8FileT (ignorePackage fi)
  