Use flag cache for executables too

Author: snoyberg

src/Stack/Build/Cache.hs

@@ -149,16 +149,19 @@ writeCache dir get' content = do
              (Binary.encode content))
 
 flagCacheFile :: (MonadIO m, MonadThrow m, MonadReader env m, HasBuildConfig env)
-              => GhcPkgId
+              => Installed
               -> m (Path Abs File)
-flagCacheFile gid = do
-    rel <- parseRelFile $ ghcPkgIdString gid
+flagCacheFile installed = do
+    rel <- parseRelFile $
+        case installed of
+            Library gid -> ghcPkgIdString gid
+            Executable ident -> packageIdentifierString ident
     dir <- flagCacheLocal
     return $ dir </> rel
 
 -- | Loads the flag cache for the given installed extra-deps
 tryGetFlagCache :: (MonadIO m, MonadThrow m, MonadReader env m, HasBuildConfig env)
-                => GhcPkgId
+                => Installed
                 -> m (Maybe ConfigCache)
 tryGetFlagCache gid = do
     file <- flagCacheFile gid
@@ -168,7 +171,7 @@ tryGetFlagCache gid = do
         _ -> return Nothing
 
 writeFlagCache :: (MonadIO m, MonadReader env m, HasBuildConfig env, MonadThrow m)
-               => GhcPkgId
+               => Installed
                -> [ByteString]
                -> Set GhcPkgId
                -> m ()

src/Stack/Build/ConstructPlan.hs

@@ -270,7 +270,7 @@ addPackageDeps package = do
                 return $ Left (depname, (range, DependencyMismatch $ adrVersion adr))
             Right (ADRToInstall task) -> return $ Right
                 (Set.singleton $ taskProvides task, Set.empty)
-            Right (ADRFound _ Executable) -> return $ Right
+            Right (ADRFound _ (Executable _)) -> return $ Right
                 (Set.empty, Set.empty)
             Right (ADRFound _ (Library gid)) -> return $ Right
                 (Set.empty, Set.singleton gid)
@@ -290,32 +290,7 @@ checkDirtiness :: PackageSource
                -> Package
                -> Set GhcPkgId
                -> M Bool
-checkDirtiness _ps@(PSLocal _lp) Executable _package _present = do
-    {- FIXME proper dirtiness checking on executables
-    ctx <- ask
-    mtime <- packageSourceCabalModTime ps
-    let configOpts = configureOpts
-            (baseConfigOpts ctx)
-            present
-            (psWanted ps)
-            (piiLocation ps) -- should be Local always
-            (packageFlags package)
-        configCache = ConfigCache
-            { configCacheOpts = map encodeUtf8 configOpts
-            , configCacheDeps = present
-            , configCabalFileModTime = mtime
-            }
-    let moldOpts = lpLastConfigOpts lp
-    case moldOpts of
-        Nothing -> return True
-        Just oldOpts
-            | oldOpts /= configCache -> return True
-            | psDirty ps -> return $ Just SkipConfig
-            | otherwise -> return Nothing
-    -}
-    return False
-checkDirtiness (PSUpstream _ _ _) Executable _ _ = return False -- TODO reinstall executables in the future
-checkDirtiness ps (Library installed) package present = do
+checkDirtiness ps installed package present = do
     ctx <- ask
     let configOpts = configureOpts
             (baseConfigOpts ctx)

src/Stack/Build/Execute.hs

@@ -301,7 +301,7 @@ singleBuild ActionContext {..} ExecuteEnv {..} task@Task {..} =
             case Map.lookup ident idMap of
                 Nothing -> error "singleBuild: invariant violated, missing package ID missing"
                 Just (Library x) -> Just x
-                Just Executable -> Nothing
+                Just (Executable _) -> Nothing
         missing' = Set.fromList $ mapMaybe getMissing $ Set.toList missing
         TaskConfigOpts missing mkOpts = taskConfigOpts
         configOpts = mkOpts missing'
@@ -347,15 +347,16 @@ singleBuild ActionContext {..} ExecuteEnv {..} task@Task {..} =
     mpkgid <- findGhcPkgId eeEnvOverride pkgDbs (packageName package)
     mpkgid' <- case (packageHasLibrary package, mpkgid) of
         (False, _) -> assert (isNothing mpkgid) $ do
-            markExeInstalled (taskLocation task) taskProvides -- FIXME this should also take the options, deps, etc
-            return Executable
+            markExeInstalled (taskLocation task) taskProvides -- TODO unify somehow with writeFlagCache?
+            return $ Executable $ PackageIdentifier
+                (packageName package)
+                (packageVersion package)
         (True, Nothing) -> throwM $ Couldn'tFindPkgId $ packageName package
-        (True, Just pkgid) -> do
-            writeFlagCache
-                pkgid
-                (map encodeUtf8 configOpts)
-                allDeps
-            return $ Library pkgid
+        (True, Just pkgid) -> return $ Library pkgid
+    writeFlagCache
+        mpkgid'
+        (map encodeUtf8 configOpts)
+        allDeps
     liftIO $ atomically $ modifyTVar eeGhcPkgIds $ Map.insert taskProvides mpkgid'
   where
     announce x = $logInfo $ T.concat

src/Stack/Build/Installed.hs

@@ -41,13 +41,11 @@ type M env m = (MonadIO m,MonadReader env m,HasHttpManager env,HasBuildConfig en
 data LoadHelper = LoadHelper
     { lhId   :: !GhcPkgId
     , lhDeps :: ![GhcPkgId]
-    , lhPair :: !(PackageName, (Version, Location, Installed))
+    , lhPair :: !(PackageName, (Version, Location, Installed)) -- TODO Version is now redundant and can be gleaned from Installed
     }
     deriving Show
 
-type InstalledMap = Map PackageName (Version, Location, Installed)
-data Installed = Library GhcPkgId | Executable
-    deriving (Show, Eq, Ord)
+type InstalledMap = Map PackageName (Version, Location, Installed) -- TODO Version is now redundant and can be gleaned from Installed
 
 -- | Returns the new InstalledMap and all of the locally registered packages.
 getInstalled :: (M env m, PackageInstallInfo pii)
@@ -103,7 +101,7 @@ getInstalled menv profiling sourceMap = do
                         -- Passed all the tests, mark this as installed!
                         _ -> m
           where
-            m = Map.singleton name (version, loc, Executable)
+            m = Map.singleton name (version, loc, Executable $ PackageIdentifier name version)
     exesSnap <- getInstalledExes Snap
     exesLocal <- getInstalledExes Local
     let installedMap = Map.unions

src/Stack/Build/Types.hs

@@ -447,3 +447,6 @@ modTime x =
               (utctDay x)
         , toRational
               (utctDayTime x))
+
+data Installed = Library GhcPkgId | Executable PackageIdentifier
+    deriving (Show, Eq, Ord)