Skip to content
GitLab
Explore
Sign in
Register
Primary navigation
Search or go to…
Project
G
ghcup-hs
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Iterations
Wiki
Requirements
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Locked files
Build
Pipelines
Jobs
Pipeline schedules
Test cases
Artifacts
Deploy
Releases
Package Registry
Container Registry
Model registry
Operate
Environments
Terraform modules
Monitor
Incidents
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Code review analytics
Issue analytics
Insights
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
Haskell
ghcup-hs
Commits
5186d959
Verified
Commit
5186d959
authored
3 years ago
by
Julian Ospald
Browse files
Options
Downloads
Patches
Plain Diff
Avoid metadata download when possible
parent
09a8a0bd
No related branches found
No related tags found
1 merge request
!238
Implement 'ghcup run'
Pipeline
#47434
failed
3 years ago
Stage: checks
Stage: quick-test
Stage: test
Stage: expensive-test
Changes
2
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
app/ghcup/GHCup/OptParse/Run.hs
+113
-58
113 additions, 58 deletions
app/ghcup/GHCup/OptParse/Run.hs
app/ghcup/Main.hs
+1
-1
1 addition, 1 deletion
app/ghcup/Main.hs
with
114 additions
and
59 deletions
app/ghcup/GHCup/OptParse/Run.hs
+
113
−
58
View file @
5186d959
...
...
@@ -161,6 +161,16 @@ type RunEffects = '[ AlreadyInstalled
,
ProcessError
]
runLeanRUN
::
(
MonadUnliftIO
m
,
MonadIO
m
)
=>
LeanAppState
->
Excepts
RunEffects
(
ReaderT
LeanAppState
m
)
a
->
m
(
VEither
RunEffects
a
)
runLeanRUN
leanAppstate
=
-- Don't use runLeanAppState here, which is disabled on windows.
-- This is the only command on all platforms that doesn't need full appstate.
flip
runReaderT
leanAppstate
.
runE
@
RunEffects
runRUN
::
MonadUnliftIO
m
=>
(
ReaderT
AppState
m
(
VEither
RunEffects
a
)
->
m
(
VEither
RunEffects
a
))
...
...
@@ -189,75 +199,120 @@ run :: forall m.
)
=>
RunOptions
->
(
forall
a
.
ReaderT
AppState
m
(
VEither
RunEffects
a
)
->
m
(
VEither
RunEffects
a
))
->
LeanAppState
->
(
ReaderT
LeanAppState
m
()
->
m
()
)
->
m
ExitCode
run
RunOptions
{
..
}
runAppState
runLogger
=
runRUN
runAppState
(
do
tmp
<-
case
runBinDir
of
run
RunOptions
{
..
}
runAppState
leanAppstate
runLogger
=
do
tmp
<-
case
runBinDir
of
Just
bdir
->
do
liftIO
$
createDirRecursive'
bdir
liftIO
$
canonicalizePath
bdir
Nothing
->
liftIO
(
getTemporaryDirectory
>>=
\
tmp
->
createTempDirectory
tmp
"ghcup"
)
forM_
runGHCVer
$
addToolToDir
tmp
GHC
forM_
runCabalVer
$
addToolToDir
tmp
Cabal
forM_
runHLSVer
$
addToolToDir
tmp
HLS
forM_
runStackVer
$
addToolToDir
tmp
Stack
case
runCOMMAND
of
[]
->
liftIO
$
putStr
tmp
(
cmd
:
args
)
->
do
newEnv
<-
liftIO
$
addToPath
tmp
r
<-
addToolsToDir
tmp
case
r
of
VRight
_
->
do
case
runCOMMAND
of
[]
->
liftIO
$
putStr
tmp
(
cmd
:
args
)
->
do
newEnv
<-
liftIO
$
addToPath
tmp
#
ifndef
IS_WINDOWS
liftIO
$
SPP
.
executeFile
cmd
True
args
(
Just
newEnv
)
liftIO
$
SPP
.
executeFile
cmd
True
args
(
Just
newEnv
)
#
else
liftE
$
lEM
@
_
@
'
[
ProcessError
]
$
exec
cmd
args
Nothing
(
Just
newEnv
)
liftE
$
lEM
@
_
@
'
[
ProcessError
]
$
exec
cmd
args
Nothing
(
Just
newEnv
)
#
endif
pure
()
)
>>=
\
case
VRight
_
->
do
pure
ExitSuccess
VLeft
e
->
do
runLogger
$
logError
$
T
.
pack
$
prettyShow
e
pure
$
ExitFailure
27
pure
ExitSuccess
VLeft
e
->
do
runLogger
$
logError
$
T
.
pack
$
prettyShow
e
pure
$
ExitFailure
27
where
isToolTag
::
ToolVersion
->
Bool
isToolTag
(
ToolTag
_
)
=
True
isToolTag
_
=
False
-- TODO: doesn't work for cross
addToolToDir
tmp
tool
ver
=
do
(
v
,
_
)
<-
liftE
$
fromVersion
(
Just
ver
)
tool
isInstalled
<-
checkIfToolInstalled'
tool
v
case
tool
of
GHC
->
do
unless
isInstalled
$
when
(
runInstTool'
&&
isNothing
(
_tvTarget
v
))
$
void
$
liftE
$
installGHCBin
(
_tvVersion
v
)
Nothing
False
void
$
liftE
$
setGHC
v
SetGHC_XYZ
(
Just
tmp
)
void
$
liftE
$
setGHC
v
SetGHCOnly
(
Just
tmp
)
pure
()
Cabal
->
do
unless
isInstalled
$
when
runInstTool'
$
void
$
liftE
$
installCabalBin
(
_tvVersion
v
)
Nothing
False
bin
<-
liftE
$
whereIsTool
Cabal
v
cbin
<-
liftIO
$
canonicalizePath
bin
lift
$
createLink
(
relativeSymlink
tmp
cbin
)
(
tmp
</>
"cabal"
)
pure
()
Stack
->
do
unless
isInstalled
$
when
runInstTool'
$
void
$
liftE
$
installStackBin
(
_tvVersion
v
)
Nothing
False
bin
<-
liftE
$
whereIsTool
Stack
v
cbin
<-
liftIO
$
canonicalizePath
bin
lift
$
createLink
(
relativeSymlink
tmp
cbin
)
(
tmp
</>
"stack"
)
pure
()
HLS
->
do
unless
isInstalled
$
when
runInstTool'
$
void
$
liftE
$
installHLSBin
(
_tvVersion
v
)
Nothing
False
liftE
$
setHLS
(
_tvVersion
v
)
SetHLS_XYZ
(
Just
tmp
)
liftE
$
setHLS
(
_tvVersion
v
)
SetHLSOnly
(
Just
tmp
)
pure
()
GHCup
->
pure
()
addToolsToDir
tmp
|
or
(
fmap
(
maybe
False
isToolTag
)
[
runGHCVer
,
runCabalVer
,
runHLSVer
,
runStackVer
])
||
runInstTool'
=
runRUN
runAppState
$
do
forM_
runGHCVer
$
\
ver
->
do
(
v
,
_
)
<-
liftE
$
fromVersion
(
Just
ver
)
GHC
installTool
GHC
v
setTool
GHC
v
tmp
forM_
runCabalVer
$
\
ver
->
do
(
v
,
_
)
<-
liftE
$
fromVersion
(
Just
ver
)
Cabal
installTool
Cabal
v
setTool
Cabal
v
tmp
forM_
runHLSVer
$
\
ver
->
do
(
v
,
_
)
<-
liftE
$
fromVersion
(
Just
ver
)
HLS
installTool
HLS
v
setTool
HLS
v
tmp
forM_
runStackVer
$
\
ver
->
do
(
v
,
_
)
<-
liftE
$
fromVersion
(
Just
ver
)
Stack
installTool
Stack
v
setTool
Stack
v
tmp
|
otherwise
=
runLeanRUN
leanAppstate
$
do
case
runGHCVer
of
Just
(
ToolVersion
v
)
->
setTool
GHC
v
tmp
Nothing
->
pure
()
_
->
fail
"Internal error"
case
runCabalVer
of
Just
(
ToolVersion
v
)
->
setTool
Cabal
v
tmp
Nothing
->
pure
()
_
->
fail
"Internal error"
case
runHLSVer
of
Just
(
ToolVersion
v
)
->
setTool
HLS
v
tmp
Nothing
->
pure
()
_
->
fail
"Internal error"
case
runStackVer
of
Just
(
ToolVersion
v
)
->
setTool
Stack
v
tmp
Nothing
->
pure
()
_
->
fail
"Internal error"
installTool
tool
v
=
do
isInstalled
<-
checkIfToolInstalled'
tool
v
case
tool
of
GHC
->
do
unless
isInstalled
$
when
(
runInstTool'
&&
isNothing
(
_tvTarget
v
))
$
void
$
liftE
$
installGHCBin
(
_tvVersion
v
)
Nothing
False
Cabal
->
do
unless
isInstalled
$
when
runInstTool'
$
void
$
liftE
$
installCabalBin
(
_tvVersion
v
)
Nothing
False
Stack
->
do
unless
isInstalled
$
when
runInstTool'
$
void
$
liftE
$
installStackBin
(
_tvVersion
v
)
Nothing
False
HLS
->
do
unless
isInstalled
$
when
runInstTool'
$
void
$
liftE
$
installHLSBin
(
_tvVersion
v
)
Nothing
False
GHCup
->
pure
()
setTool
tool
v
tmp
=
case
tool
of
GHC
->
do
void
$
liftE
$
setGHC
v
SetGHC_XYZ
(
Just
tmp
)
void
$
liftE
$
setGHC
v
SetGHCOnly
(
Just
tmp
)
Cabal
->
do
bin
<-
liftE
$
whereIsTool
Cabal
v
cbin
<-
liftIO
$
canonicalizePath
bin
lift
$
createLink
(
relativeSymlink
tmp
cbin
)
(
tmp
</>
"cabal"
)
Stack
->
do
bin
<-
liftE
$
whereIsTool
Stack
v
cbin
<-
liftIO
$
canonicalizePath
bin
lift
$
createLink
(
relativeSymlink
tmp
cbin
)
(
tmp
</>
"stack"
)
HLS
->
do
liftE
$
setHLS
(
_tvVersion
v
)
SetHLS_XYZ
(
Just
tmp
)
liftE
$
setHLS
(
_tvVersion
v
)
SetHLSOnly
(
Just
tmp
)
GHCup
->
pure
()
addToPath
path
=
do
cEnv
<-
Map
.
fromList
<$>
getEnvironment
let
paths
=
[
"PATH"
,
"Path"
]
...
...
This diff is collapsed.
Click to expand it.
app/ghcup/Main.hs
+
1
−
1
View file @
5186d959
...
...
@@ -313,7 +313,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
Nuke
->
nuke
appState
runLogger
Prefetch
pfCom
->
prefetch
pfCom
runAppState
runLogger
GC
gcOpts
->
gc
gcOpts
runAppState
runLogger
Run
runCommand
->
run
runCommand
runAppState
runLogger
Run
runCommand
->
run
runCommand
runAppState
leanAppstate
runLogger
case
res
of
ExitSuccess
->
pure
()
...
...
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment