2013-12-15 05:46:15 +00:00
|
|
|
module Build.Dependencies (getSortedDependencies) where
|
2012-05-29 18:25:43 +00:00
|
|
|
|
2013-06-15 02:23:58 +00:00
|
|
|
import Data.Data
|
2013-12-15 09:37:51 +00:00
|
|
|
import Control.Applicative
|
2013-12-16 11:03:52 +00:00
|
|
|
import Control.Monad.Error
|
|
|
|
import qualified Control.Monad.State as State
|
|
|
|
import qualified Data.Aeson as Json
|
|
|
|
import qualified Data.ByteString.Lazy.Char8 as BSC
|
2013-12-15 09:37:51 +00:00
|
|
|
import qualified Data.Char as Char
|
2013-07-19 16:05:31 +00:00
|
|
|
import qualified Data.Graph as Graph
|
|
|
|
import qualified Data.List as List
|
2013-07-26 14:38:40 +00:00
|
|
|
import qualified Data.Map as Map
|
2013-12-15 09:37:51 +00:00
|
|
|
import qualified Data.Maybe as Maybe
|
2013-07-26 14:38:40 +00:00
|
|
|
import qualified Data.Set as Set
|
2013-10-05 23:12:25 +00:00
|
|
|
import System.Directory
|
2013-07-16 12:52:50 +00:00
|
|
|
import System.Exit
|
2013-07-16 19:43:56 +00:00
|
|
|
import System.FilePath as FP
|
2013-12-15 09:37:51 +00:00
|
|
|
import System.IO
|
2013-07-20 16:52:43 +00:00
|
|
|
import Text.PrettyPrint (Doc)
|
2013-07-16 12:52:50 +00:00
|
|
|
|
2013-12-22 23:18:16 +00:00
|
|
|
import qualified SourceSyntax.Module as Module
|
2013-08-22 19:16:39 +00:00
|
|
|
import qualified SourceSyntax.Type as Type
|
2013-07-16 19:43:56 +00:00
|
|
|
import qualified Parse.Parse as Parse
|
2013-07-25 18:53:22 +00:00
|
|
|
import qualified Metadata.Prelude as Prelude
|
2013-07-14 23:06:00 +00:00
|
|
|
import qualified Transform.Check as Check
|
2013-07-16 19:43:56 +00:00
|
|
|
import qualified Transform.SortDefinitions as SD
|
2013-07-16 12:52:50 +00:00
|
|
|
import qualified Type.Inference as TI
|
2013-07-16 19:43:56 +00:00
|
|
|
import qualified Type.Constrain.Declaration as TcDecl
|
2013-07-29 09:59:55 +00:00
|
|
|
import qualified Transform.Canonicalize as Canonical
|
2013-12-16 11:03:52 +00:00
|
|
|
import qualified Elm.Internal.Paths as Path
|
|
|
|
import qualified Elm.Internal.Name as N
|
2013-12-16 07:55:36 +00:00
|
|
|
import qualified Elm.Internal.Version as V
|
2013-12-16 11:03:52 +00:00
|
|
|
import qualified Elm.Internal.Dependencies as Deps
|
2012-05-29 18:25:43 +00:00
|
|
|
|
2013-12-22 23:18:16 +00:00
|
|
|
getSortedDependencies :: [FilePath] -> Module.Interfaces -> FilePath -> IO [String]
|
2013-11-11 15:22:33 +00:00
|
|
|
getSortedDependencies srcDirs builtIns root =
|
2013-12-16 11:03:52 +00:00
|
|
|
do extras <- extraDependencies
|
|
|
|
let allSrcDirs = srcDirs ++ Maybe.fromMaybe [] extras
|
|
|
|
result <- runErrorT $ readDeps allSrcDirs builtIns root
|
|
|
|
case result of
|
|
|
|
Right deps -> sortDeps deps
|
|
|
|
Left err -> failure $ err ++ if Maybe.isJust extras then "" else msg
|
|
|
|
where msg = "\nYou may need to create a " ++
|
|
|
|
Path.dependencyFile ++
|
|
|
|
" file if you\nare trying to use a 3rd party library."
|
|
|
|
|
|
|
|
failure msg = hPutStrLn stderr msg >> exitFailure
|
|
|
|
|
|
|
|
extraDependencies :: IO (Maybe [FilePath])
|
|
|
|
extraDependencies =
|
|
|
|
do exists <- doesFileExist Path.dependencyFile
|
|
|
|
if not exists then return Nothing else Just <$> getPaths
|
2013-12-15 09:37:51 +00:00
|
|
|
where
|
2013-12-16 11:03:52 +00:00
|
|
|
getPaths = do
|
|
|
|
raw <- BSC.readFile Path.dependencyFile
|
|
|
|
case Json.eitherDecode raw of
|
2013-12-16 22:41:05 +00:00
|
|
|
Right (Deps.Mini deps) -> mapM validate deps
|
2013-12-16 11:03:52 +00:00
|
|
|
Left err ->
|
|
|
|
failure $ "Error reading the " ++ Path.dependencyFile ++ " file:\n" ++ err
|
|
|
|
|
|
|
|
validate (name,version) = do
|
|
|
|
let path = Path.dependencyDirectory </> toPath name version
|
|
|
|
exists <- doesDirectoryExist path
|
|
|
|
if exists then return path else failure (notFound name version)
|
2013-12-15 09:37:51 +00:00
|
|
|
|
2013-12-16 11:03:52 +00:00
|
|
|
toPath name version = N.toFilePath name </> show version
|
2013-12-15 09:37:51 +00:00
|
|
|
|
2013-12-16 11:03:52 +00:00
|
|
|
notFound name version =
|
|
|
|
unlines
|
|
|
|
[ "Your " ++ Path.dependencyFile ++ " file says you depend on library"
|
|
|
|
, show name ++ " " ++ show version ++ " but it was not found."
|
|
|
|
, "You may need to install it with:"
|
|
|
|
, ""
|
|
|
|
, " elm-get install " ++ show name ++ " " ++ show version ]
|
2013-12-15 09:37:51 +00:00
|
|
|
|
2013-08-02 00:22:44 +00:00
|
|
|
type Deps = (FilePath, String, [String])
|
2013-02-27 07:33:47 +00:00
|
|
|
|
2013-06-05 07:44:04 +00:00
|
|
|
sortDeps :: [Deps] -> IO [String]
|
2013-07-19 16:05:31 +00:00
|
|
|
sortDeps depends =
|
|
|
|
if null mistakes
|
2013-12-16 11:03:52 +00:00
|
|
|
then return (concat sccs)
|
|
|
|
else failure $ msg ++ unlines (map show mistakes)
|
2013-07-19 16:05:31 +00:00
|
|
|
where
|
2013-08-02 00:22:44 +00:00
|
|
|
sccs = map Graph.flattenSCC $ Graph.stronglyConnComp depends
|
2013-07-19 16:05:31 +00:00
|
|
|
|
|
|
|
mistakes = filter (\scc -> length scc > 1) sccs
|
2013-12-16 11:03:52 +00:00
|
|
|
msg = "A cyclical module dependency or was detected in:\n"
|
2013-02-27 07:33:47 +00:00
|
|
|
|
2013-12-22 23:18:16 +00:00
|
|
|
readDeps :: [FilePath] -> Module.Interfaces -> FilePath -> ErrorT String IO [Deps]
|
2013-11-11 15:22:33 +00:00
|
|
|
readDeps srcDirs builtIns root = do
|
|
|
|
let ifaces = (Set.fromList . Map.keys) builtIns
|
2013-12-16 11:03:52 +00:00
|
|
|
State.evalStateT (go ifaces root) Set.empty
|
2013-07-26 14:38:40 +00:00
|
|
|
where
|
2013-12-16 11:03:52 +00:00
|
|
|
go :: Set.Set String -> FilePath -> State.StateT (Set.Set String) (ErrorT String IO) [Deps]
|
2013-11-11 15:22:33 +00:00
|
|
|
go builtIns root = do
|
2013-12-16 11:03:52 +00:00
|
|
|
(root', txt) <- lift $ getFile srcDirs root
|
2013-07-26 14:38:40 +00:00
|
|
|
case Parse.dependencies txt of
|
2013-12-16 11:03:52 +00:00
|
|
|
Left err -> throwError $ msg ++ show err
|
|
|
|
where msg = "Error resolving dependencies in " ++ root' ++ ":\n"
|
2013-10-30 22:44:47 +00:00
|
|
|
|
2013-07-26 14:38:40 +00:00
|
|
|
Right (name,deps) ->
|
2013-12-16 11:03:52 +00:00
|
|
|
do seen <- State.get
|
2013-07-26 14:38:40 +00:00
|
|
|
let realDeps = Set.difference (Set.fromList deps) builtIns
|
|
|
|
newDeps = Set.difference (Set.filter (not . isNative) realDeps) seen
|
2013-12-16 11:03:52 +00:00
|
|
|
State.put (Set.insert name (Set.union newDeps seen))
|
2013-11-11 15:22:33 +00:00
|
|
|
rest <- mapM (go builtIns . toFilePath) (Set.toList newDeps)
|
2013-10-05 23:12:25 +00:00
|
|
|
return ((makeRelative "." root', name, Set.toList realDeps) : concat rest)
|
|
|
|
|
2013-12-16 11:03:52 +00:00
|
|
|
getFile :: [FilePath] -> FilePath -> ErrorT String IO (FilePath,String)
|
|
|
|
getFile [] path =
|
|
|
|
throwError $ unlines
|
2013-12-15 09:37:51 +00:00
|
|
|
[ "Could not find file: " ++ path
|
|
|
|
, " If it is not in the root directory of your project, use"
|
2013-12-16 11:03:52 +00:00
|
|
|
, " --src-dir to declare additional locations for source files."
|
|
|
|
, " If it is part of a 3rd party library, it needs to be declared"
|
|
|
|
, " as a dependency in the " ++ Path.dependencyFile ++ " file." ]
|
2013-10-05 23:12:25 +00:00
|
|
|
|
|
|
|
getFile (dir:dirs) path = do
|
|
|
|
let path' = dir </> path
|
2013-12-16 11:03:52 +00:00
|
|
|
exists <- liftIO $ doesFileExist path'
|
2013-10-05 23:12:25 +00:00
|
|
|
case exists of
|
2013-12-16 11:03:52 +00:00
|
|
|
True -> (,) path' `fmap` liftIO (readFile path')
|
2013-10-05 23:12:25 +00:00
|
|
|
False -> getFile dirs path
|
2013-02-27 07:33:47 +00:00
|
|
|
|
2013-07-19 16:05:31 +00:00
|
|
|
isNative name = List.isPrefixOf "Native." name
|
2013-06-05 07:44:04 +00:00
|
|
|
|
|
|
|
toFilePath :: String -> FilePath
|
2013-02-27 07:33:47 +00:00
|
|
|
toFilePath name = map swapDots name ++ ext
|
|
|
|
where swapDots '.' = '/'
|
|
|
|
swapDots c = c
|
|
|
|
ext = if isNative name then ".js" else ".elm"
|