module Language.PureScript.Graph (graph) where

import Prelude

import qualified Data.Aeson as Json
import qualified Data.Aeson.Key as Json.Key
import qualified Data.Aeson.KeyMap as Json.Map
import qualified Data.Map 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 qualified Language.PureScript.Crash as Crash
import qualified Language.PureScript.CST as CST
import qualified Language.PureScript.Make as Make
import qualified Language.PureScript.ModuleDependencies as Dependencies
import qualified Language.PureScript.Options 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