Compare commits
1 Commits
master
...
experiment
| Author | SHA1 | Date | |
|---|---|---|---|
| 1810bb27a8 |
@ -1680,7 +1680,7 @@ ghcupDownloads = M.fromList
|
||||
)
|
||||
, ( GHCup
|
||||
, M.fromList
|
||||
[ ( [vver|0.1.0|]
|
||||
[ ( [vver|0.0.0|]
|
||||
, VersionInfo [Recommended, Latest] Nothing $ M.fromList
|
||||
[ ( A_64
|
||||
, M.fromList
|
||||
|
||||
565
ghcup.cabal
565
ghcup.cabal
@ -1,236 +1,371 @@
|
||||
cabal-version: 2.2
|
||||
cabal-version: 3.0
|
||||
name: ghcup
|
||||
version: 0.1.0.0
|
||||
synopsis: ghc toolchain installer as an exe/library
|
||||
description:
|
||||
A rewrite of the shell script ghcup, for providing
|
||||
a more stable user experience and exposing an API.
|
||||
|
||||
name: ghcup
|
||||
version: 0.1.0.0
|
||||
synopsis: ghc toolchain installer as an exe/library
|
||||
description: A rewrite of the shell script ghcup, for providing
|
||||
a more stable user experience and exposing an API.
|
||||
homepage: https://github.com/hasufell/ghcup-hs
|
||||
bug-reports: https://github.com/hasufell/ghcup-hs/issues
|
||||
license: LGPL-3.0-only
|
||||
license-file: LICENSE
|
||||
author: Julian Ospald
|
||||
maintainer: hasufell@posteo.de
|
||||
copyright: Julian Ospald 2020
|
||||
category: System
|
||||
build-type: Simple
|
||||
extra-source-files: CHANGELOG.md
|
||||
homepage: https://github.com/hasufell/ghcup-hs
|
||||
bug-reports: https://github.com/hasufell/ghcup-hs/issues
|
||||
license: LGPL-3.0-only
|
||||
license-file: LICENSE
|
||||
author: Julian Ospald
|
||||
maintainer: hasufell@posteo.de
|
||||
copyright: Julian Ospald 2020
|
||||
category: System
|
||||
build-type: Simple
|
||||
extra-source-files: CHANGELOG.md
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
type: git
|
||||
location: https://github.com/hasufell/ghcup-hs
|
||||
|
||||
common HsOpenSSL { build-depends: HsOpenSSL >= 0.11 }
|
||||
common aeson { build-depends: aeson >= 1.4 }
|
||||
common aeson-pretty { build-depends: aeson-pretty >= 0.8.8 }
|
||||
common ascii-string { build-depends: ascii-string >= 1.0 }
|
||||
common async { build-depends: async >= 0.8 }
|
||||
common attoparsec { build-depends: attoparsec >= 0.13 }
|
||||
common base { build-depends: base >= 4.12 && < 5 }
|
||||
common binary { build-depends: binary >= 0.8.6.0 }
|
||||
common bytestring { build-depends: bytestring >= 0.10 }
|
||||
common bzlib { build-depends: bzlib >= 0.5.0.5 }
|
||||
common case-insensitive { build-depends: case-insensitive >= 1.2.1.0 }
|
||||
common containers { build-depends: containers >= 0.6 }
|
||||
common generics-sop { build-depends: generics-sop >= 0.5 }
|
||||
common haskus-utils-types { build-depends: haskus-utils-types >= 1.5 }
|
||||
common haskus-utils-variant { build-depends: haskus-utils-variant >= 3.0 }
|
||||
common hopenssl { build-depends: hopenssl >= 2.2.4 }
|
||||
common hpath { build-depends: hpath >= 0.11 }
|
||||
common hpath-directory { build-depends: hpath-directory >= 0.13.2 }
|
||||
common hpath-filepath { build-depends: hpath-filepath >= 0.10.3 }
|
||||
common hpath-io { build-depends: hpath-io >= 0.13.1 }
|
||||
common hpath-posix { build-depends: hpath-posix >= 0.11.1 }
|
||||
common http-io-streams { build-depends: http-io-streams >= 0.1.2.0 }
|
||||
common io-streams { build-depends: io-streams >= 1.5 }
|
||||
common language-bash { build-depends: language-bash >= 0.9 }
|
||||
common lzma { build-depends: lzma >= 0.0.0.3 }
|
||||
common megaparsec { build-depends: megaparsec >= 3.5.3 }
|
||||
common monad-logger { build-depends: monad-logger >= 0.3.31 }
|
||||
common mtl { build-depends: mtl >= 2.2 }
|
||||
common optics { build-depends: optics >= 0.2 }
|
||||
common optics-vl { build-depends: optics-vl >= 0.2 }
|
||||
common optparse-applicative { build-depends: optparse-applicative >= 0.15.1.0 }
|
||||
common parsec { build-depends: parsec >= 3.1 }
|
||||
common pretty-terminal { build-depends: pretty-terminal >= 0.1.0.0 }
|
||||
common regex-posix { build-depends: regex-posix >= 0.96 }
|
||||
common resourcet { build-depends: resourcet >= 1.2.2 }
|
||||
common safe { build-depends: safe >= 0.3.18 }
|
||||
common safe-exceptions { build-depends: safe-exceptions >= 0.1 }
|
||||
common streamly { build-depends: streamly >= 0.7.1 }
|
||||
common streamly-posix { build-depends: streamly-posix >= 0.1.0.0 }
|
||||
common streamly-bytestring { build-depends: streamly-bytestring >= 0.1.2 }
|
||||
common strict-base { build-depends: strict-base >= 0.4 }
|
||||
common string-interpolate { build-depends: string-interpolate >= 0.2.0.0 }
|
||||
common table-layout { build-depends: table-layout >= 0.8 }
|
||||
common tar-bytestring { build-depends: tar-bytestring >= 0.6.3.1 }
|
||||
common template-haskell { build-depends: template-haskell >= 2.7 }
|
||||
common terminal-progress-bar { build-depends: terminal-progress-bar >= 0.4.1 }
|
||||
common text { build-depends: text >= 1.2 }
|
||||
common time { build-depends: time >= 1.9.3 }
|
||||
common transformers { build-depends: transformers >= 0.5 }
|
||||
common unix { build-depends: unix >= 2.7 }
|
||||
common unix-bytestring { build-depends: unix-bytestring >= 0.3 }
|
||||
common uri-bytestring { build-depends: uri-bytestring >= 0.3.2.2 }
|
||||
common utf8-string { build-depends: utf8-string >= 1.0 }
|
||||
common vector { build-depends: vector >= 0.12 }
|
||||
common versions { build-depends: versions >= 3.5 }
|
||||
common waargonaut { build-depends: waargonaut >= 0.8 }
|
||||
common word8 { build-depends: word8 >= 0.1.3 }
|
||||
common zlib { build-depends: zlib >= 0.6.2.1 }
|
||||
common HsOpenSSL
|
||||
build-depends: HsOpenSSL >=0.11
|
||||
|
||||
common aeson
|
||||
build-depends: aeson >=1.4
|
||||
|
||||
common aeson-pretty
|
||||
build-depends: aeson-pretty >=0.8.8
|
||||
|
||||
common ascii-string
|
||||
build-depends: ascii-string >=1.0
|
||||
|
||||
common async
|
||||
build-depends: async >=0.8
|
||||
|
||||
common attoparsec
|
||||
build-depends: attoparsec >=0.13
|
||||
|
||||
common base
|
||||
build-depends: base >=4.12 && <5
|
||||
|
||||
common binary
|
||||
build-depends: binary >=0.8.6.0
|
||||
|
||||
common bytestring
|
||||
build-depends: bytestring >=0.10
|
||||
|
||||
common bzlib
|
||||
build-depends: bzlib >=0.5.0.5
|
||||
|
||||
common case-insensitive
|
||||
build-depends: case-insensitive >=1.2.1.0
|
||||
|
||||
common concurrent-output
|
||||
build-depends: concurrent-output >=1.10.11
|
||||
|
||||
common containers
|
||||
build-depends: containers >=0.6
|
||||
|
||||
common generics-sop
|
||||
build-depends: generics-sop >=0.5
|
||||
|
||||
common haskus-utils-types
|
||||
build-depends: haskus-utils-types >=1.5
|
||||
|
||||
common haskus-utils-variant
|
||||
build-depends: haskus-utils-variant >=3.0
|
||||
|
||||
common hopenssl
|
||||
build-depends: hopenssl >=2.2.4
|
||||
|
||||
common hpath
|
||||
build-depends: hpath >=0.11
|
||||
|
||||
common hpath-directory
|
||||
build-depends: hpath-directory >=0.13.2
|
||||
|
||||
common hpath-filepath
|
||||
build-depends: hpath-filepath >=0.10.3
|
||||
|
||||
common hpath-io
|
||||
build-depends: hpath-io >=0.13.1
|
||||
|
||||
common hpath-posix
|
||||
build-depends: hpath-posix >=0.11.1
|
||||
|
||||
common http-io-streams
|
||||
build-depends: http-io-streams >=0.1.2.0
|
||||
|
||||
common io-streams
|
||||
build-depends: io-streams >=1.5
|
||||
|
||||
common language-bash
|
||||
build-depends: language-bash >=0.9
|
||||
|
||||
common lzma
|
||||
build-depends: lzma >=0.0.0.3
|
||||
|
||||
common megaparsec
|
||||
build-depends: megaparsec >=8.0.0
|
||||
|
||||
common monad-logger
|
||||
build-depends: monad-logger >=0.3.31
|
||||
|
||||
common mtl
|
||||
build-depends: mtl >=2.2
|
||||
|
||||
common optics
|
||||
build-depends: optics >=0.2
|
||||
|
||||
common optics-vl
|
||||
build-depends: optics-vl >=0.2
|
||||
|
||||
common optparse-applicative
|
||||
build-depends: optparse-applicative >=0.15.1.0
|
||||
|
||||
common parsec
|
||||
build-depends: parsec >=3.1
|
||||
|
||||
common pretty-terminal
|
||||
build-depends: pretty-terminal >=0.1.0.0
|
||||
|
||||
common regex-posix
|
||||
build-depends: regex-posix >=0.96
|
||||
|
||||
common resourcet
|
||||
build-depends: resourcet >=1.2.2
|
||||
|
||||
common safe
|
||||
build-depends: safe >=0.3.18
|
||||
|
||||
common safe-exceptions
|
||||
build-depends: safe-exceptions >=0.1
|
||||
|
||||
common streamly
|
||||
build-depends: streamly >=0.7.1
|
||||
|
||||
common streamly-posix
|
||||
build-depends: streamly-posix >=0.1.0.0
|
||||
|
||||
common streamly-bytestring
|
||||
build-depends: streamly-bytestring >=0.1.2
|
||||
|
||||
common strict-base
|
||||
build-depends: strict-base >=0.4
|
||||
|
||||
common string-interpolate
|
||||
build-depends: string-interpolate >=0.2.0.0
|
||||
|
||||
common table-layout
|
||||
build-depends: table-layout >=0.8
|
||||
|
||||
common tar-bytestring
|
||||
build-depends: tar-bytestring >=0.6.3.1
|
||||
|
||||
common template-haskell
|
||||
build-depends: template-haskell >=2.7
|
||||
|
||||
common terminal-progress-bar
|
||||
build-depends: terminal-progress-bar >=0.4.1
|
||||
|
||||
common text
|
||||
build-depends: text >=1.2
|
||||
|
||||
common time
|
||||
build-depends: time >=1.9.3
|
||||
|
||||
common transformers
|
||||
build-depends: transformers >=0.5
|
||||
|
||||
common unix
|
||||
build-depends: unix >=2.7
|
||||
|
||||
common unix-bytestring
|
||||
build-depends: unix-bytestring >=0.3
|
||||
|
||||
common uri-bytestring
|
||||
build-depends: uri-bytestring >=0.3.2.2
|
||||
|
||||
common utf8-string
|
||||
build-depends: utf8-string >=1.0
|
||||
|
||||
common vector
|
||||
build-depends: vector >=0.12
|
||||
|
||||
common versions
|
||||
build-depends: versions >=3.5
|
||||
|
||||
common waargonaut
|
||||
build-depends: waargonaut >=0.8
|
||||
|
||||
common word8
|
||||
build-depends: word8 >=0.1.3
|
||||
|
||||
common zlib
|
||||
build-depends: zlib >=0.6.2.1
|
||||
|
||||
common config
|
||||
default-language: Haskell2010
|
||||
ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -threaded
|
||||
default-extensions: LambdaCase
|
||||
, MultiWayIf
|
||||
, PackageImports
|
||||
, RecordWildCards
|
||||
, ScopedTypeVariables
|
||||
, StrictData
|
||||
, Strict
|
||||
, TupleSections
|
||||
default-language: Haskell2010
|
||||
ghc-options:
|
||||
-Wall -fwarn-tabs -fwarn-incomplete-uni-patterns
|
||||
-fwarn-incomplete-record-updates -threaded
|
||||
|
||||
default-extensions:
|
||||
LambdaCase
|
||||
MultiWayIf
|
||||
PackageImports
|
||||
RecordWildCards
|
||||
ScopedTypeVariables
|
||||
Strict
|
||||
StrictData
|
||||
TupleSections
|
||||
|
||||
library
|
||||
import: config
|
||||
, base
|
||||
-- deps
|
||||
, HsOpenSSL
|
||||
, aeson
|
||||
, ascii-string
|
||||
, async
|
||||
, attoparsec
|
||||
, binary
|
||||
, bytestring
|
||||
, bzlib
|
||||
, case-insensitive
|
||||
, containers
|
||||
, generics-sop
|
||||
, haskus-utils-types
|
||||
, haskus-utils-variant
|
||||
, hopenssl
|
||||
, hpath
|
||||
, hpath-directory
|
||||
, hpath-filepath
|
||||
, hpath-io
|
||||
, hpath-posix
|
||||
, http-io-streams
|
||||
, io-streams
|
||||
, language-bash
|
||||
, lzma
|
||||
, monad-logger
|
||||
, mtl
|
||||
, optics
|
||||
, optics-vl
|
||||
, parsec
|
||||
, pretty-terminal
|
||||
, regex-posix
|
||||
, resourcet
|
||||
, safe
|
||||
, safe-exceptions
|
||||
, streamly
|
||||
, streamly-posix
|
||||
, streamly-bytestring
|
||||
, strict-base
|
||||
, string-interpolate
|
||||
, tar-bytestring
|
||||
, template-haskell
|
||||
, terminal-progress-bar
|
||||
, text
|
||||
, time
|
||||
, transformers
|
||||
, unix
|
||||
, unix-bytestring
|
||||
, uri-bytestring
|
||||
, utf8-string
|
||||
, vector
|
||||
, versions
|
||||
, word8
|
||||
, zlib
|
||||
exposed-modules: GHCup
|
||||
GHCup.Download
|
||||
GHCup.Errors
|
||||
GHCup.Platform
|
||||
GHCup.Types
|
||||
GHCup.Types.JSON
|
||||
GHCup.Types.Optics
|
||||
GHCup.Utils
|
||||
GHCup.Utils.Bash
|
||||
GHCup.Utils.Dirs
|
||||
GHCup.Utils.File
|
||||
GHCup.Utils.Logger
|
||||
GHCup.Utils.Prelude
|
||||
GHCup.Utils.String.QQ
|
||||
GHCup.Utils.Version.QQ
|
||||
GHCup.Version
|
||||
import:
|
||||
config
|
||||
, base
|
||||
, HsOpenSSL
|
||||
, aeson
|
||||
, ascii-string
|
||||
, async
|
||||
, attoparsec
|
||||
, binary
|
||||
, bytestring
|
||||
, bzlib
|
||||
, case-insensitive
|
||||
, concurrent-output
|
||||
, containers
|
||||
, generics-sop
|
||||
, haskus-utils-types
|
||||
, haskus-utils-variant
|
||||
, hopenssl
|
||||
, hpath
|
||||
, hpath-directory
|
||||
, hpath-filepath
|
||||
, hpath-io
|
||||
, hpath-posix
|
||||
, http-io-streams
|
||||
, io-streams
|
||||
, language-bash
|
||||
, lzma
|
||||
, monad-logger
|
||||
, mtl
|
||||
, optics
|
||||
, optics-vl
|
||||
, parsec
|
||||
, pretty-terminal
|
||||
, regex-posix
|
||||
, resourcet
|
||||
, safe
|
||||
, safe-exceptions
|
||||
, streamly
|
||||
, streamly-posix
|
||||
, streamly-bytestring
|
||||
, strict-base
|
||||
, string-interpolate
|
||||
, tar-bytestring
|
||||
, template-haskell
|
||||
, terminal-progress-bar
|
||||
, text
|
||||
, time
|
||||
, transformers
|
||||
, unix
|
||||
, unix-bytestring
|
||||
, uri-bytestring
|
||||
, utf8-string
|
||||
, vector
|
||||
, versions
|
||||
, word8
|
||||
, zlib
|
||||
|
||||
-- deps
|
||||
-- cabal-fmt: expand lib
|
||||
exposed-modules:
|
||||
GHCup
|
||||
GHCup.Download
|
||||
GHCup.Errors
|
||||
GHCup.Platform
|
||||
GHCup.Types
|
||||
GHCup.Types.JSON
|
||||
GHCup.Types.Optics
|
||||
GHCup.Utils
|
||||
GHCup.Utils.Bash
|
||||
GHCup.Utils.Dirs
|
||||
GHCup.Utils.File
|
||||
GHCup.Utils.Logger
|
||||
GHCup.Utils.Prelude
|
||||
GHCup.Utils.String.QQ
|
||||
GHCup.Utils.Version.QQ
|
||||
GHCup.Version
|
||||
|
||||
-- other-modules:
|
||||
-- other-extensions:
|
||||
hs-source-dirs: lib
|
||||
hs-source-dirs: lib
|
||||
|
||||
executable ghcup
|
||||
import: config
|
||||
, base
|
||||
--
|
||||
, bytestring
|
||||
, containers
|
||||
, haskus-utils-variant
|
||||
, monad-logger
|
||||
, megaparsec
|
||||
, mtl
|
||||
, optparse-applicative
|
||||
, text
|
||||
, versions
|
||||
, hpath
|
||||
, hpath-io
|
||||
, pretty-terminal
|
||||
, resourcet
|
||||
, string-interpolate
|
||||
, table-layout
|
||||
, uri-bytestring
|
||||
, utf8-string
|
||||
main-is: Main.hs
|
||||
import:
|
||||
config
|
||||
, base
|
||||
, bytestring
|
||||
, containers
|
||||
, haskus-utils-variant
|
||||
, monad-logger
|
||||
, megaparsec
|
||||
, mtl
|
||||
, optparse-applicative
|
||||
, text
|
||||
, versions
|
||||
, hpath
|
||||
, hpath-io
|
||||
, pretty-terminal
|
||||
, resourcet
|
||||
, string-interpolate
|
||||
, table-layout
|
||||
, uri-bytestring
|
||||
, utf8-string
|
||||
|
||||
--
|
||||
main-is: Main.hs
|
||||
|
||||
-- other-modules:
|
||||
-- other-extensions:
|
||||
build-depends: ghcup
|
||||
hs-source-dirs: app/ghcup
|
||||
default-language: Haskell2010
|
||||
build-depends: ghcup
|
||||
hs-source-dirs: app/ghcup
|
||||
default-language: Haskell2010
|
||||
|
||||
executable ghcup-gen
|
||||
import: config
|
||||
, base
|
||||
--
|
||||
, aeson
|
||||
, aeson-pretty
|
||||
, bytestring
|
||||
, containers
|
||||
, safe-exceptions
|
||||
, haskus-utils-variant
|
||||
, monad-logger
|
||||
, mtl
|
||||
, optics
|
||||
, optparse-applicative
|
||||
, text
|
||||
, versions
|
||||
, hpath
|
||||
, pretty-terminal
|
||||
, resourcet
|
||||
, string-interpolate
|
||||
, table-layout
|
||||
, transformers
|
||||
, uri-bytestring
|
||||
, utf8-string
|
||||
main-is: Main.hs
|
||||
other-modules: GHCupDownloads
|
||||
Validate
|
||||
import:
|
||||
config
|
||||
, base
|
||||
, aeson
|
||||
, aeson-pretty
|
||||
, bytestring
|
||||
, containers
|
||||
, safe-exceptions
|
||||
, haskus-utils-variant
|
||||
, monad-logger
|
||||
, mtl
|
||||
, optics
|
||||
, optparse-applicative
|
||||
, text
|
||||
, versions
|
||||
, hpath
|
||||
, pretty-terminal
|
||||
, resourcet
|
||||
, string-interpolate
|
||||
, table-layout
|
||||
, transformers
|
||||
, uri-bytestring
|
||||
, utf8-string
|
||||
|
||||
--
|
||||
main-is: Main.hs
|
||||
other-modules:
|
||||
GHCupDownloads
|
||||
Validate
|
||||
|
||||
-- other-extensions:
|
||||
build-depends: ghcup
|
||||
hs-source-dirs: app/ghcup-gen
|
||||
default-language: Haskell2010
|
||||
build-depends: ghcup
|
||||
hs-source-dirs: app/ghcup-gen
|
||||
default-language: Haskell2010
|
||||
|
||||
test-suite ghcup-test
|
||||
default-language: Haskell2010
|
||||
type: exitcode-stdio-1.0
|
||||
hs-source-dirs: test
|
||||
main-is: MyLibTest.hs
|
||||
build-depends: base ^>=4.12.0.0
|
||||
default-language: Haskell2010
|
||||
type: exitcode-stdio-1.0
|
||||
hs-source-dirs: test
|
||||
main-is: MyLibTest.hs
|
||||
build-depends: base >=4.12.0.0
|
||||
|
||||
@ -138,7 +138,7 @@ installGHCBin bDls ver mpfReq = do
|
||||
lEM $ liftIO $ execLogged "./configure"
|
||||
False
|
||||
["--prefix=" <> toFilePath inst]
|
||||
[rel|ghc-configure.log|]
|
||||
[rel|ghc-configure|]
|
||||
(Just path)
|
||||
Nothing
|
||||
lEM $ liftIO $ make ["install"] (Just path)
|
||||
@ -516,7 +516,7 @@ GhcWithLlvmCodeGen = YES|]
|
||||
"./configure"
|
||||
False
|
||||
["--prefix=" <> toFilePath ghcdir]
|
||||
[rel|ghc-configure.log|]
|
||||
[rel|ghc-conf|]
|
||||
(Just workdir)
|
||||
(Just (("GHC", toFilePath bghcPath) : newEnv))
|
||||
| otherwise -> do
|
||||
@ -524,7 +524,7 @@ GhcWithLlvmCodeGen = YES|]
|
||||
"./configure"
|
||||
False
|
||||
["--prefix=" <> toFilePath ghcdir, "--with-ghc=" <> toFilePath bghc]
|
||||
[rel|ghc-configure.log|]
|
||||
[rel|ghc-conf|]
|
||||
(Just workdir)
|
||||
(Just newEnv)
|
||||
|
||||
@ -612,7 +612,7 @@ compileCabal dls tver bver jobs = do
|
||||
lEM $ liftIO $ execLogged "./bootstrap.sh"
|
||||
False
|
||||
(maybe [] (\j -> ["-j", fS (show j)]) jobs)
|
||||
[rel|cabal-bootstrap.log|]
|
||||
[rel|cabal-bootstrap|]
|
||||
(Just workdir)
|
||||
(Just newEnv)
|
||||
|
||||
|
||||
@ -335,4 +335,4 @@ make args workdir = do
|
||||
spaths <- catMaybes . fmap parseAbs <$> getSearchPath
|
||||
has_gmake <- isJust <$> searchPath spaths [rel|gmake|]
|
||||
let mymake = if has_gmake then "gmake" else "make"
|
||||
execLogged mymake True args [rel|ghc-make.log|] workdir Nothing
|
||||
execLogged mymake True args [rel|ghc-make|] workdir Nothing
|
||||
|
||||
@ -1,19 +1,26 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
module GHCup.Utils.File where
|
||||
|
||||
import GHCup.Utils.Dirs
|
||||
import GHCup.Utils.Prelude
|
||||
import GHCup.Utils.String.QQ
|
||||
|
||||
import Control.Concurrent
|
||||
import Control.Concurrent.MVar
|
||||
import Control.Exception.Safe
|
||||
import Control.Monad
|
||||
import Data.ByteString
|
||||
import Data.ByteString ( ByteString )
|
||||
import Data.ByteString.Unsafe ( unsafeUseAsCStringLen )
|
||||
import Data.Char
|
||||
import Data.Foldable
|
||||
import Data.Functor
|
||||
import Data.IORef
|
||||
import Data.Maybe
|
||||
import Data.Word8
|
||||
import GHC.Conc hiding ( threadWaitRead )
|
||||
import GHC.Foreign ( peekCStringLen )
|
||||
import GHC.IO.Encoding ( getLocaleEncoding )
|
||||
import GHC.IO.Exception
|
||||
@ -23,7 +30,11 @@ import Optics
|
||||
import Streamly
|
||||
import Streamly.External.ByteString
|
||||
import Streamly.External.ByteString.Lazy
|
||||
import System.Console.Concurrent
|
||||
import System.Console.Pretty
|
||||
import System.Console.Regions
|
||||
import System.IO
|
||||
import System.IO.Error
|
||||
import System.Posix.Directory.ByteString
|
||||
import System.Posix.FD as FD
|
||||
import System.Posix.FilePath hiding ( (</>) )
|
||||
@ -34,6 +45,9 @@ import System.Posix.Process ( ProcessStatus(..) )
|
||||
import System.Posix.Types
|
||||
|
||||
|
||||
import qualified Control.Exception as EX
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import qualified System.Posix.Process.ByteString
|
||||
as SPPB
|
||||
import Streamly.External.Posix.DirStream
|
||||
@ -42,7 +56,16 @@ import qualified Streamly.Internal.Memory.ArrayStream
|
||||
import qualified Streamly.FileSystem.Handle as FH
|
||||
import qualified Streamly.Internal.Data.Unfold as SU
|
||||
import qualified Streamly.Prelude as S
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
import qualified "unix-bytestring" System.Posix.IO.ByteString
|
||||
as SPIB
|
||||
|
||||
|
||||
data StopThread = StopThread Bool
|
||||
deriving Show
|
||||
|
||||
instance Exception StopThread
|
||||
|
||||
|
||||
data ProcessError = NonZeroExit Int ByteString [ByteString]
|
||||
@ -99,7 +122,7 @@ findExecutable ex = do
|
||||
|
||||
-- | Execute the given command and collect the stdout, stderr and the exit code.
|
||||
-- The command is run in a subprocess.
|
||||
executeOut :: Path b -- ^ command as filename, e.g. 'ls'
|
||||
executeOut :: Path b -- ^ command as filename, e.g. 'ls'
|
||||
-> [ByteString] -- ^ arguments to the command
|
||||
-> Maybe (Path Abs) -- ^ chdir to this path
|
||||
-> IO CapturedProcess
|
||||
@ -116,26 +139,101 @@ execLogged :: ByteString -- ^ thing to execute
|
||||
-> Maybe [(ByteString, ByteString)] -- ^ optional environment
|
||||
-> IO (Either ProcessError ())
|
||||
execLogged exe spath args lfile chdir env = do
|
||||
ldir <- ghcupLogsDir
|
||||
let logfile = ldir </> lfile
|
||||
ldir <- ghcupLogsDir
|
||||
logfile <- (ldir </>) <$> parseRel (toFilePath lfile <> ".log")
|
||||
bracket (createFile (toFilePath logfile) newFilePerms) closeFd action
|
||||
where
|
||||
action fd = do
|
||||
pid <- SPPB.forkProcess $ do
|
||||
-- dup stdout
|
||||
void $ dupTo fd stdOutput
|
||||
actionWithPipes $ \(stdoutRead, stdoutWrite) -> do
|
||||
-- start the thread that logs to stdout in a region
|
||||
done <- newEmptyMVar
|
||||
tid <-
|
||||
forkIO
|
||||
$ EX.handle (\(e :: StopThread) -> pure ())
|
||||
$ EX.handle (\(e :: IOException) -> pure ())
|
||||
$ flip finally (putMVar done ())
|
||||
$ printToRegion fd stdoutRead 6
|
||||
|
||||
-- dup stderr
|
||||
void $ dupTo fd stdError
|
||||
-- fork our subprocess
|
||||
pid <- SPPB.forkProcess $ do
|
||||
void $ dupTo stdoutWrite stdOutput
|
||||
void $ dupTo stdoutWrite stdError
|
||||
closeFd stdoutWrite
|
||||
closeFd stdoutRead
|
||||
|
||||
-- execute the action
|
||||
maybe (pure ()) (changeWorkingDirectory . toFilePath) chdir
|
||||
SPPB.executeFile exe spath args env
|
||||
-- execute the action
|
||||
maybe (pure ()) (changeWorkingDirectory . toFilePath) chdir
|
||||
SPPB.executeFile exe spath args env
|
||||
|
||||
closeFd stdoutWrite
|
||||
|
||||
-- wait for the subprocess to finish
|
||||
e <- SPPB.getProcessStatus True True pid >>= \case
|
||||
i@(Just (SPPB.Exited _)) -> pure $ toProcessError exe args i
|
||||
i -> pure $ toProcessError exe args i
|
||||
|
||||
-- make sure the logging thread stops
|
||||
case e of
|
||||
Left _ -> EX.throwTo tid (StopThread False)
|
||||
Right _ -> EX.throwTo tid (StopThread True)
|
||||
takeMVar done
|
||||
|
||||
closeFd stdoutRead
|
||||
pure e
|
||||
|
||||
-- Reads fdIn and logs the output in a continous scrolling area
|
||||
-- of 'size' terminal lines. Also writes to a log file.
|
||||
printToRegion fileFd fdIn size = do
|
||||
ref <- newIORef ([] :: [ByteString])
|
||||
displayConsoleRegions $ do
|
||||
rs <- sequence . replicate size . openConsoleRegion $ Linear
|
||||
EX.handle
|
||||
(\(StopThread b) -> do
|
||||
when b (forM_ rs closeConsoleRegion)
|
||||
EX.throw (StopThread b)
|
||||
)
|
||||
$ readForever
|
||||
(\bs -> do
|
||||
modifyIORef' ref (swapRegs bs)
|
||||
regs <- readIORef ref
|
||||
forM (zip regs rs) $ \(bs, r) -> do
|
||||
setConsoleRegion r $ do
|
||||
w <- consoleWidth
|
||||
return
|
||||
. T.pack
|
||||
. color Blue
|
||||
. T.unpack
|
||||
. E.decodeUtf8
|
||||
. trim w
|
||||
. (\b -> "[ " <> toFilePath lfile <> " ] " <> b)
|
||||
$ bs
|
||||
SPIB.fdWrite fileFd (bs <> "\n")
|
||||
)
|
||||
fdIn
|
||||
|
||||
|
||||
SPPB.getProcessStatus True True pid >>= \case
|
||||
i@(Just (SPPB.Exited _)) -> pure $ toProcessError exe args i
|
||||
i -> pure $ toProcessError exe args i
|
||||
where
|
||||
swapRegs bs regs | length regs < size = regs ++ [bs]
|
||||
| otherwise = tail regs ++ [bs]
|
||||
|
||||
-- trim output line to terminal width
|
||||
trim w bs | BS.length bs > w && w > 5 = BS.take (w - 4) bs <> "..."
|
||||
| otherwise = bs
|
||||
|
||||
-- read an entire line from the file descriptor (removes the newline char)
|
||||
readLine fd' = do
|
||||
threadWaitRead fd'
|
||||
bs <- SPIB.fdRead fd' 1
|
||||
if
|
||||
| bs == "\n" -> pure ""
|
||||
| bs == "" -> pure ""
|
||||
| otherwise -> fmap (bs <>) $ readLine fd'
|
||||
|
||||
readForever action' fd' = do
|
||||
bs <- readLine fd'
|
||||
if not $ BS.null bs
|
||||
then action' bs >> readForever action' fd'
|
||||
else readForever action' fd'
|
||||
|
||||
|
||||
-- | Capture the stdout and stderr of the given action, which
|
||||
@ -176,10 +274,13 @@ captureOutStreams action =
|
||||
}
|
||||
_ -> throwIO $ userError $ ("No such PID " ++ show pid)
|
||||
|
||||
where
|
||||
actionWithPipes a =
|
||||
createPipe >>= \(p1, p2) -> (flip finally) (cleanup [p1, p2]) $ a (p1, p2)
|
||||
cleanup fds = for_ fds $ \fd -> handleIO (\_ -> pure ()) $ closeFd fd
|
||||
|
||||
actionWithPipes :: ((Fd, Fd) -> IO b) -> IO b
|
||||
actionWithPipes a =
|
||||
createPipe >>= \(p1, p2) -> (flip finally) (cleanup [p1, p2]) $ a (p1, p2)
|
||||
|
||||
cleanup :: [Fd] -> IO ()
|
||||
cleanup fds = for_ fds $ \fd -> handleIO (\_ -> pure ()) $ closeFd fd
|
||||
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user