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 :: [FilePath] -> IO (Either MultipleErrors Value, MultipleErrors)
graph [FilePath]
input = do
  [(FilePath, Text)]
moduleFiles <- [FilePath] -> IO [(FilePath, Text)]
readInput [FilePath]
input
  forall a.
Options -> Make a -> IO (Either MultipleErrors a, MultipleErrors)
Make.runMake Options
Options.defaultOptions forall a b. (a -> b) -> a -> b
$ do
    [(FilePath, PartialResult Module)]
ms <- forall (m :: * -> *) k.
MonadError MultipleErrors m =>
(k -> FilePath) -> [(k, Text)] -> m [(k, PartialResult Module)]
CST.parseModulesFromFiles forall a. a -> a
id [(FilePath, Text)]
moduleFiles
    let parsedModuleSig :: PartialResult Module -> ModuleSignature
parsedModuleSig = Module -> ModuleSignature
Dependencies.moduleSignature forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PartialResult a -> a
CST.resPartial
    ([(FilePath, PartialResult Module)]
_sorted, ModuleGraph
moduleGraph) <- forall (m :: * -> *) a.
MonadError MultipleErrors m =>
DependencyDepth
-> (a -> ModuleSignature) -> [a] -> m ([a], ModuleGraph)
Dependencies.sortModules DependencyDepth
Dependencies.Direct (PartialResult Module -> ModuleSignature
parsedModuleSig forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(FilePath, PartialResult Module)]
ms
    let pathMap :: Map ModuleName FilePath
pathMap = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$
          forall a b. (a -> b) -> [a] -> [b]
map (\(FilePath
p, PartialResult Module
m) -> (ModuleSignature -> ModuleName
Dependencies.sigModuleName (PartialResult Module -> ModuleSignature
parsedModuleSig PartialResult Module
m), FilePath
p)) [(FilePath, PartialResult Module)]
ms
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map ModuleName FilePath -> ModuleGraph -> Value
moduleGraphToJSON Map ModuleName FilePath
pathMap ModuleGraph
moduleGraph)

moduleGraphToJSON
  :: Map ModuleName FilePath
  -> Dependencies.ModuleGraph
  -> Json.Value
moduleGraphToJSON :: Map ModuleName FilePath -> ModuleGraph -> Value
moduleGraphToJSON Map ModuleName FilePath
paths = Object -> Value
Json.Object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Object -> (ModuleName, [ModuleName]) -> Object
insert forall a. Monoid a => a
mempty
  where
  insert :: Json.Object -> (ModuleName, [ModuleName]) -> Json.Object
  insert :: Object -> (ModuleName, [ModuleName]) -> Object
insert Object
obj (ModuleName
mn, [ModuleName]
depends) = forall v. Key -> v -> KeyMap v -> KeyMap v
Json.Map.insert (Text -> Key
Json.Key.fromText (ModuleName -> Text
runModuleName ModuleName
mn)) Value
value Object
obj
    where
      path :: FilePath
path = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => FilePath -> a
Crash.internalError FilePath
"missing module name in graph") forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModuleName
mn Map ModuleName FilePath
paths
      value :: Value
value = [Pair] -> Value
Json.object
        [ Key
"path"  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FilePath
path
        , Key
"depends" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ModuleName -> Text
runModuleName [ModuleName]
depends
        ]

readInput :: [FilePath] -> IO [(FilePath, Text)]
readInput :: [FilePath] -> IO [(FilePath, Text)]
readInput [FilePath]
inputFiles =
  forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
inputFiles forall a b. (a -> b) -> a -> b
$ \FilePath
inFile -> (FilePath
inFile, ) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Text
readUTF8FileT FilePath
inFile