Remove libtinfo compat symlinks

2020-07-21 00:36:31 +02:00
10 changed files with 79 additions and 177 deletions
--- a/.gitlab/before_script/linux/alpine/install_deps.sh
+++ b/.gitlab/before_script/linux/alpine/install_deps.sh
@@ -18,10 +18,6 @@ apk add --no-cache \
 	tar \
 	perl

-ln -sf libncurses.so /usr/lib/libtinfo.so
-ln -sf libncursesw.so.6 /usr/lib/libtinfow.so.6
-ln -sf libtinfow.so.6 /usr/lib/libtinfow.so
-
 if [ "${BIT}" = "32" ] ; then
 	curl -sSfL https://downloads.haskell.org/ghcup/i386-linux-ghcup > ./ghcup-bin
 else
@@ -49,5 +45,3 @@ apk add --no-cache \
 	xz-dev \
 	ncurses-static

-ln -sf libncursesw.a /usr/lib/libtinfow.a
-
--- a/.gitlab/script/ghcup_version.sh
+++ b/.gitlab/script/ghcup_version.sh
@@ -44,6 +44,12 @@ ghcup-gen check -f ghcup-${JSON_VERSION}.json

 eghcup --numeric-version

+# TODO: rm once we have tarballs
+if [ "${OS}"  = "FREEBSD" ] ; then
+	GHC_VERSION=8.6.3
+	CABAL_VERSION=2.4.1.0
+fi
+
 eghcup install ${GHC_VERSION}
 eghcup set ${GHC_VERSION}
 eghcup install-cabal ${CABAL_VERSION}
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,10 +1,5 @@
 # Revision history for ghcup

-## 0.1.8 -- 2020-07-21
-
-* Fix bug in logging thread dying on newlines
-* Allow to install from arbitrary bindists: `ghcup -n install ghc -u '{"dlHash": "", "dlSubdir": "ghc-8.10.1", "dlUri": "https://github.com/commercialhaskell/ghc/releases/download/ghc-8.10.1-release/ghc-8.10.1-x86_64-deb9-linux.tar.xz"}' 8.10.1`
-
 ## 0.1.7 -- 2020-07-20

 * Fix a bug in libarchive not unpacking some uncleanly packed bindists
--- a/app/ghcup/Main.hs
+++ b/app/ghcup/Main.hs
@@ -38,7 +38,6 @@ import           Control.Monad.Fail             ( MonadFail )
 import           Control.Monad.Logger
 import           Control.Monad.Reader
 import           Control.Monad.Trans.Resource
-import           Data.Aeson                     ( eitherDecode )
 import           Data.Bifunctor
 import           Data.Char
 import           Data.Either
@@ -69,7 +68,6 @@ import           URI.ByteString

 import qualified Data.ByteString               as B
 import qualified Data.ByteString.UTF8          as UTF8
-import qualified Data.ByteString.Lazy.UTF8     as BLU
 import qualified Data.Text                     as T
 import qualified Data.Text.IO                  as T
 import qualified Data.Text.Encoding            as E
@@ -121,7 +119,6 @@ data InstallCommand = InstallGHC InstallOptions
 data InstallOptions = InstallOptions
  { instVer      :: Maybe ToolVersion
  , instPlatform :: Maybe PlatformRequest
-  , instBindist  :: Maybe DownloadInfo
  }

 data SetCommand = SetGHC SetOptions
@@ -408,7 +405,7 @@ installParser =

 installOpts :: Parser InstallOptions
 installOpts =
-  (\p u v -> InstallOptions v p u)
+  (flip InstallOptions)
    <$> (optional
          (option
            (eitherReader platformParser)
@@ -420,17 +417,6 @@ installOpts =
            )
          )
        )
-    <*> (optional
-          (option
-            (eitherReader bindistParser)
-            (  short 'u'
-            <> long "url"
-            <> metavar "BINDIST_URL"
-            <> help
-                 "Provide DownloadInfo as json string, e.g.: '{ \"dlHash\": \"<sha256 hash>\", \"dlSubdir\": \"ghc-<ver>\", \"dlUri\": \"<uri>\" }'"
-            )
-          )
-        )
    <*> optional toolVersionArgument


