diff --git a/app/ghcup-gen/GHCupDownloads.hs b/app/ghcup-gen/GHCupDownloads.hs index cba00f8..e5d34cd 100644 --- a/app/ghcup-gen/GHCupDownloads.hs +++ b/app/ghcup-gen/GHCupDownloads.hs @@ -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 diff --git a/ghcup.cabal b/ghcup.cabal index 6662856..21675ef 100644 --- a/ghcup.cabal +++ b/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 diff --git a/lib/GHCup.hs b/lib/GHCup.hs index a4f5abb..8097dd6 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -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) diff --git a/lib/GHCup/Utils.hs b/lib/GHCup/Utils.hs index f2a9be2..1e7350c 100644 --- a/lib/GHCup/Utils.hs +++ b/lib/GHCup/Utils.hs @@ -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 diff --git a/lib/GHCup/Utils/File.hs b/lib/GHCup/Utils/File.hs index 7157029..c871530 100644 --- a/lib/GHCup/Utils/File.hs +++ b/lib/GHCup/Utils/File.hs @@ -1,18 +1,21 @@ -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} module GHCup.Utils.File where import GHCup.Utils.Dirs import GHCup.Utils.Prelude +import Control.Concurrent 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 GHC.Foreign ( peekCStringLen ) import GHC.IO.Encoding ( getLocaleEncoding ) @@ -23,7 +26,10 @@ import Optics import Streamly import Streamly.External.ByteString import Streamly.External.ByteString.Lazy +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 +40,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 +51,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 +117,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 +134,110 @@ 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 (\(_ :: StopThread) -> pure ()) + $ EX.handle (\(_ :: 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 + flip finally (readTilEOF (lineAction ref rs) fdIn) -- make sure the last few lines don't get cut off + $ handle + (\(StopThread b) -> do + when b (forM_ rs closeConsoleRegion) + EX.throw (StopThread b) + ) + $ readForever (lineAction ref rs) fdIn + + where + -- action to perform line by line + lineAction ref rs 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") - SPPB.getProcessStatus True True pid >>= \case - i@(Just (SPPB.Exited _)) -> pure $ toProcessError exe args i - i -> pure $ toProcessError exe args i + 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 + bs <- + handle + (\(e :: IOError) -> do + if isEOFError e then threadDelay 1000 >> pure "" else throw e + ) + $ 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' + + readTilEOF action' fd' = do + bs <- readLine fd' + when (not $ BS.null bs) (action' bs >> readTilEOF action' fd') -- | Capture the stdout and stderr of the given action, which @@ -176,10 +278,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