@@ -1,55 +1,57 @@
11{-# OPTIONS_GHC -W #-}
2−module Build.Dependencies (getSortedDependencies, readDeps) where
2+module Build.Dependencies (Recipe(..), getBuildRecipe, readDeps) where
33
4−import Control.Applicative
54import Control.Monad.Error
65import qualified Control.Monad.State as State
7−import qualified Data.Aeson as Json
8−import qualified Data.ByteString.Lazy.Char8 as BSC
96import qualified Data.Graph as Graph
107import qualified Data.List as List
118import qualified Data.Map as Map
12−import qualified Data.Maybe as Maybe
139import qualified Data.Set as Set
1410import System.Directory
1511import System.FilePath as FP
1612
17−import Build.Print (failure)
18−
1913import qualified SourceSyntax.Module as Module
2014import qualified Parse.Parse as Parse
2115import qualified Elm.Internal.Paths as Path
2216import qualified Elm.Internal.Name as N
17+import qualified Elm.Internal.Version as V
2318import qualified Elm.Internal.Dependencies as Deps
2419
25−getSortedDependencies :: [FilePath] -> Module.Interfaces -> FilePath -> IO [String]
26−getSortedDependencies srcDirs builtIns root =
27− do extras <- extraDependencies
28− let allSrcDirs = srcDirs ++ Maybe.fromMaybe [] extras
29− result <- runErrorT $ readAllDeps allSrcDirs builtIns root
30− case result of
31− Right deps -> sortDeps deps
32− Left err -> failure err
33−
34−extraDependencies :: IO (Maybe [FilePath])
35−extraDependencies =
36− do exists <- doesFileExist Path.dependencyFile
37− if not exists then return Nothing else Just <$> getPaths
20+data Recipe = Recipe
21+ { _elmFiles :: [FilePath]
22+ , _jsFiles :: [FilePath]
23+ }
24+
25+getBuildRecipe :: [FilePath] -> Module.Interfaces -> FilePath -> ErrorT String IO Recipe
26+getBuildRecipe srcDirs builtIns root =
27+ do directories <- getDependencies
28+ jsFiles <- nativeFiles ("." : directories)
29+ let allSrcDirs = srcDirs ++ directories
30+ nodes <- collectDependencies allSrcDirs builtIns root
31+ elmFiles <- sortElmFiles nodes
32+ return (Recipe elmFiles jsFiles)
33+
34+-- | Based on the projects elm_dependencies.json, find all of the paths and
35+-- dependency information we might need.
36+getDependencies :: ErrorT String IO [FilePath]
37+getDependencies =
38+ do exists <- liftIO $ doesFileExist Path.dependencyFile
39+ if not exists then return [] else getPaths
3840 where
39− getPaths = do
40− raw <- BSC.readFile Path.dependencyFile
41− case Json.eitherDecode raw of
42− Right (Deps.Mini deps) -> mapM validate deps
43− Left err ->
44− failure $ "Error reading the " ++ Path.dependencyFile ++ " file:\n" ++ err
45−
46− validate (name,version) = do
47− let path = Path.dependencyDirectory </> toPath name version
48− exists <- doesDirectoryExist path
49− if exists then return path else failure (notFound name version)
50−
51− toPath name version = N.toFilePath name </> show version
52−
41+ getPaths :: ErrorT String IO [FilePath]
42+ getPaths =
43+ Deps.withDeps Path.dependencyFile $ \deps ->
44+ mapM getPath (Deps.dependencies deps)
45+
46+ getPath :: (N.Name, V.Version) -> ErrorT String IO FilePath
47+ getPath (name,version) = do
48+ let path = Path.dependencyDirectory </> N.toFilePath name </> show version
49+ exists <- liftIO $ doesDirectoryExist path
50+ if exists
51+ then return path
52+ else throwError (notFound name version)
53+
54+ notFound :: N.Name -> V.Version -> String
5355 notFound name version =
5456 unlines
5557 [ "Your " ++ Path.dependencyFile ++ " file says you depend on library"
@@ -58,27 +60,47 @@ extraDependencies =
5860 , ""
5961 , " elm-get install " ++ show name ++ " " ++ show version ]
6062
61−type Deps = (FilePath, String, [String])
63+nativeFiles :: [FilePath] -> ErrorT String IO [FilePath]
64+nativeFiles directories =
65+ concat `fmap` mapM getNativeFiles directories
66+ where
67+ getNativeFiles dir =
68+ Deps.withDeps (dir </> Path.dependencyFile) $ \deps ->
69+ return (map (toPath dir) (Deps.native deps))
70+
71+ toPath dir moduleName =
72+ dir </> joinPath (split moduleName) <.> "js"
73+
74+split :: String -> [String]
75+split moduleName = go [] moduleName
76+ where
77+ go paths str =
78+ case break (=='.') str of
79+ (path, _:rest) -> go (paths ++ [path]) rest
80+ (path, []) -> paths ++ [path]
81+
82+type DependencyNode = (FilePath, String, [String])
6283
63−sortDeps :: [Deps] -> IO [String]
64−sortDeps depends =
84+sortElmFiles :: [DependencyNode] -> ErrorT String IO [FilePath]
85+sortElmFiles depends =
6586 if null mistakes
6687 then return (concat sccs)
67− else failure $ msg ++ unlines (map show mistakes)
88+ else throwError $ msg ++ unlines (map show mistakes)
6889 where
6990 sccs = map Graph.flattenSCC $ Graph.stronglyConnComp depends
7091
7192 mistakes = filter (\scc -> length scc > 1) sccs
7293 msg = "A cyclical module dependency or was detected in:\n"
7394
74−readAllDeps :: [FilePath] -> Module.Interfaces -> FilePath -> ErrorT String IO [Deps]
75−readAllDeps srcDirs rawBuiltIns filePath =
95+collectDependencies :: [FilePath] -> Module.Interfaces -> FilePath
96+ -> ErrorT String IO [DependencyNode]
97+collectDependencies srcDirs rawBuiltIns filePath =
7698 State.evalStateT (go Nothing filePath) Set.empty
7799 where
78100 builtIns :: Set.Set String
79101 builtIns = Set.fromList $ Map.keys rawBuiltIns
80102
81− go :: Maybe String -> FilePath -> State.StateT (Set.Set String) (ErrorT String IO) [Deps]
103+ go :: Maybe String -> FilePath -> State.StateT (Set.Set String) (ErrorT String IO) [DependencyNode]
82104 go parentModuleName filePath = do
83105 filePath' <- lift $ findSrcFile parentModuleName srcDirs filePath
84106 (moduleName, deps) <- lift $ readDeps filePath'
@@ -93,9 +115,9 @@ readDeps :: FilePath -> ErrorT String IO (String, [String])
93115readDeps path = do
94116 txt <- lift $ readFile path
95117 case Parse.dependencies txt of
118+ Right o -> return o
96119 Left err -> throwError $ msg ++ show err
97120 where msg = "Error resolving dependencies in " ++ path ++ ":\n"
98− Right o -> return o
99121
100122findSrcFile :: Maybe String -> [FilePath] -> FilePath -> ErrorT String IO FilePath
101123findSrcFile parentModuleName dirs path =