Graph.hs

module Language.PureScript.Graph (graph) where

import Prelude

import Data.Aeson qualified as Json
import Data.Aeson.Key qualified as Json.Key
import Data.Aeson.KeyMap qualified as Json.Map
import Data.Map qualified as Map

import Control.Monad (forM)
import Data.Aeson ((.=))
import Data.Foldable (foldl')
import Data.Map (Map)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import System.IO.UTF8 (readUTF8FileT)

import Language.PureScript.Crash qualified as Crash
import Language.PureScript.CST qualified as CST
import Language.PureScript.Make qualified as Make
import Language.PureScript.ModuleDependencies qualified as Dependencies
import Language.PureScript.Options qualified as Options

import Language.PureScript.Errors (MultipleErrors)
import Language.PureScript.Names (ModuleName, runModuleName)


-- | Given a set of filepaths, try to build the dependency graph and return
--   that as its JSON representation (or a bunch of errors, if any)
graph :: [FilePath] -> IO (Either MultipleErrors Json.Value, MultipleErrors)
graph input = do
  moduleFiles <- readInput input
  Make.runMake Options.defaultOptions $ do
    ms <- CST.parseModulesFromFiles id moduleFiles
    let parsedModuleSig = Dependencies.moduleSignature . CST.resPartial
    (_sorted, moduleGraph) <- Dependencies.sortModules Dependencies.Direct (parsedModuleSig . snd) ms
    let pathMap = Map.fromList $
          map (\(p, m) -> (Dependencies.sigModuleName (parsedModuleSig m), p)) ms
    pure (moduleGraphToJSON pathMap moduleGraph)

moduleGraphToJSON
  :: Map ModuleName FilePath
  -> Dependencies.ModuleGraph
  -> Json.Value
moduleGraphToJSON paths = Json.Object . foldl' insert mempty
  where
  insert :: Json.Object -> (ModuleName, [ModuleName]) -> Json.Object
  insert obj (mn, depends) = Json.Map.insert (Json.Key.fromText (runModuleName mn)) value obj
    where
      path = fromMaybe (Crash.internalError "missing module name in graph") $ Map.lookup mn paths
      value = Json.object
        [ "path"  .= path
        , "depends" .= fmap runModuleName depends
        ]

readInput :: [FilePath] -> IO [(FilePath, Text)]
readInput inputFiles =
  forM inputFiles $ \inFile -> (inFile, ) <$> readUTF8FileT inFile