Merge pull request #64 from phadej/env-data-dir

Set environment with data-directories
phadej · Jan 10, 2021 · 687ed1b · 687ed1b
2 parents c76f4fb + a923e71
commit 687ed1b
Show file tree

Hide file tree

Showing 6 changed files with 42 additions and 16 deletions.
diff --git a/cabal-docspec/Makefile b/cabal-docspec/Makefile
@@ -1,7 +1,7 @@
-VERSION=0.0.0.20210109
+VERSION=0.0.0.20210110
 
 cabal-docspec.1 : MANUAL.md
-	echo '.TH CABAL-DOCSPEC 1 "January 9, 2021" "cabal-docspec $(VERSION)" "Cabal Extras"' > cabal-docspec.1
+	echo '.TH CABAL-DOCSPEC 1 "January 10, 2021" "cabal-docspec $(VERSION)" "Cabal Extras"' > cabal-docspec.1
 	pandoc -f markdown -t man MANUAL.md >> cabal-docspec.1
 
 man : cabal-docspec.1

diff --git a/cabal-docspec/cabal-docspec.1 b/cabal-docspec/cabal-docspec.1
@@ -1,4 +1,4 @@
-.TH CABAL-DOCSPEC 1 "January 9, 2021" "cabal-docspec 0.0.0.20210109" "Cabal Extras"
+.TH CABAL-DOCSPEC 1 "January 10, 2021" "cabal-docspec 0.0.0.20210110" "Cabal Extras"
 .SH NAME
 .PP
 cabal-docspec - another doctest for Haskell

diff --git a/cabal-docspec/cabal-docspec.cabal b/cabal-docspec/cabal-docspec.cabal
@@ -1,6 +1,6 @@
 cabal-version:      2.2
 name:               cabal-docspec
-version:            0.0.0.20210109
+version:            0.0.0.20210110
 synopsis:           Run examples in your docs
 category:           Development
 description:

diff --git a/cabal-docspec/src/CabalDocspec/GHCi.hs b/cabal-docspec/src/CabalDocspec/GHCi.hs
@@ -33,10 +33,11 @@ withInteractiveGhc
     :: TracerPeu r Tr
     -> GhcInfo
     -> Path Absolute
+    -> [(String,String)]
     -> [String]
     -> (GHCi -> Peu r a)
     -> Peu r a
-withInteractiveGhc tracer ghcInfo cwd args kont = do
+withInteractiveGhc tracer ghcInfo cwd env args kont = do
     traceApp tracer $ TraceGHCi (ghcPath ghcInfo) args'
 
     Proci.withInteractiveProcess pc1 $ \iph -> do
@@ -54,6 +55,7 @@ withInteractiveGhc tracer ghcInfo cwd args kont = do
     pc0 = Proc.proc (ghcPath ghcInfo) args'
     pc1 = pc0
         { Proc.cwd = Just (toFilePath cwd)
+        , Proc.env = Just env
         }
 
     args' = ["--interactive", "-ignore-dot-ghci", "-v0"] ++ args

diff --git a/cabal-docspec/src/CabalDocspec/Main.hs b/cabal-docspec/src/CabalDocspec/Main.hs
@@ -22,12 +22,13 @@ import qualified Distribution.Types.BuildInfo                 as C
 import qualified Distribution.Types.CondTree                  as C
 import qualified Distribution.Types.ConfVar                   as C
 import qualified Distribution.Types.Flag                      as C
-import qualified Language.Haskell.Extension as Ext
 import qualified Distribution.Types.GenericPackageDescription as C
 import qualified Distribution.Types.InstalledPackageInfo      as IPI
 import qualified Distribution.Types.Library                   as C
 import qualified Distribution.Types.LibraryName               as C
+import qualified Distribution.Types.PackageDescription        as C
 import qualified Distribution.Version                         as C
+import qualified Language.Haskell.Extension                   as Ext
 import qualified Options.Applicative                          as O
 import qualified System.FilePath                              as FP
 
@@ -99,12 +100,22 @@ main = do
                             []  -> die tracer $ "No package " ++ target ++ " in the plan"
                             _   -> return match
 
+                -- collect environment of datadirs
+                let env :: [(String, String)]
+                    env =
+                        [ (manglePackageName pn ++ "_datadir", toFilePath $ pkgDir pkg </> fromUnrootedFilePath (C.dataDir pd))
+                        | pkg <- pkgs0
+                        , let pd = C.packageDescription (pkgGpd pkg)
+                        , let pn = C.packageName pd
+                        , not (null (C.dataFiles pd))
+                        ]
+
                 -- process components
                 res <- for pkgs $ \pkg -> do
                     for (pkgUnits pkg) $ \unit ->
                         ifor (Plan.uComps unit) $ \cn ci -> do
                             testComponent tracer0 tracer (optGhci opts)
