@@ -2,6 +2,7 @@
22{-# LANGUAGE BangPatterns, OverloadedStrings #-}
33module Elm.Details
44 ( Details(..)
5+ , BuildID
56 , ValidOutline(..)
67 , Local(..)
78 , Foreign(..)
@@ -15,7 +16,7 @@ module Elm.Details
1516
1617import Control.Concurrent (forkIO)
1718import Control.Concurrent.MVar (MVar, newEmptyMVar, newMVar, putMVar, readMVar, takeMVar)
18−import Control.Monad (liftM, liftM2, liftM3, liftM4)
19+import Control.Monad (liftM, liftM2, liftM3)
1920import Data.Binary (Binary, get, put, getWord8, putWord8)
2021import qualified Data.Either as Either
2122import qualified Data.Map as Map
@@ -27,6 +28,7 @@ import qualified Data.NonEmptyList as NE
2728import qualified Data.OneOrMore as OneOrMore
2829import qualified Data.Set as Set
2930import qualified Data.Utf8 as Utf8
31+import Data.Word (Word64)
3032import qualified System.Directory as Dir
3133import System.FilePath ((</>), (<.>))
3234
@@ -66,23 +68,42 @@ data Details =
6668 Details
6769 { _outlineTime :: File.Time
6870 , _outline :: ValidOutline
71+ , _buildID :: BuildID
6972 , _locals :: Map.Map ModuleName.Raw Local
7073 , _foreigns :: Map.Map ModuleName.Raw Foreign
7174 , _extras :: Extras
7275 }
7376
7477
78+type BuildID = Word64
79+
80+
7581data ValidOutline
7682 = ValidApp (NE.List FilePath)
7783 | ValidPkg Pkg.Name [ModuleName.Raw] (Map.Map Pkg.Name V.Version {- for docs in reactor -})
7884
7985
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+--
8099data Local =
81100 Local
82101 { _path :: FilePath
83102 , _time :: File.Time
84103 , _deps :: [ModuleName.Raw]
85104 , _main :: Bool
105+ , _lastChange :: BuildID
106+ , _lastCompile :: BuildID
86107 }
87108
88109
@@ -104,14 +125,14 @@ type Interfaces =
104125
105126
106127loadObjects :: FilePath -> Details -> IO (MVar (Maybe Opt.GlobalGraph))
107−loadObjects root (Details _ _ _ _ extras) =
128+loadObjects root (Details _ _ _ _ _ extras) =
108129 case extras of
109130 ArtifactsFresh _ o -> newMVar (Just o)
110131 ArtifactsCached -> fork (File.readBinary (Stuff.objects root))
111132
112133
113134loadInterfaces :: FilePath -> Details -> IO (MVar (Maybe Interfaces))
114−loadInterfaces root (Details _ _ _ _ extras) =
135+loadInterfaces root (Details _ _ _ _ _ extras) =
115136 case extras of
116137 ArtifactsFresh i _ -> newMVar (Just i)
117138 ArtifactsCached -> fork (File.readBinary (Stuff.interfaces root))
@@ -143,9 +164,9 @@ load style scope root =
143164 Nothing ->
144165 generate style scope root newTime
145166
146− Just details@(Details oldTime _ _ _ _) ->
167+ Just details@(Details oldTime _ buildID _ _ _) ->
147168 if oldTime == newTime
148− then return (Right details)
169+ then return (Right details { _buildID = buildID + 1 })
149170 else generate style scope root newTime
150171
151172
@@ -310,7 +331,7 @@ verifyDependencies env@(Env key scope root cache _ _ _) time outline solution di
310331 objs = Map.foldr addObjects Opt.empty artifacts
311332 ifaces = Map.foldrWithKey (addInterfaces directDeps) Map.empty artifacts
312333 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)
314335 in
315336 do BW.writeBinary scope (Stuff.objects root) objs
316337 BW.writeBinary scope (Stuff.interfaces root) ifaces
@@ -761,8 +782,14 @@ endpointDecoder =
761782
762783
763784instance Binary Details where
764− get = do { a <- get; b <- get; c <- get; d <- get; return (Details a b c d ArtifactsCached) }
765− put (Details a b c d _) = put a >> put b >> put c >> put d
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
792+ return (Details a b c d e ArtifactsCached)
766793
767794
768795instance Binary ValidOutline where
@@ -780,8 +807,15 @@ instance Binary ValidOutline where
780807
781808
782809instance 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)
785819
786820
787821instance Binary Foreign where