cabal-doctest: Cache doctest executables

Author: sol

doctest.cabal

@@ -65,7 +65,6 @@ library:
     ghc-paths: ">= 0.1.0.9"
     Cabal:
     transformers:
-    temporary:
 
 flags:
   cabal-doctest:

package.yaml

@@ -3,10 +3,11 @@ module Cabal (externalCommand) where
 
 import           Imports
 
+import           System.IO
 import           System.Environment
 import           System.Exit (exitWith)
+import           System.Directory
 import           System.FilePath
-import           System.IO.Temp (withSystemTempDirectory)
 import           System.Process
 
 import qualified Info
@@ -19,30 +20,46 @@ externalCommand args = do
     Just cabal -> run cabal (drop 1 args)
 
 run :: String -> [String] -> IO ()
-run cabal args = withSystemTempDirectory "doctest" $ \ dir -> do
-  let
-    doctest = dir </> "doctest"
-    script = dir </> "init-ghci"
+run cabal args = do
 
   Paths{..} <- paths cabal
 
-  callProcess cabal [
-      "install" , "doctest-" <> Info.version
-    , "--flag", "-cabal-doctest"
-    , "--ignore-project"
-    , "--installdir", dir
-    , "--install-method=symlink"
-    , "--with-compiler", ghc
-    , "--with-hc-pkg", ghcPkg
-    ]
-
-  callProcess (dir </> "doctest") ["--version"]
+  let
+    doctest = cache </> "doctest" <> "-" <> Info.version
+    script = cache </> "init-ghci-" <> Info.version
+
+  doesFileExist doctest >>= \ case
+    True -> pass
+    False -> callProcess cabal [
+        "install" , "doctest-" <> Info.version
+      , "--flag", "-cabal-doctest"
+      , "--ignore-project"
+      , "--installdir", cache
+      , "--program-suffix", "-" <> Info.version
+      , "--install-method=copy"
+      , "--with-compiler", ghc
+      , "--with-hc-pkg", ghcPkg
+      ]
+
+  doesFileExist script >>= \ case
+    True -> pass
+    False -> writeFileAtomically script ":seti -w -Wdefault"
+
+  callProcess doctest ["--version"]
+
   callProcess cabal ("build" : "--only-dependencies" : args)
-  writeFile script ":seti -w -Wdefault"
+
   spawnProcess cabal ("repl"
     : "--build-depends=QuickCheck"
     : "--build-depends=template-haskell"
     : ("--repl-options=-ghci-script=" <> script)
     : "--with-compiler" : doctest
     : "--with-hc-pkg" : ghcPkg
     : args) >>= waitForProcess >>= exitWith
+
+writeFileAtomically :: FilePath -> String -> IO ()
+writeFileAtomically name contents = do
+  (tmp, h) <- openTempFile (takeDirectory name) (takeFileName name)
+  hPutStr h contents
+  hClose h
+  renameFile tmp name

src/Cabal.hs

@@ -12,6 +12,7 @@ import           Data.Version hiding (parseVersion)
 import qualified Data.Version as Version
 import           System.Exit hiding (die)
 import           System.Directory
+import           System.FilePath
 import           System.IO
 import           System.Process
 import           Text.ParserCombinators.ReadP
@@ -20,10 +21,12 @@ import qualified Distribution.Simple.GHC as GHC
 import           Distribution.Verbosity
 import           Distribution.Simple.Program.Db
 import           Distribution.Simple.Program.Types
+import           Distribution.Simple.Compiler
 
 data Paths = Paths {
   ghc  :: FilePath
 , ghcPkg :: FilePath
+, cache :: FilePath
 } deriving (Eq, Show)
 
 paths :: FilePath -> IO Paths
@@ -40,22 +43,31 @@ paths cabal = do
   values <- parseFields <$> readProcess cabal ["path", "-v0"] ""
 
   let
-    compiler_path :: String
-    compiler_path = "compiler-path"
+    getPath :: String -> String -> IO FilePath
+    getPath subject key = case lookup key values of
+      Nothing -> die $ "Cannot determine the path to " <> subject <> ". Running 'cabal path' did not return a value for '" <> key <> "'."
+      Just path -> canonicalizePath path
 
-  ghc <- case lookup compiler_path values of
-    Nothing -> die $ "Cannot determine the path to 'ghc'. Running 'cabal path' did not return a value for '" <> compiler_path <> "'."
-    Just path -> canonicalizePath path
+  ghc <- getPath "'ghc'" "compiler-path"
+
+  (compiler, _, programs) <- GHC.configure silent (Just ghc) Nothing emptyProgramDb
 
-  (_, _, programs) <- GHC.configure silent (Just ghc) Nothing emptyProgramDb
 
   ghcPkg <- case programPath <$> List.find (programId >>> (== "ghc-pkg")) (configuredPrograms programs) of
     Nothing -> die $ "Cannot determine the path to 'ghc-pkg' from '" <> ghc <> "'."
     Just path -> return path
 
+  abi <- strip <$> readProcess ghcPkg ["--no-user-package-db", "field", "base", "abi", "--simple-output"] ""
+
+  cache_home <- getPath "Cabal's cache directory" "cache-home"
+  let cache = cache_home </> "doctest" </> showCompilerId compiler <> "-" <> abi
+
+  createDirectoryIfMissing True cache
+
   return Paths {
     ghc
   , ghcPkg
+  , cache
   }
   where
     parseFields :: String -> [(String, FilePath)]

src/Cabal/Paths.hs

@@ -16,3 +16,6 @@ spec = do
 
     it "returns the path to 'ghc-pkg'" $ do
       (paths "cabal" >>= doesFileExist . ghcPkg) `shouldReturn` True
+
+    it "returns the path to Cabal's cache directory" $ do
+      (paths "cabal" >>= doesDirectoryExist . cache) `shouldReturn` True