@@ -2,7 +2,10 @@ module Build.Dependencies (getSortedDependencies) where
22
33import Data.Data
44import 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
69import qualified Data.Char as Char
710import qualified Data.Graph as Graph
811import qualified Data.List as List
@@ -24,82 +27,99 @@ import qualified Transform.SortDefinitions as SD
2427import qualified Type.Inference as TI
2528import qualified Type.Constrain.Declaration as TcDecl
2629import qualified Transform.Canonicalize as Canonical
30+import qualified Elm.Internal.Paths as Path
31+import qualified Elm.Internal.Name as N
2732import qualified Elm.Internal.Version as V
33+import qualified Elm.Internal.Dependencies as Deps
2834
2935getSortedDependencies :: [FilePath] -> Interfaces -> FilePath -> IO [String]
3036getSortedDependencies srcDirs builtIns root =
31− do extras <- additionalSourceDirs
32− sortDeps =<< readDeps (srcDirs ++ extras) builtIns root
33−
34−additionalSourceDirs :: IO [FilePath]
35−additionalSourceDirs =
36− do exists <- doesDirectoryExist deps
37− if exists then getProjects deps else return []
37+ do extras <- extraDependencies
38+ let allSrcDirs = srcDirs ++ Maybe.fromMaybe [] extras
39+ result <- runErrorT $ readDeps allSrcDirs builtIns root
40+ case result of
41+ Right deps -> sortDeps 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."
46+
47+failure msg = hPutStrLn stderr msg >> exitFailure
48+
49+extraDependencies :: IO (Maybe [FilePath])
50+extraDependencies =
51+ do exists <- doesFileExist Path.dependencyFile
52+ if not exists then return Nothing else Just <$> getPaths
3853 where
39− deps = "elm_dependencies"
40−
41− getProjects dir = do
42− subs <- map (dir </>) <$> getDirectoryContents dir
43− projects <- filterM isProject subs
44− Maybe.catMaybes <$> mapM getLatest projects
54+ getPaths = do
55+ raw <- BSC.readFile Path.dependencyFile
56+ case Json.eitherDecode raw of
57+ Right deps -> mapM validate (Deps.dependencies deps)
58+ Left err ->
59+ failure $ "Error reading the " ++ Path.dependencyFile ++ " file:\n" ++ err
60+
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)
4565
46− getLatest project = do
47− subs <- getDirectoryContents project
48− case Maybe.mapMaybe V.fromString subs of
49− [] -> return Nothing
50− versions -> return $ Just $ (project </>) $ show maxVersion
51− where maxVersion = List.maximum versions
66+ toPath name version = N.toFilePath name </> show version
5267
53− isProject path = do
54− exists <- doesDirectoryExist path
55− return $ exists && path `notElem` [".","..","_internals"]
68+ notFound name version =
69+ unlines
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:"
73+ , ""
74+ , " elm-get install " ++ show name ++ " " ++ show version ]
5675
5776type Deps = (FilePath, String, [String])
5877
5978sortDeps :: [Deps] -> IO [String]
6079sortDeps depends =
6180 if null mistakes
62− then return (concat sccs)
63− else print msg >> mapM print mistakes >> exitFailure
81+ then return (concat sccs)
82+ else failure $ msg ++ unlines (map show mistakes)
6483 where
6584 sccs = map Graph.flattenSCC $ Graph.stronglyConnComp depends
6685
6786 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"
6988
70−readDeps :: [FilePath] -> Interfaces -> FilePath -> IO [Deps]
89+readDeps :: [FilePath] -> Interfaces -> FilePath -> ErrorT String IO [Deps]
7190readDeps srcDirs builtIns root = do
7291 let ifaces = (Set.fromList . Map.keys) builtIns
73− evalStateT (go ifaces root) Set.empty
92+ State.evalStateT (go ifaces root) Set.empty
7493 where
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]
7695 go builtIns root = do
77− (root', txt) <- liftIO $ getFile srcDirs root
96+ (root', txt) <- lift $ getFile srcDirs root
7897 case Parse.dependencies txt of
79− Left err -> liftIO (putStrLn msg >> print err >> exitFailure)
80− where msg = "Error resolving dependencies in " ++ root' ++ ":"
98+ Left err -> throwError $ msg ++ show err
99+ where msg = "Error resolving dependencies in " ++ root' ++ ":\n"
81100
82101 Right (name,deps) ->
83− do seen <- get
102+ do seen <- State.get
84103 let realDeps = Set.difference (Set.fromList deps) builtIns
85104 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))
87106 rest <- mapM (go builtIns . toFilePath) (Set.toList newDeps)
88107 return ((makeRelative "." root', name, Set.toList realDeps) : concat rest)
89108
90−getFile :: [FilePath] -> FilePath -> IO (FilePath,String)
91−getFile [] path = do
92− hPutStrLn stderr $ unlines
109+getFile :: [FilePath] -> FilePath -> ErrorT String IO (FilePath,String)
110+getFile [] path =
111+ throwError $ unlines
93112 [ "Could not find file: " ++ path
94113 , " If it is not in the root directory of your project, use"
95− , " --src-dir to declare additional locations for source files." ]
96− exitFailure
114+ , " --src-dir to declare additional locations for source files."
115+ , " If it is part of a 3rd party library, it needs to be declared"
116+ , " as a dependency in the " ++ Path.dependencyFile ++ " file." ]
97117
98118getFile (dir:dirs) path = do
99119 let path' = dir </> path
100− exists <- doesFileExist path'
120+ exists <- liftIO $ doesFileExist path'
101121 case exists of
102− True -> (,) path' `fmap` readFile path'
122+ True -> (,) path' `fmap` liftIO (readFile path')
103123 False -> getFile dirs path
104124
105125isNative name = List.isPrefixOf "Native." name