git.iko.soy/elk
on 63243ca help sign in
elk/compiler/Build/Dependencies.hs
121 lines 4.8 kB history raw
1{-# OPTIONS_GHC -W #-}
2module Build.Dependencies (getSortedDependencies) 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.Exit
16import System.FilePath as FP
17import System.IO
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 $ readDeps allSrcDirs builtIns root
30 case result of
31 Right deps -> sortDeps deps
32 Left err -> failure $ err ++ if Maybe.isJust extras then "" else msg
33 where msg = "\nYou may need to create a " ++
34 Path.dependencyFile ++
35 " file if you\nare trying to use a 3rd party library."
37failure msg = hPutStrLn stderr msg >> exitFailure
39extraDependencies :: IO (Maybe [FilePath])
40extraDependencies =
41 do exists <- doesFileExist Path.dependencyFile
42 if not exists then return Nothing else Just <$> getPaths
43 where
44 getPaths = do
45 raw <- BSC.readFile Path.dependencyFile
46 case Json.eitherDecode raw of
47 Right (Deps.Mini deps) -> mapM validate deps
48 Left err ->
49 failure $ "Error reading the " ++ Path.dependencyFile ++ " file:\n" ++ err
51 validate (name,version) = do
52 let path = Path.dependencyDirectory </> toPath name version
53 exists <- doesDirectoryExist path
54 if exists then return path else failure (notFound name version)
56 toPath name version = N.toFilePath name </> show version
58 notFound name version =
59 unlines
60 [ "Your " ++ Path.dependencyFile ++ " file says you depend on library"
61 , show name ++ " " ++ show version ++ " but it was not found."
62 , "You may need to install it with:"
63 , ""
64 , " elm-get install " ++ show name ++ " " ++ show version ]
66type Deps = (FilePath, String, [String])
68sortDeps :: [Deps] -> IO [String]
69sortDeps depends =
70 if null mistakes
71 then return (concat sccs)
72 else failure $ msg ++ unlines (map show mistakes)
73 where
74 sccs = map Graph.flattenSCC $ Graph.stronglyConnComp depends
76 mistakes = filter (\scc -> length scc > 1) sccs
77 msg = "A cyclical module dependency or was detected in:\n"
79readDeps :: [FilePath] -> Module.Interfaces -> FilePath -> ErrorT String IO [Deps]
80readDeps srcDirs builtIns root = do
81 let ifaces = (Set.fromList . Map.keys) builtIns
82 State.evalStateT (go ifaces root) Set.empty
83 where
84 go :: Set.Set String -> FilePath -> State.StateT (Set.Set String) (ErrorT String IO) [Deps]
85 go builtIns root = do
86 (root', txt) <- lift $ getFile srcDirs root
87 case Parse.dependencies txt of
88 Left err -> throwError $ msg ++ show err
89 where msg = "Error resolving dependencies in " ++ root' ++ ":\n"
91 Right (name,deps) ->
92 do seen <- State.get
93 let realDeps = Set.difference (Set.fromList deps) builtIns
94 newDeps = Set.difference (Set.filter (not . isNative) realDeps) seen
95 State.put (Set.insert name (Set.union newDeps seen))
96 rest <- mapM (go builtIns . toFilePath) (Set.toList newDeps)
97 return ((makeRelative "." root', name, Set.toList realDeps) : concat rest)
99getFile :: [FilePath] -> FilePath -> ErrorT String IO (FilePath,String)
100getFile [] path =
101 throwError $ unlines
102 [ "Could not find file: " ++ path
103 , " If it is not in the root directory of your project, use"
104 , " --src-dir to declare additional locations for source files."
105 , " If it is part of a 3rd party library, it needs to be declared"
106 , " as a dependency in the " ++ Path.dependencyFile ++ " file." ]
108getFile (dir:dirs) path = do
109 let path' = dir </> path
110 exists <- liftIO $ doesFileExist path'
111 case exists of
112 True -> (,) path' `fmap` liftIO (readFile path')
113 False -> getFile dirs path
115isNative name = List.isPrefixOf "Native." name
117toFilePath :: String -> FilePath
118toFilePath name = map swapDots name ++ ext
119 where swapDots '.' = '/'
120 swapDots c = c
121 ext = if isNative name then ".js" else ".elm"