@@ -2,7 +2,10 @@ module Build.Dependencies (getSortedDependencies) where
3import Data.Data
3import Data.Data
4import Control.Applicative
4import Control.Applicative
5−import Control.Monad.State
5+import Control.Monad.Error
6+import qualified Control.Monad.State as State
7+import qualified Data.Aeson as Json
8+import qualified Data.ByteString.Lazy.Char8 as BSC
6import qualified Data.Char as Char
9import qualified Data.Char as Char
7import qualified Data.Graph as Graph
10import qualified Data.Graph as Graph
8import qualified Data.List as List
11import qualified Data.List as List
@@ -24,82 +27,99 @@ import qualified Transform.SortDefinitions as SD
24import qualified Type.Inference as TI
27import qualified Type.Inference as TI
25import qualified Type.Constrain.Declaration as TcDecl
28import qualified Type.Constrain.Declaration as TcDecl
26import qualified Transform.Canonicalize as Canonical
29import qualified Transform.Canonicalize as Canonical
30+import qualified Elm.Internal.Paths as Path
31+import qualified Elm.Internal.Name as N
27import qualified Elm.Internal.Version as V
32import qualified Elm.Internal.Version as V
33+import qualified Elm.Internal.Dependencies as Deps
29getSortedDependencies :: [FilePath] -> Interfaces -> FilePath -> IO [String]
35getSortedDependencies :: [FilePath] -> Interfaces -> FilePath -> IO [String]
30getSortedDependencies srcDirs builtIns root =
36getSortedDependencies srcDirs builtIns root =
31− do extras <- additionalSourceDirs
37+ do extras <- extraDependencies
32− sortDeps =<< readDeps (srcDirs ++ extras) builtIns root
38+ let allSrcDirs = srcDirs ++ Maybe.fromMaybe [] extras
33−
39+ result <- runErrorT $ readDeps allSrcDirs builtIns root
34−additionalSourceDirs :: IO [FilePath]
40+ case result of
35−additionalSourceDirs =
41+ Right deps -> sortDeps deps
36− do exists <- doesDirectoryExist deps
42+ Left err -> failure $ err ++ if Maybe.isJust extras then "" else msg
43+ where msg = "\nYou may need to create a " ++
44+ Path.dependencyFile ++
45+ " file if you\nare trying to use a 3rd party library."
47+failure msg = hPutStrLn stderr msg >> exitFailure
49+extraDependencies :: IO (Maybe [FilePath])
51+ do exists <- doesFileExist Path.dependencyFile
37− if exists then getProjects deps else return []
52+ if not exists then return Nothing else Just <$> getPaths
39− deps = "elm_dependencies"
54+ getPaths = do
40−
55+ raw <- BSC.readFile Path.dependencyFile
41− getProjects dir = do
56+ case Json.eitherDecode raw of
42− subs <- map (dir </>) <$> getDirectoryContents dir
57+ Right deps -> mapM validate (Deps.dependencies deps)
43− projects <- filterM isProject subs
58+ Left err ->
44− Maybe.catMaybes <$> mapM getLatest projects
59+ failure $ "Error reading the " ++ Path.dependencyFile ++ " file:\n" ++ err
61+ validate (name,version) = do
62+ let path = Path.dependencyDirectory </> toPath name version
63+ exists <- doesDirectoryExist path
64+ if exists then return path else failure (notFound name version)
46− getLatest project = do
66+ toPath name version = N.toFilePath name </> show version
47− subs <- getDirectoryContents project
48− case Maybe.mapMaybe V.fromString subs of
50− versions -> return $ Just $ (project </>) $ show maxVersion
51− where maxVersion = List.maximum versions
53− isProject path = do
68+ notFound name version =
54− exists <- doesDirectoryExist path
69+ unlines
55− return $ exists && path `notElem` [".","..","_internals"]
70+ [ "Your " ++ Path.dependencyFile ++ " file says you depend on library"
71+ , show name ++ " " ++ show version ++ " but it was not found."
72+ , "You may need to install it with:"
74+ , " elm-get install " ++ show name ++ " " ++ show version ]
57type Deps = (FilePath, String, [String])
76type Deps = (FilePath, String, [String])
59sortDeps :: [Deps] -> IO [String]
78sortDeps :: [Deps] -> IO [String]
60sortDeps depends =
79sortDeps depends =
61 if null mistakes
80 if null mistakes
62− then return (concat sccs)
81+ then return (concat sccs)
63− else print msg >> mapM print mistakes >> exitFailure
82+ else failure $ msg ++ unlines (map show mistakes)
65 sccs = map Graph.flattenSCC $ Graph.stronglyConnComp depends
84 sccs = map Graph.flattenSCC $ Graph.stronglyConnComp depends
67 mistakes = filter (\scc -> length scc > 1) sccs
86 mistakes = filter (\scc -> length scc > 1) sccs
68− msg = "A cyclical module dependency or was detected in: "
87+ msg = "A cyclical module dependency or was detected in:\n"
70−readDeps :: [FilePath] -> Interfaces -> FilePath -> IO [Deps]
89+readDeps :: [FilePath] -> Interfaces -> FilePath -> ErrorT String IO [Deps]
71readDeps srcDirs builtIns root = do
90readDeps srcDirs builtIns root = do
72 let ifaces = (Set.fromList . Map.keys) builtIns
91 let ifaces = (Set.fromList . Map.keys) builtIns
73− evalStateT (go ifaces root) Set.empty
92+ State.evalStateT (go ifaces root) Set.empty
75− go :: Set.Set String -> FilePath -> StateT (Set.Set String) IO [Deps]
94+ go :: Set.Set String -> FilePath -> State.StateT (Set.Set String) (ErrorT String IO) [Deps]
76 go builtIns root = do
95 go builtIns root = do
77− (root', txt) <- liftIO $ getFile srcDirs root
96+ (root', txt) <- lift $ getFile srcDirs root
78 case Parse.dependencies txt of
97 case Parse.dependencies txt of
79− Left err -> liftIO (putStrLn msg >> print err >> exitFailure)
98+ Left err -> throwError $ msg ++ show err
80− where msg = "Error resolving dependencies in " ++ root' ++ ":"
99+ where msg = "Error resolving dependencies in " ++ root' ++ ":\n"
82 Right (name,deps) ->
101 Right (name,deps) ->
83− do seen <- get
102+ do seen <- State.get
84 let realDeps = Set.difference (Set.fromList deps) builtIns
103 let realDeps = Set.difference (Set.fromList deps) builtIns
85 newDeps = Set.difference (Set.filter (not . isNative) realDeps) seen
104 newDeps = Set.difference (Set.filter (not . isNative) realDeps) seen
86− put (Set.insert name (Set.union newDeps seen))
105+ State.put (Set.insert name (Set.union newDeps seen))
87 rest <- mapM (go builtIns . toFilePath) (Set.toList newDeps)
106 rest <- mapM (go builtIns . toFilePath) (Set.toList newDeps)
88 return ((makeRelative "." root', name, Set.toList realDeps) : concat rest)
107 return ((makeRelative "." root', name, Set.toList realDeps) : concat rest)
90−getFile :: [FilePath] -> FilePath -> IO (FilePath,String)
109+getFile :: [FilePath] -> FilePath -> ErrorT String IO (FilePath,String)
91−getFile [] path = do
110+getFile [] path =
92− hPutStrLn stderr $ unlines
111+ throwError $ unlines
93 [ "Could not find file: " ++ path
112 [ "Could not find file: " ++ path
94 , " If it is not in the root directory of your project, use"
113 , " If it is not in the root directory of your project, use"
95− , " --src-dir to declare additional locations for source files." ]
114+ , " --src-dir to declare additional locations for source files."
96− exitFailure
115+ , " If it is part of a 3rd party library, it needs to be declared"
116+ , " as a dependency in the " ++ Path.dependencyFile ++ " file." ]
98getFile (dir:dirs) path = do
118getFile (dir:dirs) path = do
99 let path' = dir </> path
119 let path' = dir </> path
100− exists <- doesFileExist path'
120+ exists <- liftIO $ doesFileExist path'
101 case exists of
121 case exists of
102− True -> (,) path' `fmap` readFile path'
122+ True -> (,) path' `fmap` liftIO (readFile path')
103 False -> getFile dirs path
123 False -> getFile dirs path
105isNative name = List.isPrefixOf "Native." name
125isNative name = List.isPrefixOf "Native." name