@@ -814,8 +800,6 @@ platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
        pure v


-bindistParser :: String -> Either String DownloadInfo
-bindistParser = eitherDecode . BLU.fromString


 toSettings :: Options -> Settings
@@ -1063,9 +1047,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
          let installGHC InstallOptions{..} =
                  (runInstTool $ do
                      v <- liftE $ fromVersion dls instVer GHC
-                      case instBindist of
-                        Nothing -> liftE $ installGHCBin dls (_tvVersion v) (fromMaybe pfreq instPlatform)
-                        Just uri -> liftE $ installGHCBindist uri (_tvVersion v) (fromMaybe pfreq instPlatform)
+                      liftE $ installGHCBin dls (_tvVersion v) (fromMaybe pfreq instPlatform) -- FIXME: ugly sharing of tool version
                    )
                    >>= \case
                          VRight _ -> do
@@ -1099,9 +1081,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
          let installCabal InstallOptions{..} =
                (runInstTool $ do
                    v <- liftE $ fromVersion dls instVer Cabal
-                    case instBindist of
-                      Nothing -> liftE $ installCabalBin dls (_tvVersion v) (fromMaybe pfreq instPlatform)
-                      Just uri -> liftE $ installCabalBindist uri (_tvVersion v) (fromMaybe pfreq instPlatform)
+                    liftE $ installCabalBin dls (_tvVersion v) (fromMaybe pfreq instPlatform) -- FIXME: ugly sharing of tool version
                  )
                  >>= \case
                        VRight _ -> do
