Skip to content

Commit 975f584

Browse files
mpilgremmpilgrem
authored
Merge pull request #5967 from commercialhaskell/export-lists
Add export lists
2 parents 5ce326a + ec4a473 commit 975f584

File tree

15 files changed

+906
-754
lines changed

15 files changed

+906
-754
lines changed

‎src/Data/Monoid/Map.hs‎

Lines changed: 7 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,19 +1,21 @@
11
{-# LANGUAGE DeriveGeneric #-}
22
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
33

4-
module Data.Monoid.Map where
4+
module Data.Monoid.Map
5+
( MonoidMap (..)
6+
) where
57

68
import qualified Data.Map as M
79
import Stack.Prelude
810

911
-- | Utility newtype wrapper to make Map's Monoid also use the
1012
-- element's Monoid.
1113
newtype MonoidMap k a = MonoidMap (Map k a)
12-
deriving (Eq, Ord, Read, Show, Generic, Functor)
14+
deriving (Eq, Functor, Generic, Ord, Read, Show)
1315

1416
instance (Ord k, Semigroup a) => Semigroup (MonoidMap k a) where
15-
MonoidMap mp1 <> MonoidMap mp2 = MonoidMap (M.unionWith (<>) mp1 mp2)
17+
MonoidMap mp1 <> MonoidMap mp2 = MonoidMap (M.unionWith (<>) mp1 mp2)
1618

1719
instance (Ord k, Semigroup a) => Monoid (MonoidMap k a) where
18-
mappend = (<>)
19-
mempty = MonoidMap mempty
20+
mappend = (<>)
21+
mempty = MonoidMap mempty

‎src/Path/CheckInstall.hs‎

Lines changed: 35 additions & 33 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,9 @@
22
{-# LANGUAGE FlexibleContexts #-}
33
{-# LANGUAGE OverloadedStrings #-}
44

5-
module Path.CheckInstall where
5+
module Path.CheckInstall
6+
( warnInstallSearchPathIssues
7+
) where
68

79
import Control.Monad.Extra ( anyM, (&&^) )
810
import qualified Data.Text as T
@@ -16,37 +18,37 @@ import qualified System.FilePath as FP
1618
-- only visible when running in the Stack environment.
1719
warnInstallSearchPathIssues :: HasConfig env => FilePath -> [Text] -> RIO env ()
1820
warnInstallSearchPathIssues destDir installed = do
19-
searchPath <- liftIO FP.getSearchPath
20-
destDirIsInPATH <- liftIO $
21-
anyM (\dir -> D.doesDirectoryExist dir &&^ fmap (FP.equalFilePath destDir) (D.canonicalizePath dir)) searchPath
22-
if destDirIsInPATH
23-
then forM_ installed $ \exe -> do
24-
mexePath <- (liftIO . D.findExecutable . T.unpack) exe
25-
case mexePath of
26-
Just exePath -> do
27-
exeDir <- (liftIO . fmap FP.takeDirectory . D.canonicalizePath) exePath
28-
unless (exeDir `FP.equalFilePath` destDir) $ do
29-
prettyWarnL
30-
[ flow "The"
31-
, style File . fromString . T.unpack $ exe
32-
, flow "executable found on the PATH environment variable is"
33-
, style File . fromString $ exePath
34-
, flow "and not the version that was just installed."
35-
, flow "This means that"
36-
, style File . fromString . T.unpack $ exe
37-
, "calls on the command line will not use this version."
38-
]
39-
Nothing -> do
40-
prettyWarnL
41-
[ flow "Installation path"
42-
, style Dir . fromString $ destDir
43-
, flow "is on the PATH but the"
44-
, style File . fromString . T.unpack $ exe
45-
, flow "executable that was just installed could not be found on the PATH."
46-
]
47-
else do
21+
searchPath <- liftIO FP.getSearchPath
22+
destDirIsInPATH <- liftIO $
23+
anyM (\dir -> D.doesDirectoryExist dir &&^ fmap (FP.equalFilePath destDir) (D.canonicalizePath dir)) searchPath
24+
if destDirIsInPATH
25+
then forM_ installed $ \exe -> do
26+
mexePath <- (liftIO . D.findExecutable . T.unpack) exe
27+
case mexePath of
28+
Just exePath -> do
29+
exeDir <- (liftIO . fmap FP.takeDirectory . D.canonicalizePath) exePath
30+
unless (exeDir `FP.equalFilePath` destDir) $ do
4831
prettyWarnL
49-
[ flow "Installation path "
50-
, style Dir . fromString $ destDir
51-
, "not found on the PATH environment variable."
32+
[ flow "The"
33+
, style File . fromString . T.unpack $ exe
34+
, flow "executable found on the PATH environment variable is"
35+
, style File . fromString $ exePath
36+
, flow "and not the version that was just installed."
37+
, flow "This means that"
38+
, style File . fromString . T.unpack $ exe
39+
, "calls on the command line will not use this version."
5240
]
41+
Nothing -> do
42+
prettyWarnL
43+
[ flow "Installation path"
44+
, style Dir . fromString $ destDir
45+
, flow "is on the PATH but the"
46+
, style File . fromString . T.unpack $ exe
47+
, flow "executable that was just installed could not be found on the PATH."
48+
]
49+
else do
50+
prettyWarnL
51+
[ flow "Installation path "
52+
, style Dir . fromString $ destDir
53+
, "not found on the PATH environment variable."
54+
]

‎src/Stack/Config/Build.hs‎

Lines changed: 82 additions & 75 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,12 @@
22
{-# LANGUAGE RecordWildCards #-}
33

44
-- | Build configuration
5-
module Stack.Config.Build where
5+
module Stack.Config.Build
6+
( benchmarkOptsFromMonoid
7+
, buildOptsFromMonoid
8+
, haddockOptsFromMonoid
9+
, testOptsFromMonoid
10+
) where
611

712
import Distribution.Verbosity ( normal )
813
import Stack.Prelude
@@ -11,86 +16,88 @@ import Stack.Types.Config
1116
-- | Interprets BuildOptsMonoid options.
1217
buildOptsFromMonoid :: BuildOptsMonoid -> BuildOpts
1318
buildOptsFromMonoid BuildOptsMonoid{..} = BuildOpts
14-
{ boptsLibProfile = fromFirstFalse
15-
(buildMonoidLibProfile <>
16-
FirstFalse (if tracing || profiling then Just True else Nothing))
17-
, boptsExeProfile = fromFirstFalse
18-
(buildMonoidExeProfile <>
19-
FirstFalse (if tracing || profiling then Just True else Nothing))
20-
, boptsLibStrip = fromFirstTrue
21-
(buildMonoidLibStrip <>
22-
FirstTrue (if noStripping then Just False else Nothing))
23-
, boptsExeStrip = fromFirstTrue
24-
(buildMonoidExeStrip <>
25-
FirstTrue (if noStripping then Just False else Nothing))
26-
, boptsHaddock = fromFirstFalse buildMonoidHaddock
27-
, boptsHaddockOpts = haddockOptsFromMonoid buildMonoidHaddockOpts
28-
, boptsOpenHaddocks = fromFirstFalse buildMonoidOpenHaddocks
29-
, boptsHaddockDeps = getFirst buildMonoidHaddockDeps
30-
, boptsHaddockInternal = fromFirstFalse buildMonoidHaddockInternal
31-
, boptsHaddockHyperlinkSource = fromFirstTrue buildMonoidHaddockHyperlinkSource
32-
, boptsInstallExes = fromFirstFalse buildMonoidInstallExes
33-
, boptsInstallCompilerTool = fromFirstFalse buildMonoidInstallCompilerTool
34-
, boptsPreFetch = fromFirstFalse buildMonoidPreFetch
35-
, boptsKeepGoing = getFirst buildMonoidKeepGoing
36-
, boptsKeepTmpFiles = fromFirstFalse buildMonoidKeepTmpFiles
37-
, boptsForceDirty = fromFirstFalse buildMonoidForceDirty
38-
, boptsTests = fromFirstFalse buildMonoidTests
39-
, boptsTestOpts =
40-
testOptsFromMonoid buildMonoidTestOpts additionalArgs
41-
, boptsBenchmarks = fromFirstFalse buildMonoidBenchmarks
42-
, boptsBenchmarkOpts =
43-
benchmarkOptsFromMonoid buildMonoidBenchmarkOpts additionalArgs
44-
, boptsReconfigure = fromFirstFalse buildMonoidReconfigure
45-
, boptsCabalVerbose = fromFirst (CabalVerbosity normal) buildMonoidCabalVerbose
46-
, boptsSplitObjs = fromFirstFalse buildMonoidSplitObjs
47-
, boptsSkipComponents = buildMonoidSkipComponents
48-
, boptsInterleavedOutput = fromFirstTrue buildMonoidInterleavedOutput
49-
, boptsDdumpDir = getFirst buildMonoidDdumpDir
50-
}
51-
where
52-
-- These options are not directly used in bopts, instead they
53-
-- transform other options.
54-
tracing = getAny buildMonoidTrace
55-
profiling = getAny buildMonoidProfile
56-
noStripping = getAny buildMonoidNoStrip
57-
-- Additional args for tracing / profiling
58-
additionalArgs =
59-
if tracing || profiling
60-
then Just $ "+RTS" : catMaybes [trac, prof, Just "-RTS"]
61-
else Nothing
62-
trac =
63-
if tracing
64-
then Just "-xc"
65-
else Nothing
66-
prof =
67-
if profiling
68-
then Just "-p"
69-
else Nothing
19+
{ boptsLibProfile = fromFirstFalse
20+
(buildMonoidLibProfile <>
21+
FirstFalse (if tracing || profiling then Just True else Nothing))
22+
, boptsExeProfile = fromFirstFalse
23+
(buildMonoidExeProfile <>
24+
FirstFalse (if tracing || profiling then Just True else Nothing))
25+
, boptsLibStrip = fromFirstTrue
26+
(buildMonoidLibStrip <>
27+
FirstTrue (if noStripping then Just False else Nothing))
28+
, boptsExeStrip = fromFirstTrue
29+
(buildMonoidExeStrip <>
30+
FirstTrue (if noStripping then Just False else Nothing))
31+
, boptsHaddock = fromFirstFalse buildMonoidHaddock
32+
, boptsHaddockOpts = haddockOptsFromMonoid buildMonoidHaddockOpts
33+
, boptsOpenHaddocks = fromFirstFalse buildMonoidOpenHaddocks
34+
, boptsHaddockDeps = getFirst buildMonoidHaddockDeps
35+
, boptsHaddockInternal = fromFirstFalse buildMonoidHaddockInternal
36+
, boptsHaddockHyperlinkSource = fromFirstTrue buildMonoidHaddockHyperlinkSource
37+
, boptsInstallExes = fromFirstFalse buildMonoidInstallExes
38+
, boptsInstallCompilerTool = fromFirstFalse buildMonoidInstallCompilerTool
39+
, boptsPreFetch = fromFirstFalse buildMonoidPreFetch
40+
, boptsKeepGoing = getFirst buildMonoidKeepGoing
41+
, boptsKeepTmpFiles = fromFirstFalse buildMonoidKeepTmpFiles
42+
, boptsForceDirty = fromFirstFalse buildMonoidForceDirty
43+
, boptsTests = fromFirstFalse buildMonoidTests
44+
, boptsTestOpts =
45+
testOptsFromMonoid buildMonoidTestOpts additionalArgs
46+
, boptsBenchmarks = fromFirstFalse buildMonoidBenchmarks
47+
, boptsBenchmarkOpts =
48+
benchmarkOptsFromMonoid buildMonoidBenchmarkOpts additionalArgs
49+
, boptsReconfigure = fromFirstFalse buildMonoidReconfigure
50+
, boptsCabalVerbose = fromFirst (CabalVerbosity normal) buildMonoidCabalVerbose
51+
, boptsSplitObjs = fromFirstFalse buildMonoidSplitObjs
52+
, boptsSkipComponents = buildMonoidSkipComponents
53+
, boptsInterleavedOutput = fromFirstTrue buildMonoidInterleavedOutput
54+
, boptsDdumpDir = getFirst buildMonoidDdumpDir
55+
}
56+
where
57+
-- These options are not directly used in bopts, instead they
58+
-- transform other options.
59+
tracing = getAny buildMonoidTrace
60+
profiling = getAny buildMonoidProfile
61+
noStripping = getAny buildMonoidNoStrip
62+
-- Additional args for tracing / profiling
63+
additionalArgs =
64+
if tracing || profiling
65+
then Just $ "+RTS" : catMaybes [trac, prof, Just "-RTS"]
66+
else Nothing
67+
trac =
68+
if tracing
69+
then Just "-xc"
70+
else Nothing
71+
prof =
72+
if profiling
73+
then Just "-p"
74+
else Nothing
7075

7176
haddockOptsFromMonoid :: HaddockOptsMonoid -> HaddockOpts
72-
haddockOptsFromMonoid HaddockOptsMonoid{..} =
73-
defaultHaddockOpts
74-
{hoAdditionalArgs = hoMonoidAdditionalArgs}
77+
haddockOptsFromMonoid HaddockOptsMonoid{..} = defaultHaddockOpts
78+
{ hoAdditionalArgs = hoMonoidAdditionalArgs }
7579

7680
testOptsFromMonoid :: TestOptsMonoid -> Maybe [String] -> TestOpts
77-
testOptsFromMonoid TestOptsMonoid{..} madditional =
78-
defaultTestOpts
79-
{ toRerunTests = fromFirstTrue toMonoidRerunTests
80-
, toAdditionalArgs = fromMaybe [] madditional <> toMonoidAdditionalArgs
81-
, toCoverage = fromFirstFalse toMonoidCoverage
82-
, toDisableRun = fromFirstFalse toMonoidDisableRun
83-
, toMaximumTimeSeconds = fromFirst (toMaximumTimeSeconds defaultTestOpts) toMonoidMaximumTimeSeconds
84-
, toAllowStdin = fromFirstTrue toMonoidAllowStdin
85-
}
81+
testOptsFromMonoid TestOptsMonoid{..} madditional = defaultTestOpts
82+
{ toRerunTests = fromFirstTrue toMonoidRerunTests
83+
, toAdditionalArgs = fromMaybe [] madditional <> toMonoidAdditionalArgs
84+
, toCoverage = fromFirstFalse toMonoidCoverage
85+
, toDisableRun = fromFirstFalse toMonoidDisableRun
86+
, toMaximumTimeSeconds =
87+
fromFirst (toMaximumTimeSeconds defaultTestOpts) toMonoidMaximumTimeSeconds
88+
, toAllowStdin = fromFirstTrue toMonoidAllowStdin
89+
}
8690

87-
benchmarkOptsFromMonoid :: BenchmarkOptsMonoid -> Maybe [String] -> BenchmarkOpts
91+
benchmarkOptsFromMonoid ::
92+
BenchmarkOptsMonoid
93+
-> Maybe [String]
94+
-> BenchmarkOpts
8895
benchmarkOptsFromMonoid BenchmarkOptsMonoid{..} madditional =
89-
defaultBenchmarkOpts
96+
defaultBenchmarkOpts
9097
{ beoAdditionalArgs =
91-
fmap (\args -> unwords args <> " ") madditional <>
92-
getFirst beoMonoidAdditionalArgs
98+
fmap (\args -> unwords args <> " ") madditional <>
99+
getFirst beoMonoidAdditionalArgs
93100
, beoDisableRun = fromFirst
94-
(beoDisableRun defaultBenchmarkOpts)
95-
beoMonoidDisableRun
101+
(beoDisableRun defaultBenchmarkOpts)
102+
beoMonoidDisableRun
96103
}

‎src/Stack/Config/Docker.hs‎

Lines changed: 49 additions & 44 deletions
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,11 @@
44
{-# LANGUAGE RecordWildCards #-}
55

66
-- | Docker configuration
7-
module Stack.Config.Docker where
7+
module Stack.Config.Docker
8+
( ConfigDockerException (..)
9+
, addDefaultTag
10+
, dockerOptsFromMonoid
11+
) where
812

913
import Data.List ( find )
1014
import qualified Data.Text as T
@@ -36,8 +40,8 @@ instance Exception ConfigDockerException where
3640
, "' explicitly, in your configuration file."]
3741

3842
-- | Add a default Docker tag name to a given base image.
39-
addDefaultTag
40-
:: MonadThrow m
43+
addDefaultTag ::
44+
MonadThrow m
4145
=> String -- ^ base
4246
-> Maybe Project
4347
-> Maybe AbstractResolver
@@ -54,45 +58,46 @@ addDefaultTag base mproject maresolver = do
5458
pure $ base ++ ":" ++ show lts
5559

5660
-- | Interprets DockerOptsMonoid options.
57-
dockerOptsFromMonoid
58-
:: MonadThrow m
59-
=> Maybe Project
60-
-> Maybe AbstractResolver
61-
-> DockerOptsMonoid
62-
-> m DockerOpts
61+
dockerOptsFromMonoid ::
62+
MonadThrow m
63+
=> Maybe Project
64+
-> Maybe AbstractResolver
65+
-> DockerOptsMonoid
66+
-> m DockerOpts
6367
dockerOptsFromMonoid mproject maresolver DockerOptsMonoid{..} = do
64-
let dockerImage =
65-
case getFirst dockerMonoidRepoOrImage of
66-
Nothing -> addDefaultTag "fpco/stack-build" mproject maresolver
67-
Just (DockerMonoidImage image) -> pure image
68-
Just (DockerMonoidRepo repo) ->
69-
case find (`elem` (":@" :: String)) repo of
70-
Nothing -> addDefaultTag repo mproject maresolver
71-
-- Repo already specified a tag or digest, so don't append default
72-
Just _ -> pure repo
73-
let dockerEnable =
74-
fromFirst (getAny dockerMonoidDefaultEnable) dockerMonoidEnable
75-
dockerRegistryLogin =
76-
fromFirst
77-
(isJust (emptyToNothing (getFirst dockerMonoidRegistryUsername)))
78-
dockerMonoidRegistryLogin
79-
dockerRegistryUsername = emptyToNothing (getFirst dockerMonoidRegistryUsername)
80-
dockerRegistryPassword = emptyToNothing (getFirst dockerMonoidRegistryPassword)
81-
dockerAutoPull = fromFirstTrue dockerMonoidAutoPull
82-
dockerDetach = fromFirstFalse dockerMonoidDetach
83-
dockerPersist = fromFirstFalse dockerMonoidPersist
84-
dockerContainerName = emptyToNothing (getFirst dockerMonoidContainerName)
85-
dockerNetwork = emptyToNothing (getFirst dockerMonoidNetwork)
86-
dockerRunArgs = dockerMonoidRunArgs
87-
dockerMount = dockerMonoidMount
88-
dockerMountMode = emptyToNothing (getFirst dockerMonoidMountMode)
89-
dockerEnv = dockerMonoidEnv
90-
dockerSetUser = getFirst dockerMonoidSetUser
91-
dockerRequireDockerVersion =
92-
simplifyVersionRange (getIntersectingVersionRange dockerMonoidRequireDockerVersion)
93-
dockerStackExe = getFirst dockerMonoidStackExe
94-
95-
pure DockerOpts{..}
96-
where emptyToNothing Nothing = Nothing
97-
emptyToNothing (Just s) | null s = Nothing
98-
| otherwise = Just s
68+
let dockerImage =
69+
case getFirst dockerMonoidRepoOrImage of
70+
Nothing -> addDefaultTag "fpco/stack-build" mproject maresolver
71+
Just (DockerMonoidImage image) -> pure image
72+
Just (DockerMonoidRepo repo) ->
73+
case find (`elem` (":@" :: String)) repo of
74+
Nothing -> addDefaultTag repo mproject maresolver
75+
-- Repo already specified a tag or digest, so don't append default
76+
Just _ -> pure repo
77+
let dockerEnable =
78+
fromFirst (getAny dockerMonoidDefaultEnable) dockerMonoidEnable
79+
dockerRegistryLogin =
80+
fromFirst
81+
(isJust (emptyToNothing (getFirst dockerMonoidRegistryUsername)))
82+
dockerMonoidRegistryLogin
83+
dockerRegistryUsername = emptyToNothing (getFirst dockerMonoidRegistryUsername)
84+
dockerRegistryPassword = emptyToNothing (getFirst dockerMonoidRegistryPassword)
85+
dockerAutoPull = fromFirstTrue dockerMonoidAutoPull
86+
dockerDetach = fromFirstFalse dockerMonoidDetach
87+
dockerPersist = fromFirstFalse dockerMonoidPersist
88+
dockerContainerName = emptyToNothing (getFirst dockerMonoidContainerName)
89+
dockerNetwork = emptyToNothing (getFirst dockerMonoidNetwork)
90+
dockerRunArgs = dockerMonoidRunArgs
91+
dockerMount = dockerMonoidMount
92+
dockerMountMode = emptyToNothing (getFirst dockerMonoidMountMode)
93+
dockerEnv = dockerMonoidEnv
94+
dockerSetUser = getFirst dockerMonoidSetUser
95+
dockerRequireDockerVersion =
96+
simplifyVersionRange (getIntersectingVersionRange dockerMonoidRequireDockerVersion)
97+
dockerStackExe = getFirst dockerMonoidStackExe
98+
pure DockerOpts{..}
99+
where
100+
emptyToNothing Nothing = Nothing
101+
emptyToNothing (Just s)
102+
| null s = Nothing
103+
| otherwise = Just s

0 commit comments

Comments
 (0)