a74201c · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

introduce lastChange and lastCompile to detect tricky recompiles

a74201cEvan Czaplicki7 years ago

builder/src/Elm/Details.hs+44−10

compare with master

unifiedsplit

@@ -2,6 +2,7 @@

2{-# LANGUAGE BangPatterns, OverloadedStrings #-}

3module Elm.Details

4 ( Details(..)

5+ , BuildID

5 , ValidOutline(..)

6 , ValidOutline(..)

6 , Local(..)

7 , Local(..)

7 , Foreign(..)

8 , Foreign(..)

@@ -15,7 +16,7 @@ module Elm.Details

16import Control.Concurrent (forkIO)

17import Control.Concurrent (forkIO)

17import Control.Concurrent.MVar (MVar, newEmptyMVar, newMVar, putMVar, readMVar, takeMVar)

18import Control.Concurrent.MVar (MVar, newEmptyMVar, newMVar, putMVar, readMVar, takeMVar)

18−import Control.Monad (liftM, liftM2, liftM3, liftM4)

19+import Control.Monad (liftM, liftM2, liftM3)

19import Data.Binary (Binary, get, put, getWord8, putWord8)

20import Data.Binary (Binary, get, put, getWord8, putWord8)

20import qualified Data.Either as Either

21import qualified Data.Either as Either

21import qualified Data.Map as Map

22import qualified Data.Map as Map

@@ -27,6 +28,7 @@ import qualified Data.NonEmptyList as NE

27import qualified Data.OneOrMore as OneOrMore

28import qualified Data.OneOrMore as OneOrMore

28import qualified Data.Set as Set

29import qualified Data.Set as Set

29import qualified Data.Utf8 as Utf8

30import qualified Data.Utf8 as Utf8

31+import Data.Word (Word64)

30import qualified System.Directory as Dir

32import qualified System.Directory as Dir

31import System.FilePath ((</>), (<.>))

33import System.FilePath ((</>), (<.>))

@@ -66,23 +68,42 @@ data Details =

66 Details

68 Details

67 { _outlineTime :: File.Time

69 { _outlineTime :: File.Time

68 , _outline :: ValidOutline

70 , _outline :: ValidOutline

71+ , _buildID :: BuildID

69 , _locals :: Map.Map ModuleName.Raw Local

72 , _locals :: Map.Map ModuleName.Raw Local

70 , _foreigns :: Map.Map ModuleName.Raw Foreign

73 , _foreigns :: Map.Map ModuleName.Raw Foreign

71 , _extras :: Extras

74 , _extras :: Extras

72 }

75 }

78+type BuildID = Word64

79+

80+

75data ValidOutline

81data ValidOutline

76 = ValidApp (NE.List FilePath)

82 = ValidApp (NE.List FilePath)

77 | ValidPkg Pkg.Name [ModuleName.Raw] (Map.Map Pkg.Name V.Version {- for docs in reactor -})

83 | ValidPkg Pkg.Name [ModuleName.Raw] (Map.Map Pkg.Name V.Version {- for docs in reactor -})

86+-- NOTE: we need two ways to detect if a file must be recompiled:

87+--

88+-- (1) _time is the modification time from the last time we compiled the file.

89+-- By checking EQUALITY with the current modification time, we can detect file

90+-- saves and `git checkout` of previous versions. Both need a recompile.

91+--

92+-- (2) _lastChange is the BuildID from the last time a new interface file was

93+-- generated, and _lastCompile is the BuildID from the last time the file was

94+-- compiled. These may be different if a file is recompiled but the interface

95+-- stayed the same. When the _lastCompile is LESS THAN the _lastChange of any

96+-- imports, we need to recompile. This can happen when a project has multiple

97+-- entrypoints and some modules are compiled less often than their imports.

98+--

80data Local =

99data Local =

81 Local

100 Local

82 { _path :: FilePath

101 { _path :: FilePath

83 , _time :: File.Time

102 , _time :: File.Time

84 , _deps :: [ModuleName.Raw]

103 , _deps :: [ModuleName.Raw]

85 , _main :: Bool

104 , _main :: Bool

105+ , _lastChange :: BuildID

106+ , _lastCompile :: BuildID

86 }

107 }

108

109

@@ -104,14 +125,14 @@ type Interfaces =

104

125

105

126

106loadObjects :: FilePath -> Details -> IO (MVar (Maybe Opt.GlobalGraph))

127loadObjects :: FilePath -> Details -> IO (MVar (Maybe Opt.GlobalGraph))

107−loadObjects root (Details _ _ _ _ extras) =

128+loadObjects root (Details _ _ _ _ _ extras) =

108 case extras of

129 case extras of

109 ArtifactsFresh _ o -> newMVar (Just o)

130 ArtifactsFresh _ o -> newMVar (Just o)

110 ArtifactsCached -> fork (File.readBinary (Stuff.objects root))

131 ArtifactsCached -> fork (File.readBinary (Stuff.objects root))

111

132

112

133

113loadInterfaces :: FilePath -> Details -> IO (MVar (Maybe Interfaces))

134loadInterfaces :: FilePath -> Details -> IO (MVar (Maybe Interfaces))

114−loadInterfaces root (Details _ _ _ _ extras) =

135+loadInterfaces root (Details _ _ _ _ _ extras) =

115 case extras of

136 case extras of

116 ArtifactsFresh i _ -> newMVar (Just i)

137 ArtifactsFresh i _ -> newMVar (Just i)

117 ArtifactsCached -> fork (File.readBinary (Stuff.interfaces root))

138 ArtifactsCached -> fork (File.readBinary (Stuff.interfaces root))

@@ -143,9 +164,9 @@ load style scope root =

143 Nothing ->

164 Nothing ->

144 generate style scope root newTime

165 generate style scope root newTime

145

166

146− Just details@(Details oldTime _ _ _ _) ->

167+ Just details@(Details oldTime _ buildID _ _ _) ->

147 if oldTime == newTime

168 if oldTime == newTime

148− then return (Right details)

169+ then return (Right details { _buildID = buildID + 1 })

149 else generate style scope root newTime

170 else generate style scope root newTime

150

171

151

172

@@ -310,7 +331,7 @@ verifyDependencies env@(Env key scope root cache _ _ _) time outline solution di

310 objs = Map.foldr addObjects Opt.empty artifacts

331 objs = Map.foldr addObjects Opt.empty artifacts

311 ifaces = Map.foldrWithKey (addInterfaces directDeps) Map.empty artifacts

332 ifaces = Map.foldrWithKey (addInterfaces directDeps) Map.empty artifacts

312 foreigns = Map.map (OneOrMore.destruct Foreign) $ Map.foldrWithKey gatherForeigns Map.empty $ Map.intersection artifacts directDeps

333 foreigns = Map.map (OneOrMore.destruct Foreign) $ Map.foldrWithKey gatherForeigns Map.empty $ Map.intersection artifacts directDeps

313− details = Details time outline Map.empty foreigns (ArtifactsFresh ifaces objs)

334+ details = Details time outline 0 Map.empty foreigns (ArtifactsFresh ifaces objs)

314 in

335 in

315 do BW.writeBinary scope (Stuff.objects root) objs

336 do BW.writeBinary scope (Stuff.objects root) objs

316 BW.writeBinary scope (Stuff.interfaces root) ifaces

337 BW.writeBinary scope (Stuff.interfaces root) ifaces

@@ -761,8 +782,14 @@ endpointDecoder =

761

782

762

783

763instance Binary Details where

784instance Binary Details where

785+ put (Details a b c d e _) = put a >> put b >> put c >> put d >> put e

786+ get =

787+ do a <- get

788+ b <- get

789+ c <- get

790+ d <- get

791+ e <- get

764− get = do { a <- get; b <- get; c <- get; d <- get; return (Details a b c d ArtifactsCached) }

792+ return (Details a b c d e ArtifactsCached)

765− put (Details a b c d _) = put a >> put b >> put c >> put d

766

793

767

794

768instance Binary ValidOutline where

795instance Binary ValidOutline where

@@ -780,8 +807,15 @@ instance Binary ValidOutline where

780

807

781

808

782instance Binary Local where

809instance Binary Local where

783− get = liftM4 Local get get get get

784− put (Local a b c d) = put a >> put b >> put c >> put d

810+ put (Local a b c d e f) = put a >> put b >> put c >> put d >> put e >> put f

811+ get =

812+ do a <- get

813+ b <- get

814+ c <- get

815+ d <- get

816+ e <- get

817+ f <- get

818+ return (Local a b c d e f)

785

819

786

820

787instance Binary Foreign where

821instance Binary Foreign where