-                                ghcInfo builddir cabalCfg plan pkg unit cn ci
+                                ghcInfo builddir cabalCfg plan env pkg unit cn ci
 
                 -- summarize Summary's
                 return $ foldMap (foldMap (foldMap id)) res
@@ -196,12 +207,13 @@ testComponent
     -> Path Absolute -- ^ builddir
     -> Cabal.Config Identity
     -> Plan.PlanJson
+    -> [(String, String)]
     -> Package
     -> Plan.Unit
     -> Plan.CompName
     -> Plan.CompInfo
     -> Peu r Summary
-testComponent tracer0 tracerTop dynOptsCli ghcInfo buildDir cabalCfg plan pkg unit cn@Plan.CompNameLib ci = do
+testComponent tracer0 tracerTop dynOptsCli ghcInfo buildDir cabalCfg plan env pkg unit cn@Plan.CompNameLib ci = do
     traceApp tracerTop $ TraceComponent (C.packageId (pkgGpd pkg)) cn
 
     -- "configure"
@@ -251,12 +263,12 @@ testComponent tracer0 tracerTop dynOptsCli ghcInfo buildDir cabalCfg plan pkg un
 
     if optPhase dynOpts > Phase1
     then do
-        phase2 tracer dynOpts unitIds ghcInfo (Just buildDir) cabalCfg (pkgDir pkg) parsed
+        phase2 tracer dynOpts unitIds ghcInfo (Just buildDir) cabalCfg (pkgDir pkg) env parsed
     else
         return $ foldMap skipModule parsed
 
 -- Skip other components
-testComponent _tracer0 _tracerTop _dynOpts _ghcInfo _builddir _cabalCfg _plan _pkg _unit _cn _ci =
+testComponent _tracer0 _tracerTop _dynOpts _ghcInfo _builddir _cabalCfg _plan _env _pkg _unit _cn _ci =
     return mempty
 
 -------------------------------------------------------------------------------
@@ -340,8 +352,9 @@ testComponentNo tracer0 tracerTop dynOptsCli ghcInfo cabalCfg dbG pkg = do
 
     if optPhase dynOpts > Phase1
     then do
-        -- tmpDir <- getTemporaryDirectory -- TODO: make this configurable
-        phase2 tracer dynOpts unitIds ghcInfo Nothing cabalCfg (pkgDir pkg) parsed
+        -- Note: we don't pass additional environment
+        -- For non-cabal-plan setup we simply don't support data-files.
+        phase2 tracer dynOpts unitIds ghcInfo Nothing cabalCfg (pkgDir pkg) [] parsed
     else
         return $ foldMap skipModule parsed
 
@@ -373,6 +386,12 @@ findExtraPackages tracer plan = traverse $ \pn -> do
 -- Utilities
 -------------------------------------------------------------------------------
 
+manglePackageName :: C.PackageName -> String
+manglePackageName = map fixchar . prettyShow where
+    fixchar :: Char -> Char
+    fixchar '-' = '_'
+    fixchar c   = c
+
 -- | Return name per module.
 findModules
     :: TracerPeu r Tr

diff --git a/cabal-docspec/src/CabalDocspec/Phase2.hs b/cabal-docspec/src/CabalDocspec/Phase2.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE BangPatterns        #-}
 {-# LANGUAGE RecordWildCards     #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 module CabalDocspec.Phase2 (
@@ -7,9 +6,11 @@ module CabalDocspec.Phase2 (
 
 import Peura
 
-import Control.Monad (foldM)
+import Control.Monad      (foldM)
+import System.Environment (getEnvironment)
 
 import qualified Cabal.Config           as Cabal
+import qualified Data.Map               as Map
 import qualified Language.Haskell.Lexer as L
 
 import CabalDocspec.Doctest.Example
@@ -30,9 +31,10 @@ phase2
     -> Maybe (Path Absolute) -- ^ Build directory, @builddir@
     -> Cabal.Config Identity
     -> Path Absolute
+    -> [(String,String)]
     -> [Module [Located DocTest]]
     -> Peu r Summary
-phase2 tracer dynOpts unitIds ghcInfo mbuildDir cabalCfg cwd parsed = do
+phase2 tracer dynOpts unitIds ghcInfo mbuildDir cabalCfg cwd extraEnv parsed = do
     let preserveIt = case optPreserveIt dynOpts of
             PreserveIt     -> True
             DontPreserveIt -> False
@@ -73,7 +75,10 @@ phase2 tracer dynOpts unitIds ghcInfo mbuildDir cabalCfg cwd parsed = do
             | u <- map prettyShow unitIds
             ]
 
-    withInteractiveGhc tracer ghcInfo cwd ghciArgs $ \ghci -> do
+    currEnv <- liftIO getEnvironment
+    let env = Map.toList $ Map.fromList $ extraEnv ++ currEnv
+
+    withInteractiveGhc tracer ghcInfo cwd env ghciArgs $ \ghci -> do
         fmap mconcat $ for parsed $ \m -> do
             traceApp tracer $ TracePhase2 (moduleName m)