git.iko.soy/elk
on 4bec310 help sign in
elk/compiler/Build/Dependencies.hs
133 lines 5.1 kB history raw
1{-# OPTIONS_GHC -W #-}
2module Build.Dependencies (getSortedDependencies, readDeps) where
4import Control.Applicative
5import Control.Monad.Error
6import qualified Control.Monad.State as State
7import qualified Data.Aeson as Json
8import qualified Data.ByteString.Lazy.Char8 as BSC
9import qualified Data.Graph as Graph
10import qualified Data.List as List
11import qualified Data.Map as Map
12import qualified Data.Maybe as Maybe
13import qualified Data.Set as Set
14import System.Directory
15import System.FilePath as FP
17import Build.Print (failure)
19import qualified SourceSyntax.Module as Module
20import qualified Parse.Parse as Parse
21import qualified Elm.Internal.Paths as Path
22import qualified Elm.Internal.Name as N
23import qualified Elm.Internal.Dependencies as Deps
25getSortedDependencies :: [FilePath] -> Module.Interfaces -> FilePath -> IO [String]
26getSortedDependencies 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
34extraDependencies :: IO (Maybe [FilePath])
35extraDependencies =
36 do exists <- doesFileExist Path.dependencyFile
37 if not exists then return Nothing else Just <$> getPaths
38 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
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)
51 toPath name version = N.toFilePath name </> show version
53 notFound name version =
54 unlines
55 [ "Your " ++ Path.dependencyFile ++ " file says you depend on library"
56 , show name ++ " " ++ show version ++ " but it was not found."
57 , "You may need to install it with:"
58 , ""
59 , " elm-get install " ++ show name ++ " " ++ show version ]
61type Deps = (FilePath, String, [String])
63sortDeps :: [Deps] -> IO [String]
64sortDeps depends =
65 if null mistakes
66 then return (concat sccs)
67 else failure $ msg ++ unlines (map show mistakes)
68 where
69 sccs = map Graph.flattenSCC $ Graph.stronglyConnComp depends
71 mistakes = filter (\scc -> length scc > 1) sccs
72 msg = "A cyclical module dependency or was detected in:\n"
74readAllDeps :: [FilePath] -> Module.Interfaces -> FilePath -> ErrorT String IO [Deps]
75readAllDeps srcDirs rawBuiltIns filePath =
76 State.evalStateT (go Nothing filePath) Set.empty
77 where
78 builtIns :: Set.Set String
79 builtIns = Set.fromList $ Map.keys rawBuiltIns
81 go :: Maybe String -> FilePath -> State.StateT (Set.Set String) (ErrorT String IO) [Deps]
82 go parentModuleName filePath = do
83 filePath' <- lift $ findSrcFile parentModuleName srcDirs filePath
84 (moduleName, deps) <- lift $ readDeps filePath'
85 seen <- State.get
86 let realDeps = Set.difference (Set.fromList deps) builtIns
87 newDeps = Set.difference (Set.filter (not . isNative) realDeps) seen
88 State.put (Set.insert moduleName (Set.union newDeps seen))
89 rest <- mapM (go (Just moduleName) . toFilePath) (Set.toList newDeps)
90 return ((makeRelative "." filePath', moduleName, Set.toList realDeps) : concat rest)
92readDeps :: FilePath -> ErrorT String IO (String, [String])
93readDeps path = do
94 txt <- lift $ readFile path
95 case Parse.dependencies txt of
96 Left err -> throwError $ msg ++ show err
97 where msg = "Error resolving dependencies in " ++ path ++ ":\n"
98 Right o -> return o
100findSrcFile :: Maybe String -> [FilePath] -> FilePath -> ErrorT String IO FilePath
101findSrcFile parentModuleName dirs path =
102 foldr tryDir notFound dirs
103 where
104 tryDir dir next = do
105 let path' = dir </> path
106 exists <- liftIO $ doesFileExist path'
107 if exists
108 then return path'
109 else next
111 parentModuleName' =
112 case parentModuleName of
113 Just name -> "module '" ++ name ++ "'"
114 Nothing -> "the main module"
116 notFound = throwError $ unlines
117 [ "When finding the imports declared in " ++ parentModuleName' ++ ", could not find file: " ++ path
118 , " If you created this module, but it is in a subdirectory that does not"
119 , " exactly match the module name, you may need to use the --src-dir flag."
120 , ""
121 , " If it is part of a 3rd party library, it needs to be declared"
122 , " as a dependency in your project's " ++ Path.dependencyFile ++ " file."
123 ]
125isNative :: String -> Bool
126isNative name = List.isPrefixOf "Native." name
128toFilePath :: String -> FilePath
129toFilePath name = map swapDots name ++ ext
130 where
131 swapDots '.' = '/'
132 swapDots c = c
133 ext = if isNative name then ".js" else ".elm"