Move store-related TH into its own module #4272

Author: snoyberg

package.yaml

@@ -231,6 +231,7 @@ library:
   - Stack.Sig.Sign
   - Stack.Snapshot
   - Stack.Solver
+  - Stack.StoreTH
   - Stack.Types.Build
   - Stack.Types.BuildPlan
   - Stack.Types.CompilerBuild

src/Stack/Build/Cache.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE DeriveGeneric         #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TemplateHaskell       #-}
 {-# LANGUAGE TupleSections         #-}
 {-# LANGUAGE ConstraintKinds       #-}
 {-# LANGUAGE OverloadedStrings     #-}
@@ -42,18 +41,17 @@ import           Data.Char (ord)
 import qualified Data.Map as M
 import qualified Data.Set as Set
 import qualified Data.Store as Store
-import           Data.Store.VersionTagged
 import qualified Data.Text as T
 import           Path
 import           Path.IO
 import           Stack.Constants
 import           Stack.Constants.Config
+import           Stack.StoreTH
 import           Stack.Types.Build
 import           Stack.Types.Compiler
 import           Stack.Types.Config
 import           Stack.Types.GhcPkgId
 import           Stack.Types.NamedComponent
-import           Stack.Types.Package
 import qualified System.FilePath as FP
 
 -- | Directory containing files to mark an executable as installed
@@ -124,17 +122,17 @@ tryGetBuildCache :: HasEnvConfig env
                  => Path Abs Dir
                  -> NamedComponent
                  -> RIO env (Maybe (Map FilePath FileCacheInfo))
-tryGetBuildCache dir component = liftM (fmap buildCacheTimes) . $(versionedDecodeFile buildCacheVC) =<< buildCacheFile dir component
+tryGetBuildCache dir component = liftM (fmap buildCacheTimes) . decodeBuildCache =<< buildCacheFile dir component
 
 -- | Try to read the dirtiness cache for the given package directory.
 tryGetConfigCache :: HasEnvConfig env
                   => Path Abs Dir -> RIO env (Maybe ConfigCache)
-tryGetConfigCache dir = $(versionedDecodeFile configCacheVC) =<< configCacheFile dir
+tryGetConfigCache dir = decodeConfigCache =<< configCacheFile dir
 
 -- | Try to read the mod time of the cabal file from the last build
 tryGetCabalMod :: HasEnvConfig env
                => Path Abs Dir -> RIO env (Maybe ModTime)
-tryGetCabalMod dir = $(versionedDecodeFile modTimeVC) =<< configCabalMod dir
+tryGetCabalMod dir = decodeModTime =<< configCabalMod dir
 
 -- | Write the dirtiness cache for this package's files.
 writeBuildCache :: HasEnvConfig env
@@ -143,7 +141,7 @@ writeBuildCache :: HasEnvConfig env
                 -> Map FilePath FileCacheInfo -> RIO env ()
 writeBuildCache dir component times = do
     fp <- buildCacheFile dir component
-    $(versionedEncodeFile buildCacheVC) fp BuildCache
+    encodeBuildCache fp BuildCache
         { buildCacheTimes = times
         }
 
@@ -154,7 +152,7 @@ writeConfigCache :: HasEnvConfig env
                 -> RIO env ()
 writeConfigCache dir x = do
     fp <- configCacheFile dir
-    $(versionedEncodeFile configCacheVC) fp x
+    encodeConfigCache fp x
 
 -- | See 'tryGetCabalMod'
 writeCabalMod :: HasEnvConfig env
@@ -163,7 +161,7 @@ writeCabalMod :: HasEnvConfig env
               -> RIO env ()
 writeCabalMod dir x = do
     fp <- configCabalMod dir
-    $(versionedEncodeFile modTimeVC) fp x
+    encodeModTime fp x
 
 -- | Delete the caches for the project.
 deleteCaches :: (MonadIO m, MonadReader env m, HasEnvConfig env, MonadThrow m)
@@ -193,7 +191,7 @@ tryGetFlagCache :: HasEnvConfig env
                 -> RIO env (Maybe ConfigCache)
 tryGetFlagCache gid = do
     fp <- flagCacheFile gid
-    $(versionedDecodeFile configCacheVC) fp
+    decodeConfigCache fp
 
 writeFlagCache :: HasEnvConfig env
                => Installed
@@ -202,23 +200,23 @@ writeFlagCache :: HasEnvConfig env
 writeFlagCache gid cache = do
     file <- flagCacheFile gid
     ensureDir (parent file)
-    $(versionedEncodeFile configCacheVC) file cache
+    encodeConfigCache file cache
 
 -- | Mark a test suite as having succeeded
 setTestSuccess :: HasEnvConfig env
                => Path Abs Dir
                -> RIO env ()
 setTestSuccess dir = do
     fp <- testSuccessFile dir
-    $(versionedEncodeFile testSuccessVC) fp True
+    encodeTestSuccess fp True
 
 -- | Mark a test suite as not having succeeded
 unsetTestSuccess :: HasEnvConfig env
                  => Path Abs Dir
                  -> RIO env ()
 unsetTestSuccess dir = do
     fp <- testSuccessFile dir
-    $(versionedEncodeFile testSuccessVC) fp False
+    encodeTestSuccess fp False
 
 -- | Check if the test suite already passed
 checkTestSuccess :: HasEnvConfig env
@@ -227,7 +225,7 @@ checkTestSuccess :: HasEnvConfig env
 checkTestSuccess dir =
     liftM
         (fromMaybe False)
-        ($(versionedDecodeFile testSuccessVC) =<< testSuccessFile dir)
+        (decodeTestSuccess =<< testSuccessFile dir)
 
 --------------------------------------
 -- Precompiled Cache
@@ -315,7 +313,7 @@ writePrecompiledCache baseConfigOpts loc copts depIDs mghcPkgId sublibs exes = d
       name <- parseRelFile $ T.unpack exe
       relPath <- stackRootRelative $ bcoSnapInstallRoot baseConfigOpts </> bindirSuffix </> name
       return $ toFilePath relPath
-  $(versionedEncodeFile precompiledCacheVC) file PrecompiledCache
+  encodePrecompiledCache file PrecompiledCache
       { pcLibrary = mlibpath
       , pcSubLibs = sublibpaths
       , pcExes = exes'
@@ -335,7 +333,7 @@ readPrecompiledCache :: forall env. HasEnvConfig env
                      -> RIO env (Maybe PrecompiledCache)
 readPrecompiledCache loc copts depIDs = do
     file <- precompiledCacheFile loc copts depIDs
-    mcache <- $(versionedDecodeFile precompiledCacheVC) file
+    mcache <- decodePrecompiledCache file
     maybe (pure Nothing) (fmap Just . mkAbs) mcache
   where
     -- Since commit ed9ccc08f327bad68dd2d09a1851ce0d055c0422,

src/Stack/Constants.hs

@@ -118,7 +118,7 @@ module Stack.Constants
     ,relFileStackDotExe
     ,relFileStackDotTmpDotExe
     ,relFileStackDotTmp
-    ,defaultTemplateName
+    ,ghcShowOptionsOutput
     )
     where
 
@@ -127,11 +127,12 @@ import           Data.FileEmbed (embedFile, makeRelativeToProject)
 import qualified Data.Set as Set
 import           Distribution.Package (mkPackageName)
 import qualified Hpack.Config as Hpack
+import qualified Language.Haskell.TH.Syntax as TH (runIO, lift)
 import           Path as FL
 import           Stack.Prelude
 import           Stack.Types.Compiler
-import           Stack.Types.TemplateName
 import           System.Permissions (osIsWindows)
+import           System.Process (readProcess)
 
 -- | Extensions used for Haskell modules. Excludes preprocessor ones.
 haskellFileExts :: [Text]
@@ -584,6 +585,8 @@ relFileStackDotTmp = $(mkRelFile "stack.tmp")
 relFileStack :: Path Rel File
 relFileStack = $(mkRelFile "stack")
 
--- | The default template name you can use if you don't have one.
-defaultTemplateName :: TemplateName
-defaultTemplateName = $(mkTemplateName "new-template")
+-- Technically, we should be consulting the user's current ghc,
+-- but that would require loading up a BuildConfig.
+ghcShowOptionsOutput :: [String]
+ghcShowOptionsOutput =
+  $(TH.runIO (readProcess "ghc" ["--show-options"] "") >>= TH.lift . lines)

src/Stack/Options/Completion.hs

@@ -1,6 +1,5 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TupleSections #-}
 
 module Stack.Options.Completion
@@ -21,14 +20,13 @@ import qualified Distribution.Types.UnqualComponentName as C
 import           Options.Applicative
 import           Options.Applicative.Builder.Extra
 import           Stack.Config (getLocalPackages)
+import           Stack.Constants (ghcShowOptionsOutput)
 import           Stack.Options.GlobalParser (globalOptsFromMonoid)
 import           Stack.Runners (loadConfigWithOpts)
-import           Stack.Prelude hiding (lift)
+import           Stack.Prelude
 import           Stack.Setup
 import           Stack.Types.Config
 import           Stack.Types.NamedComponent
-import           System.Process (readProcess)
-import           Language.Haskell.TH.Syntax (runIO, lift)
 
 ghcOptsCompleter :: Completer
 ghcOptsCompleter = mkCompleter $ \inputRaw -> return $
@@ -38,10 +36,7 @@ ghcOptsCompleter = mkCompleter $ \inputRaw -> return $
         otherArgs = reverse otherArgsReversed
      in if null curArg then [] else
          map (otherArgs ++) $
-         filter (curArg `isPrefixOf`)
-                -- Technically, we should be consulting the user's current ghc,
-                -- but that would require loading up a BuildConfig.
-                $(runIO (readProcess "ghc" ["--show-options"] "") >>= lift . lines)
+         filter (curArg `isPrefixOf`) ghcShowOptionsOutput
 
 -- TODO: Ideally this would pay attention to --stack-yaml, may require
 -- changes to optparse-applicative.

src/Stack/PackageDump.hs

@@ -6,7 +6,6 @@
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
 module Stack.PackageDump
     ( Line
     , eachSection
@@ -34,14 +33,14 @@ import qualified Data.Conduit.Text as CT
 import           Data.List (isPrefixOf)
 import qualified Data.Map as Map
 import qualified Data.Set as Set
-import           Data.Store.VersionTagged
 import qualified RIO.Text as T
 import qualified Distribution.License as C
 import           Distribution.ModuleName (ModuleName)
 import qualified Distribution.System as OS
 import qualified Distribution.Text as C
 import           Path.Extra (toFilePathNoTrailingSep)
 import           Stack.GhcPkg
+import           Stack.StoreTH
 import           Stack.Types.Compiler
 import           Stack.Types.GhcPkgId
 import           Stack.Types.PackageDump
@@ -100,13 +99,13 @@ newInstalledCache = liftIO $ InstalledCache <$> newIORef (InstalledCacheInner Ma
 -- empty cache.
 loadInstalledCache :: HasLogFunc env => Path Abs File -> RIO env InstalledCache
 loadInstalledCache path = do
-    m <- $(versionedDecodeOrLoad installedCacheVC) path (return $ InstalledCacheInner Map.empty)
+    m <- decodeOrLoadInstalledCache path (return $ InstalledCacheInner Map.empty)
     liftIO $ InstalledCache <$> newIORef m
 
 -- | Save a @InstalledCache@ to disk
 saveInstalledCache :: HasLogFunc env => Path Abs File -> InstalledCache -> RIO env ()
 saveInstalledCache path (InstalledCache ref) =
-    liftIO (readIORef ref) >>= $(versionedEncodeFile installedCacheVC) path
+    readIORef ref >>= encodeInstalledCache path
 
 -- | Prune a list of possible packages down to those whose dependencies are met.
 --

src/Stack/Snapshot.hs

@@ -9,7 +9,6 @@
 {-# LANGUAGE OverloadedStrings   #-}
 {-# LANGUAGE RecordWildCards     #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TemplateHaskell     #-}
 {-# LANGUAGE TupleSections       #-}
 {-# LANGUAGE ViewPatterns        #-}
 
@@ -24,7 +23,6 @@ module Stack.Snapshot
 
 import           Stack.Prelude hiding (Display (..))
 import           Control.Monad.State.Strict      (get, put, StateT, execStateT)
-import           Data.Store.VersionTagged
 import qualified Data.Conduit.List as CL
 import qualified Data.Map as Map
 import qualified Data.Set as Set
@@ -44,6 +42,7 @@ import qualified Pantry
 import qualified Pantry.SHA256 as SHA256
 import           Stack.Package
 import           Stack.PackageDump
+import           Stack.StoreTH
 import           Stack.Types.BuildPlan
 import           Stack.Types.GhcPkgId
 import           Stack.Types.VersionIntervals
@@ -174,7 +173,7 @@ loadSnapshot mcompiler =
       path <- configLoadedSnapshotCache
         sd
         (maybe GISSnapshotHints GISCompiler mcompiler)
-      $(versionedDecodeOrLoad loadedSnapshotVC) path (inner sd)
+      decodeOrLoadLoadedSnapshot path (inner sd)
 
     inner :: SnapshotDef -> RIO env LoadedSnapshot
     inner sd = do