@@ -7,7 +7,9 @@ module Stuff
77 , elmi
88 , elmo
99 , temp
10− , getRoot
10+ , findRoot
11+ , withProjectLock
12+ , withCacheLock
1113 , PackageCache
1214 , getPackageCache
1315 , registry
@@ -19,6 +21,7 @@ module Stuff
1921
2022import qualified System.Directory as Dir
2123import qualified System.Environment as Env
24+import qualified System.FileLock as Lock
2225import qualified System.FilePath as FP
2326import System.FilePath ((</>), (<.>))
2427
@@ -31,29 +34,29 @@ import qualified Elm.Version as V
3134-- PATHS
3235
3336
34−stuff :: FilePath
35−stuff =
36− "elm-stuff" </> compilerVersion
37+stuff :: FilePath -> FilePath
38+stuff root =
39+ root </> "elm-stuff" </> compilerVersion
3740
3841
39−details :: FilePath
40−details =
41− stuff </> "d.dat"
42+details :: FilePath -> FilePath
43+details root =
44+ stuff root </> "d.dat"
4245
4346
44−interfaces :: FilePath
45−interfaces =
46− stuff </> "i.dat"
47+interfaces :: FilePath -> FilePath
48+interfaces root =
49+ stuff root </> "i.dat"
4750
4851
49−objects :: FilePath
50−objects =
51− stuff </> "o.dat"
52+objects :: FilePath -> FilePath
53+objects root =
54+ stuff root </> "o.dat"
5255
5356
54−prepublishDir :: FilePath
55−prepublishDir =
56− stuff </> "prepublish"
57+prepublishDir :: FilePath -> FilePath
58+prepublishDir root =
59+ stuff root </> "prepublish"
5760
5861
5962compilerVersion :: FilePath
@@ -77,39 +80,56 @@ elmo root name =
7780
7881toArtifactPath :: FilePath -> ModuleName.Raw -> String -> FilePath
7982toArtifactPath root name ext =
80− root </> stuff </> ModuleName.toHyphenPath name <.> ext
83+ stuff root </> ModuleName.toHyphenPath name <.> ext
8184
8285
8386
8487-- TEMP
8588
8689
87−temp :: String -> FilePath
88−temp ext =
89− stuff </> "temp" <.> ext
90+temp :: FilePath -> String -> FilePath
91+temp root ext =
92+ stuff root </> "temp" <.> ext
9093
9194
9295
93−-- GET ROOT
96+-- ROOT
9497
9598
96−getRoot :: IO (Maybe FilePath)
97−getRoot =
99+findRoot :: IO (Maybe FilePath)
100+findRoot =
98101 do dir <- Dir.getCurrentDirectory
99− getRootHelp (FP.splitDirectories dir)
102+ findRootHelp (FP.splitDirectories dir)
100103
101104
102−getRootHelp :: [String] -> IO (Maybe FilePath)
103−getRootHelp dirs =
105+findRootHelp :: [String] -> IO (Maybe FilePath)
106+findRootHelp dirs =
104107 case dirs of
105108 [] ->
106109 return Nothing
107110
108111 _:_ ->
109− do exists_ <- Dir.doesFileExist (FP.joinPath dirs </> "elm.json")
110− if exists_
112+ do exists <- Dir.doesFileExist (FP.joinPath dirs </> "elm.json")
113+ if exists
111114 then return (Just (FP.joinPath dirs))
112− else getRootHelp (init dirs)
115+ else findRootHelp (init dirs)
116+
117+
118+
119+-- LOCKS
120+
121+
122+withProjectLock :: FilePath -> IO a -> IO a
123+withProjectLock root work =
124+ do let dir = stuff root
125+ Dir.createDirectoryIfMissing True dir
126+ Lock.withFileLock (dir </> "project.lock") Lock.Exclusive (\_ -> work)
127+
128+
129+withCacheLock :: PackageCache -> IO a -> IO a
130+withCacheLock (PackageCache dir) work =
131+ Lock.withFileLock (dir </> "cache.lock") Lock.Exclusive (\_ -> work)
132+
113133
114134
115135