git.iko.soy/elk
on master help sign in
Add file locking mechanism to Stuff module / make API more reliable
8d998beEvan Czaplicki
builder/src/Stuff.hs+49−29
compare with master
unifiedsplit
@@ -7,7 +7,9 @@ module Stuff
7 , elmi
7 , elmi
8 , elmo
8 , elmo
9 , temp
9 , temp
10− , getRoot
10+ , findRoot
11+ , withProjectLock
12+ , withCacheLock
11 , PackageCache
13 , PackageCache
12 , getPackageCache
14 , getPackageCache
13 , registry
15 , registry
@@ -19,6 +21,7 @@ module Stuff
19
21
20import qualified System.Directory as Dir
22import qualified System.Directory as Dir
21import qualified System.Environment as Env
23import qualified System.Environment as Env
24+import qualified System.FileLock as Lock
22import qualified System.FilePath as FP
25import qualified System.FilePath as FP
23import System.FilePath ((</>), (<.>))
26import System.FilePath ((</>), (<.>))
24
27
@@ -31,29 +34,29 @@ import qualified Elm.Version as V
31-- PATHS
34-- PATHS
32
35
33
36
34−stuff :: FilePath
37+stuff :: FilePath -> FilePath
35−stuff =
38+stuff root =
36− "elm-stuff" </> compilerVersion
39+ root </> "elm-stuff" </> compilerVersion
37
40
38
41
39−details :: FilePath
42+details :: FilePath -> FilePath
40−details =
43+details root =
41− stuff </> "d.dat"
44+ stuff root </> "d.dat"
42
45
43
46
44−interfaces :: FilePath
47+interfaces :: FilePath -> FilePath
45−interfaces =
48+interfaces root =
46− stuff </> "i.dat"
49+ stuff root </> "i.dat"
47
50
48
51
49−objects :: FilePath
52+objects :: FilePath -> FilePath
50−objects =
53+objects root =
51− stuff </> "o.dat"
54+ stuff root </> "o.dat"
52
55
53
56
54−prepublishDir :: FilePath
57+prepublishDir :: FilePath -> FilePath
55−prepublishDir =
58+prepublishDir root =
56− stuff </> "prepublish"
59+ stuff root </> "prepublish"
57
60
58
61
59compilerVersion :: FilePath
62compilerVersion :: FilePath
@@ -77,39 +80,56 @@ elmo root name =
77
80
78toArtifactPath :: FilePath -> ModuleName.Raw -> String -> FilePath
81toArtifactPath :: FilePath -> ModuleName.Raw -> String -> FilePath
79toArtifactPath root name ext =
82toArtifactPath root name ext =
80− root </> stuff </> ModuleName.toHyphenPath name <.> ext
83+ stuff root </> ModuleName.toHyphenPath name <.> ext
81
84
82
85
83
86
84-- TEMP
87-- TEMP
85
88
86
89
87−temp :: String -> FilePath
90+temp :: FilePath -> String -> FilePath
88−temp ext =
91+temp root ext =
89− stuff </> "temp" <.> ext
92+ stuff root </> "temp" <.> ext
90
93
91
94
92
95
93−-- GET ROOT
96+-- ROOT
94
97
95
98
96−getRoot :: IO (Maybe FilePath)
99+findRoot :: IO (Maybe FilePath)
97−getRoot =
100+findRoot =
98 do dir <- Dir.getCurrentDirectory
101 do dir <- Dir.getCurrentDirectory
99− getRootHelp (FP.splitDirectories dir)
102+ findRootHelp (FP.splitDirectories dir)
100
103
101
104
102−getRootHelp :: [String] -> IO (Maybe FilePath)
105+findRootHelp :: [String] -> IO (Maybe FilePath)
103−getRootHelp dirs =
106+findRootHelp dirs =
104 case dirs of
107 case dirs of
105 [] ->
108 [] ->
106 return Nothing
109 return Nothing
107
110
108 _:_ ->
111 _:_ ->
109− do exists_ <- Dir.doesFileExist (FP.joinPath dirs </> "elm.json")
112+ do exists <- Dir.doesFileExist (FP.joinPath dirs </> "elm.json")
110− if exists_
113+ if exists
111 then return (Just (FP.joinPath dirs))
114 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+
113
133
114
134
115
135