--- a/ghcup-0.0.2.json
+++ b/ghcup-0.0.2.json
@@ -1898,13 +1898,6 @@
      "8.4.4": {
        "viArch": {
          "A_64": {
-            "Linux_Alpine": {
-              "unknown_versioning": {
-                "dlHash": "336affff8314d3dc5e85d9c09015ae2ba8a7658b459c8c8ae77ecaa551a56ae7",
-                "dlSubdir": "ghc-8.4.4",
-                "dlUri": "https://files.hasufell.de/ghc/ghc-8.4.4-x86_64-alpine-linux.tar.xz"
-              }
-            },
            "FreeBSD": {
              "unknown_versioning": {
                "dlHash": "44fbd142d1c355d6110595c59c760e2c73866ff9259ec85ebf814edb244d1940",
--- a/ghcup.cabal
+++ b/ghcup.cabal
@@ -1,6 +1,6 @@
 cabal-version:      3.0
 name:               ghcup
-version:            0.1.8
+version:            0.1.7
 synopsis:           ghc toolchain installer as an exe/library
 description:
  A rewrite of the shell script ghcup, for providing
@@ -341,7 +341,6 @@ executable ghcup
  import:
    config
    , base
-    , aeson
    , bytestring
    , containers
    , haskus-utils-variant
--- a/lib/GHCup.hs
+++ b/lib/GHCup.hs
@@ -77,7 +77,7 @@ import qualified Data.Text.Encoding            as E



-installGHCBindist :: ( MonadFail m
+installGHCBin :: ( MonadFail m
                 , MonadMask m
                 , MonadCatch m
                 , MonadReader Settings m
@@ -85,7 +85,7 @@ installGHCBindist :: ( MonadFail m
                 , MonadResource m
                 , MonadIO m
                 )
-              => DownloadInfo
+              => GHCupDownloads
              -> Version
              -> PlatformRequest
              -> Excepts
@@ -102,13 +102,14 @@ installGHCBindist :: ( MonadFail m
                    ]
                   m
                   ()
-installGHCBindist dlinfo ver (PlatformRequest {..}) = do
+installGHCBin bDls ver pfreq@(PlatformRequest {..}) = do
  let tver = (mkTVer ver)
  lift $ $(logDebug) [i|Requested to install GHC with #{ver}|]
  whenM (liftIO $ ghcInstalled tver)
    $ (throwE $ AlreadyInstalled GHC ver)

  -- download (or use cached version)
+  dlinfo                       <- lE $ getDownloadInfo GHC ver pfreq bDls
  dl                           <- liftE $ downloadCached dlinfo Nothing

  -- unpack
@@ -149,62 +150,32 @@ installGHCBindist dlinfo ver (PlatformRequest {..}) = do
    | otherwise = []


-installGHCBin :: ( MonadFail m
-                 , MonadMask m
-                 , MonadCatch m
-                 , MonadReader Settings m
-                 , MonadLogger m
-                 , MonadResource m
-                 , MonadIO m
-                 )
-              => GHCupDownloads
-              -> Version
-              -> PlatformRequest
-              -> Excepts
-                   '[ AlreadyInstalled
-                    , BuildFailed
-                    , DigestError
-                    , DownloadFailed
-                    , NoDownload
-                    , NotInstalled
-                    , UnknownArchive
+installCabalBin :: ( MonadMask m
+                   , MonadCatch m
+                   , MonadReader Settings m
+                   , MonadLogger m
+                   , MonadResource m
+                   , MonadIO m
+                   , MonadFail m
+                   )
+                => GHCupDownloads
+                -> Version
+                -> PlatformRequest
+                -> Excepts
+                     '[ AlreadyInstalled
+                      , CopyError
+                      , DigestError
+                      , DownloadFailed
+                      , NoDownload
+                      , NotInstalled
+                      , UnknownArchive
 #if !defined(TAR)
-                    , ArchiveResult
+                      , ArchiveResult
 #endif
-                    ]
-                   m
-                   ()
-installGHCBin bDls ver pfreq = do
-  dlinfo <- lE $ getDownloadInfo GHC ver pfreq bDls
-  installGHCBindist dlinfo ver pfreq
-
-
-installCabalBindist :: ( MonadMask m
-                       , MonadCatch m
-                       , MonadReader Settings m
-                       , MonadLogger m
-                       , MonadResource m
-                       , MonadIO m
-                       , MonadFail m
-                       )
-                    => DownloadInfo
-                    -> Version
-                    -> PlatformRequest
-                    -> Excepts
-                         '[ AlreadyInstalled
-                          , CopyError
-                          , DigestError
-                          , DownloadFailed
-                          , NoDownload
-                          , NotInstalled
-                          , UnknownArchive
-#if !defined(TAR)
-                          , ArchiveResult
-#endif
-                          ]
-                         m
-                         ()
-installCabalBindist dlinfo ver (PlatformRequest {..}) = do
+                      ]
+                     m
+                     ()
+installCabalBin bDls ver pfreq@(PlatformRequest {..}) = do
  lift $ $(logDebug) [i|Requested to install cabal version #{ver}|]

  bindir <- liftIO ghcupBinDir
@@ -219,6 +190,7 @@ installCabalBindist dlinfo ver (PlatformRequest {..}) = do
    $ (throwE $ AlreadyInstalled Cabal ver)

  -- download (or use cached version)
+  dlinfo                       <- lE $ getDownloadInfo Cabal ver pfreq bDls
  dl                           <- liftE $ downloadCached dlinfo Nothing

  -- unpack
@@ -255,37 +227,6 @@ installCabalBindist dlinfo ver (PlatformRequest {..}) = do
      Overwrite


-installCabalBin :: ( MonadMask m
-                   , MonadCatch m
-                   , MonadReader Settings m
-                   , MonadLogger m
-                   , MonadResource m
-                   , MonadIO m
-                   , MonadFail m
-                   )
-                => GHCupDownloads
-                -> Version
-                -> PlatformRequest
-                -> Excepts
-                     '[ AlreadyInstalled
-                      , CopyError
-                      , DigestError
-                      , DownloadFailed
-                      , NoDownload
-                      , NotInstalled
-                      , UnknownArchive
-#if !defined(TAR)
-                      , ArchiveResult
-#endif
-                      ]
-                     m
-                     ()
-installCabalBin bDls ver pfreq = do
-  dlinfo <- lE $ getDownloadInfo Cabal ver pfreq bDls
-  installCabalBindist dlinfo ver pfreq
-
-
-

    ---------------------
    --[ Set GHC/cabal ]--
--- a/lib/GHCup/Data/GHCupDownloads.hs
+++ b/lib/GHCup/Data/GHCupDownloads.hs
@@ -365,12 +365,6 @@ ghc_844_32_alpine = DownloadInfo
  (Just [rel|ghc-8.4.4|])
  "892888d388ef5c9cadf5cfba1146d62237c25b9b066fb62fee940b2b285fd308"

-ghc_844_64_alpine :: DownloadInfo
-ghc_844_64_alpine = DownloadInfo
-  [uri|https://files.hasufell.de/ghc/ghc-8.4.4-x86_64-alpine-linux.tar.xz|]
-  (Just [rel|ghc-8.4.4|])
-  "336affff8314d3dc5e85d9c09015ae2ba8a7658b459c8c8ae77ecaa551a56ae7"
-


    -----------------
@@ -866,9 +860,9 @@ ghc_8101_32_alpine = DownloadInfo

 ghc_8101_64_freebsd :: DownloadInfo
 ghc_8101_64_freebsd = DownloadInfo
-  [uri|https://files.hasufell.de/ghc/ghc-8.10.1-x86_64-portbld-freebsd.tar.xz|]
+  [uri|https://downloads.haskell.org/ghc/8.10.1/ghc-8.10.1-x86_64-portbld-freebsd.tar.xz|]
  (Just [rel|ghc-8.10.1|])
-  "e8646ec9b60fd40aa9505ee055f22f04601290ab7a1342c2cf37c34de9d3f142"
+  "52d27dbf9de82005dde9bfc521bff612e381b5228af194259c2306d2b75825c2"



@@ -1358,7 +1352,6 @@ ghcupDownloads = M.fromList
                    )
                  , (Darwin      , M.fromList [(Nothing, ghc_844_64_darwin)])
                  , (FreeBSD     , M.fromList [(Nothing, ghc_844_64_freebsd)])
-                  , (Linux Alpine, M.fromList [(Nothing, ghc_844_64_alpine)])
                  ]
                )
              , ( A_32
--- a/lib/GHCup/Utils/File.hs
+++ b/lib/GHCup/Utils/File.hs
@@ -10,7 +10,6 @@ import           GHCup.Utils.Prelude
 import           GHCup.Types

 import           Control.Concurrent
-import           Control.Concurrent.Async
 import           Control.Exception              ( evaluate )
 import           Control.Exception.Safe
 import           Control.Monad
@@ -58,6 +57,14 @@ import qualified "unix-bytestring" System.Posix.IO.ByteString



+
+-- | Bool signals whether the regions should be cleaned.
+data StopThread = StopThread Bool
+  deriving Show
+
+instance Exception StopThread
+
+
 data ProcessError = NonZeroExit Int ByteString [ByteString]
                  | PTerminated ByteString [ByteString]
                  | PStopped ByteString [ByteString]
@@ -124,9 +131,10 @@ execLogged exe spath args lfile chdir env = do
      pState <- newEmptyMVar
      done   <- newEmptyMVar
      void
-        $ forkIO
+        $ forkOS
+        $ EX.handle (\(_ :: StopThread) -> pure ())
        $ EX.handle (\(_ :: IOException) -> pure ())
-        $ flip EX.finally (putMVar done ())
+        $ flip finally (putMVar done ())
        $ (if verbose
            then tee fd stdoutRead
            else printToRegion fd stdoutRead 6 pState
@@ -149,7 +157,7 @@ execLogged exe spath args lfile chdir env = do
      e <- toProcessError exe args <$!> SPPB.getProcessStatus True True pid
      putMVar pState (either (const False) (const True) e)

-      void $ race (takeMVar done) (threadDelay (1000000 * 3))
+      takeMVar done
      closeFd stdoutRead

      pure e
@@ -217,41 +225,33 @@ execLogged exe spath args lfile chdir env = do
      | BS.length bs > w && w > 5 -> BS.take (w - 4) bs <> "..."
      | otherwise                 -> bs

-  -- Consecutively read from Fd in 512 chunks until we hit
-  -- newline or EOF.
-  readLine :: MonadIO m
-           => Fd          -- ^ input file descriptor
-           -> ByteString  -- ^ rest buffer (read across newline)
-           -> m (ByteString, ByteString, Bool) -- ^ (full line, rest, eof)
-  readLine fd = \inBs -> go inBs
+  -- read an entire line from the file descriptor (removes the newline char)
+  readLine :: MonadIO m => Fd -> ByteString -> m (ByteString, ByteString)
+  readLine fd = go
   where
    go inBs = do
-      -- if buffer is not empty, process it first
-      mbs <- if BS.length inBs == 0
-               -- otherwise attempt read
-               then liftIO
-                    $ handleIO (\e -> if isEOFError e then pure Nothing else ioError e)
-                    $ fmap Just
-                    $ SPIB.fdRead fd 512
-               else pure $ Just inBs
-      case mbs of
-        Nothing -> pure ("", "", True)
-        Just bs -> do
-          -- split on newline
-          let (line, rest) = BS.span (/= _lf) bs
-          if
-            | BS.length rest /= 0 -> pure (line, BS.tail rest, False)
-            -- if rest is empty, then there was no newline, process further
-            | otherwise           -> (\(l, r, b) -> (line <> l, r, b)) <$!> go mempty
+      bs <-
+        liftIO
+        $ handleIO (\e -> if isEOFError e then pure "" else ioError e)
+        $ SPIB.fdRead fd 512
+      let nbs          = BS.append inBs bs
+          (line, rest) = BS.span (/= _lf) nbs
+      if
+        | BS.length rest /= 0 -> pure (line, BS.tail rest)
+        | BS.length line == 0 -> pure (mempty, mempty)
+        | otherwise           -> (\(l, r) -> (line <> l, r)) <$!> go mempty

  readTilEOF :: MonadIO m => (ByteString -> m a) -> Fd -> m ()
  readTilEOF ~action' fd' = go mempty
   where
    go bs' = do
-      (bs, rest, eof) <- readLine fd' bs'
-      if eof
-         then liftIO $ ioError (mkIOError eofErrorType "" Nothing Nothing)
-         else (void $ action' bs) >> go rest
+      (bs, rest) <- readLine fd' bs'
+      if
+        | BS.length bs == 0 -> liftIO
+        $ ioError (mkIOError eofErrorType "" Nothing Nothing)
+        | otherwise -> do
+          void $ action' bs
+          go rest


 -- | Capture the stdout and stderr of the given action, which
@@ -288,12 +288,13 @@ captureOutStreams action = do
      done   <- newEmptyMVar
      _      <-
        forkIO
+        $ EX.handle (\(_ :: StopThread) -> pure ())
        $ EX.handle (\(_ :: IOException) -> pure ())
-        $ flip EX.finally (putMVar done ())
+        $ flip finally (putMVar done ())
        $ writeStds parentStdoutRead parentStderrRead refOut refErr

      status <- SPPB.getProcessStatus True True pid
-      void $ race (takeMVar done) (threadDelay (1000000 * 3))
+      takeMVar done

      case status of
        -- readFd will take care of closing the fd
@@ -313,13 +314,13 @@ captureOutStreams action = do
    void
      $ forkIO
      $ hideError eofErrorType
-      $ flip EX.finally (putMVar doneOut ())
+      $ flip finally (putMVar doneOut ())
      $ readTilEOF (\x -> modifyIORef' rout (<> x)) pout
    doneErr <- newEmptyMVar
    void
      $ forkIO
      $ hideError eofErrorType
-      $ flip EX.finally (putMVar doneErr ())
+      $ flip finally (putMVar doneErr ())
      $ readTilEOF (\x -> modifyIORef' rerr (<> x)) perr
    takeMVar doneOut
    takeMVar doneErr
--- a/lib/GHCup/Version.hs
+++ b/lib/GHCup/Version.hs
@@ -16,7 +16,7 @@ ghcupURL :: URI
 ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.2.json|]

 ghcUpVer :: PVP
-ghcUpVer = [pver|0.1.8|]
+ghcUpVer = [pver|0.1.7|]

 numericVer :: String
 numericVer = T.unpack . prettyPVP $ ghcUpVer