git.iko.soy/elk
on 577fc17 help sign in
elk/compiler/Build/Dependencies.hs
158 lines 5.9 kB history raw
1{-# OPTIONS_GHC -W #-}
2module Build.Dependencies (Recipe(..), getBuildRecipe, readDeps) where
4import Control.Monad.Error
5import qualified Control.Monad.State as State
6import qualified Data.Graph as Graph
7import qualified Data.List as List
8import qualified Data.Map as Map
9import qualified Data.Set as Set
10import System.Directory
11import System.FilePath as FP
13import qualified AST.Module as Module
14import qualified Parse.Parse as Parse
15import qualified Elm.Internal.Paths as Path
16import qualified Elm.Internal.Name as N
17import qualified Elm.Internal.Version as V
18import qualified Elm.Internal.Dependencies as Deps
20data Recipe = Recipe
21 { _elmFiles :: [FilePath]
22 , _jsFiles :: [FilePath]
23 }
25getBuildRecipe :: [FilePath] -> Module.Interfaces -> FilePath -> ErrorT String IO Recipe
26getBuildRecipe 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)
34-- | Based on the projects elm_dependencies.json, find all of the paths and
35-- dependency information we might need.
36getDependencies :: ErrorT String IO [FilePath]
37getDependencies =
38 do exists <- liftIO $ doesFileExist Path.dependencyFile
39 if not exists then return [] else getPaths
40 where
41 getPaths :: ErrorT String IO [FilePath]
42 getPaths =
43 Deps.withDeps Path.dependencyFile $ \deps ->
44 mapM getPath (Deps.dependencies deps)
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)
54 notFound :: N.Name -> V.Version -> String
55 notFound name version =
56 unlines
57 [ "Your " ++ Path.dependencyFile ++ " file says you depend on library"
58 , show name ++ " " ++ show version ++ " but it was not found."
59 , "You may need to install it with:"
60 , ""
61 , " elm-get install " ++ show name ++ " " ++ show version ]
63nativeFiles :: [FilePath] -> ErrorT String IO [FilePath]
64nativeFiles directories =
65 do exists <- liftIO $ doesFileExist Path.dependencyFile
66 if not exists
67 then return []
68 else concat `fmap` mapM getNativeFiles directories
69 where
70 getNativeFiles dir =
71 Deps.withDeps (dir </> Path.dependencyFile) $ \deps ->
72 return (map (toPath dir) (Deps.native deps))
74 toPath dir moduleName =
75 dir </> joinPath (split moduleName) <.> "js"
77split :: String -> [String]
78split moduleName = go [] moduleName
79 where
80 go paths str =
81 case break (=='.') str of
82 (path, _:rest) -> go (paths ++ [path]) rest
83 (path, []) -> paths ++ [path]
85type DependencyNode = (FilePath, String, [String])
87sortElmFiles :: [DependencyNode] -> ErrorT String IO [FilePath]
88sortElmFiles depends =
89 if null mistakes
90 then return (concat sccs)
91 else throwError $ msg ++ unlines (map show mistakes)
92 where
93 sccs = map Graph.flattenSCC $ Graph.stronglyConnComp depends
95 mistakes = filter (\scc -> length scc > 1) sccs
96 msg = "A cyclical module dependency or was detected in:\n"
98collectDependencies :: [FilePath] -> Module.Interfaces -> FilePath
99 -> ErrorT String IO [DependencyNode]
100collectDependencies srcDirs rawBuiltIns filePath =
101 State.evalStateT (go Nothing filePath) Set.empty
102 where
103 builtIns :: Set.Set String
104 builtIns = Set.fromList $ Map.keys rawBuiltIns
106 go :: Maybe String -> FilePath -> State.StateT (Set.Set String) (ErrorT String IO) [DependencyNode]
107 go parentModuleName filePath = do
108 filePath' <- lift $ findSrcFile parentModuleName srcDirs filePath
109 (moduleName, deps) <- lift $ readDeps filePath'
110 seen <- State.get
111 let realDeps = Set.difference (Set.fromList deps) builtIns
112 newDeps = Set.difference (Set.filter (not . isNative) realDeps) seen
113 State.put (Set.insert moduleName (Set.union newDeps seen))
114 rest <- mapM (go (Just moduleName) . toFilePath) (Set.toList newDeps)
115 return ((makeRelative "." filePath', moduleName, Set.toList realDeps) : concat rest)
117readDeps :: FilePath -> ErrorT String IO (String, [String])
118readDeps path = do
119 txt <- lift $ readFile path
120 case Parse.dependencies txt of
121 Right o -> return o
122 Left err -> throwError $ msg ++ show err
123 where msg = "Error resolving dependencies in " ++ path ++ ":\n"
125findSrcFile :: Maybe String -> [FilePath] -> FilePath -> ErrorT String IO FilePath
126findSrcFile parentModuleName dirs path =
127 foldr tryDir notFound dirs
128 where
129 tryDir dir next = do
130 let path' = dir </> path
131 exists <- liftIO $ doesFileExist path'
132 if exists
133 then return path'
134 else next
136 parentModuleName' =
137 case parentModuleName of
138 Just name -> "module '" ++ name ++ "'"
139 Nothing -> "the main module"
141 notFound = throwError $ unlines
142 [ "When finding the imports declared in " ++ parentModuleName' ++ ", could not find file: " ++ path
143 , " If you created this module, but it is in a subdirectory that does not"
144 , " exactly match the module name, you may need to use the --src-dir flag."
145 , ""
146 , " If it is part of a 3rd party library, it needs to be declared"
147 , " as a dependency in your project's " ++ Path.dependencyFile ++ " file."
148 ]
150isNative :: String -> Bool
151isNative name = List.isPrefixOf "Native." name
153toFilePath :: String -> FilePath
154toFilePath name = map swapDots name ++ ext
155 where
156 swapDots '.' = '/'
157 swapDots c = c
158 ext = if isNative name then ".js" else ".elm"