Windows support

This hopefull fixes nix packaging.

.gitlab/before_script/darwin/install_deps.sh

@@ -10,8 +10,8 @@ curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-apple-darwin-ghcup > ./gh
 chmod +x ghcup-bin
 
 ./ghcup-bin upgrade -i -f
-./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml install ${GHC_VERSION}
+./ghcup-bin install ${GHC_VERSION}
-./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml set ${GHC_VERSION}
+./ghcup-bin set ${GHC_VERSION}
-./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml install-cabal ${CABAL_VERSION}
+./ghcup-bin install-cabal ${CABAL_VERSION}
 
 exit 0

.gitlab/before_script/freebsd/install_deps.sh

@@ -12,8 +12,8 @@ curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-portbld-freebsd-ghcup > .
 chmod +x ghcup-bin
 
 ./ghcup-bin upgrade -i -f
-./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml install ${GHC_VERSION}
+./ghcup-bin install ${GHC_VERSION}
-./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml set ${GHC_VERSION}
+./ghcup-bin set ${GHC_VERSION}
-./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml install-cabal ${CABAL_VERSION}
+./ghcup-bin install-cabal ${CABAL_VERSION}
 
 exit 0

.gitlab/before_script/linux/alpine/install_deps.sh

@@ -28,8 +28,8 @@ else
 fi
 chmod +x ghcup-bin
 ./ghcup-bin upgrade -i -f
-./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml install ${GHC_VERSION}
+./ghcup-bin install ${GHC_VERSION}
-./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml install-cabal ${CABAL_VERSION}
+./ghcup-bin install-cabal ${CABAL_VERSION}
 
 # utils
 apk add --no-cache \
@@ -41,6 +41,9 @@ apk add --no-cache \
 	zlib \
 	zlib-dev \
 	zlib-static \
+	bzip2 \
+	bzip2-dev \
+	bzip2-static \
 	gmp \
 	gmp-dev \
 	openssl-dev \

.gitlab/before_script/linux/install_deps.sh

@@ -7,13 +7,13 @@ set -eux
 mkdir -p "${TMPDIR}"
 
 sudo apt-get update -y
-sudo apt-get install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev git wget
+sudo apt-get install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget
 
 curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-linux-ghcup > ./ghcup-bin
 chmod +x ghcup-bin
 
 ./ghcup-bin upgrade -i -f
-./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml install ${GHC_VERSION}
+./ghcup-bin install ${GHC_VERSION}
-./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml set ${GHC_VERSION}
+./ghcup-bin set ${GHC_VERSION}
-./ghcup-bin -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml install-cabal ${CABAL_VERSION}
+./ghcup-bin install-cabal ${CABAL_VERSION}
 

.gitlab/before_script/linux/install_deps_manual.sh

@@ -19,7 +19,7 @@ ednf() {
 }
 
 ednf update
-ednf install gcc gcc-c++ gmp gmp-devel make ncurses ncurses-devel xz xz-devel perl zlib zlib-devel openssl-devel openssl-libs openssl libffi libffi-devel lbzip2 lbzip2-utils
+ednf install gcc gcc-c++ gmp gmp-devel make ncurses ncurses-devel xz xz-devel perl zlib zlib-devel openssl-devel openssl-libs openssl libffi libffi-devel lbzip2 lbzip2-utils bzip2-devel
 if [ "${ARCH}" = "ARM64" ] ; then
 	ednf install numactl numactl-libs numactl-devel
 fi

.gitlab/before_script/linux/install_deps_minimal.sh

@@ -7,4 +7,4 @@ set -eux
 mkdir -p "${TMPDIR}"
 
 sudo apt-get update -y
-sudo apt-get install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev git wget
+sudo apt-get install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget

.gitlab/script/ghcup_version.sh

@@ -7,11 +7,11 @@ set -eux
 mkdir -p "$CI_PROJECT_DIR"/.local/bin
 
 ecabal() {
-	cabal --store-dir="$(pwd)"/.store "$@"
+	cabal --store-dir="$CI_PROJECT_DIR"/.store "$@"
 }
 
 eghcup() {
-	ghcup -v -c -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml "$@"
+	ghcup -v -c -s file://$CI_PROJECT_DIR/ghcup-${JSON_VERSION}.yaml "$@"
 }
 
 git describe --always
@@ -96,14 +96,19 @@ eghcup set ${GHC_VERSION}
 eghcup rm 8.10.3
 [ "$(ghc --numeric-version)" = "${ghc_ver}" ]
 
-# install hls
 if [ "${OS}" = "DARWIN" ] ; then
 	eghcup install hls
 	haskell-language-server-wrapper --version
+
+	eghcup install stack
+	stack --version
 elif [ "${OS}" = "LINUX" ] ; then
 	if [ "${ARCH}" = "64" ] ; then
 		eghcup install hls
 		haskell-language-server-wrapper --version
+
+		eghcup install stack
+		stack --version
 	fi
 fi
 
@@ -111,8 +116,12 @@ fi
 eghcup rm $(ghc --numeric-version)
 
 # https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/116
-eghcup install cabal -u https://oleg.fi/cabal-install-3.4.0.0-rc4/cabal-install-3.4.0.0-x86_64-ubuntu-16.04.tar.xz 3.4.0.0-rc4
+if [ "${OS}" = "LINUX" ] ; then
-eghcup rm cabal 3.4.0.0-rc4
+	if [ "${ARCH}" = "64" ] ; then
+		eghcup install cabal -u https://oleg.fi/cabal-install-3.4.0.0-rc4/cabal-install-3.4.0.0-x86_64-ubuntu-16.04.tar.xz 3.4.0.0-rc4
+		eghcup rm cabal 3.4.0.0-rc4
+	fi
+fi
 
 eghcup upgrade
 eghcup upgrade -f

CHANGELOG.md

@@ -1,5 +1,16 @@
 # Revision history for ghcup
 
+## 0.1.15 -- ????-??-??
+
+* Add date to GHC bindist names created by ghcup
+* Warn when /tmp doesn't have 5GB or more of disk space
+* Allow to compile GHC from git repo wrt [#126](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/126)
+* Add stack support
+
+## 0.1.14.2 -- 2021-05-12
+
+* Remove dead dependency on ascii-string
+
 ## 0.1.14.1 -- 2021-04-11
 
 * Make internal symlink target parser more lax, fixes [#119](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/119)

HACKING.md

@@ -6,10 +6,6 @@
 
 This is an open variant, similar to [plucky](https://hackage.haskell.org/package/plucky) or [oops](https://github.com/i-am-tom/oops) and allows us to combine different error types. Maybe it is too much and it's a little bit [unergonomic](https://github.com/haskus/packages/issues/32) at times. If it really hurts maintenance, it will be removed. It was more of an experiment.
 
-### No use of filepath or directory
-
-Filepath and directory have two fundamental problems: 1. they use String as filepath (see [AFPP](https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/abstract-file-path) as to why this is wrong) and 2. they try very hard to be cross-platform at the expense of low-level correctness. Instead, we use the [hpath](https://github.com/hasufell/hpath) libraries for file and filepath related stuff, which also gives us stronger filepath types.
-
 ### No use of haskell-TLS
 
 I consider haskell-TLS an interesting experiment, but not a battle-tested and peer-reviewed crypto implementation. There is little to no research about what the intricacies of using haskell for low-level crypto are and how vulnerable such binaries are. Instead, we use either curl the binary (for FreeBSD and mac) or http-io-streams, which works with OpenSSL bindings.

README.md

@@ -4,8 +4,6 @@ It follows the unix UNIX philosophy of [do one thing and do it well](https://en.
 
 Similar in scope to [rustup](https://github.com/rust-lang-nursery/rustup.rs), [pyenv](https://github.com/pyenv/pyenv) and [jenv](http://www.jenv.be).
 
-*Ubuntu users may prefer [hvr's ppa](https://launchpad.net/~hvr/+archive/ubuntu/ghc).*
-
 ## Table of Contents
 
    * [Installation](#installation)
@@ -79,7 +77,7 @@ ghcup install cabal
 ghcup upgrade
 ```
 
-Generally this is meant to be used with [`cabal-install`](https://hackage.haskell.org/package/cabal-install), which
+GHCup works very well with [`cabal-install`](https://hackage.haskell.org/package/cabal-install), which
 handles your haskell packages and can demand that [a specific version](https://cabal.readthedocs.io/en/latest/nix-local-build.html#cfg-flag---with-compiler)  of `ghc` is available, which `ghcup` can do.
 
 ### Configuration
@@ -236,8 +234,8 @@ ghcup is not a reimplementation of stack. The only common part is automatic inst
 
 2. Why not support windows?
 
-Consider using [Chocolatey](https://chocolatey.org/search?q=ghc) or [ghcups](https://github.com/kakkun61/ghcups).
+We do.
 
 3. Why the haskell reimplementation?
 
-Why not?
+:-)

app/ghcup-gen/Validate.hs

@@ -37,12 +37,11 @@ import           Data.IORef
 import           Data.List
 import           Data.String.Interpolate
 import           Data.Versions
-import           HPath                          ( toFilePath, rel )
 import           Haskus.Utils.Variant.Excepts
 import           Optics
+import           System.FilePath
 import           System.Exit
 import           System.IO
-import           System.Posix.FilePath
 import           Text.ParserCombinators.ReadP
 import           Text.PrettyPrint.HughesPJClass ( prettyShow )
 import           Text.Regex.Posix
@@ -106,6 +105,10 @@ validate dls = do
       addError
     when ((notElem FreeBSD pspecs) && arch == A_64) $ lift $ $(logWarn)
       [i|FreeBSD missing for #{t} #{v'} #{arch'}|]
+    when (notElem Windows pspecs && arch == A_64) $ do
+      lift $ $(logError)
+        [i|Windows missing for for #{t} #{v'} #{arch'}|]
+      addError
 
     -- alpine needs to be set explicitly, because
     -- we cannot assume that "Linux UnknownLinux" runs on Alpine
@@ -238,7 +241,7 @@ validateTarballs (TarballFilter tool versionRegex) dls = do
       $ do
         case tool of
           Just GHCup -> do
-            let fn = [rel|ghcup|]
+            let fn = "ghcup"
             dir <- liftIO ghcupCacheDir
             p <- liftE $ download dli dir (Just fn)
             liftE $ checkDigest dli p
@@ -252,7 +255,7 @@ validateTarballs (TarballFilter tool versionRegex) dls = do
     case r of
       VRight (Just basePath) -> do
         case _dlSubdir dli of
-          Just (RealDir (toFilePath -> prel)) -> do
+          Just (RealDir prel) -> do
             lift $ $(logInfo)
               [i|verifying subdir: #{prel}|]
             when (basePath /= prel) $ do

app/ghcup/BrickMain.hs

@@ -14,6 +14,7 @@ import           GHCup.Download
 import           GHCup.Errors
 import           GHCup.Types
 import           GHCup.Utils
+import           GHCup.Utils.Prelude ( decUTF8Safe )
 import           GHCup.Utils.File
 import           GHCup.Utils.Logger
 
@@ -66,7 +67,8 @@ data BrickData = BrickData
   deriving Show
 
 data BrickSettings = BrickSettings
-  { showAll :: Bool
+  { showAllVersions :: Bool
+  , showAllTools    :: Bool
   }
   deriving Show
 
@@ -97,17 +99,22 @@ keyHandlers KeyBindings {..} =
   , (bUninstall, const "Uninstall", withIOAction del')
   , (bSet, const "Set"      , withIOAction set')
   , (bChangelog, const "ChangeLog", withIOAction changelog')
-  , ( bShowAll
+  , ( bShowAllVersions
     , \BrickSettings {..} ->
-       if showAll then "Hide old versions" else "Show all versions"
+       if showAllVersions then "Don't show all versions" else "Show all versions"
-    , hideShowHandler
+    , hideShowHandler (not . showAllVersions) showAllTools
+    )
+  , ( bShowAllTools
+    , \BrickSettings {..} ->
+       if showAllTools then "Don't show all tools" else "Show all tools"
+    , hideShowHandler showAllVersions (not . showAllTools)
     )
   , (bUp, const "Up", \BrickState {..} -> continue BrickState{ appState = moveCursor 1 appState Up, .. })
   , (bDown, const "Down", \BrickState {..} -> continue BrickState{ appState = moveCursor 1 appState Down, .. })
   ]
  where
-  hideShowHandler BrickState{..} =
+  hideShowHandler f p BrickState{..} =
-    let newAppSettings   = appSettings { showAll = not . showAll $ appSettings }
+    let newAppSettings   = appSettings { showAllVersions = f appSettings , showAllTools = p appSettings }
         newInternalState = constructList appData newAppSettings (Just appState)
     in  continue (BrickState appData newAppSettings newInternalState appKeys)
 
@@ -142,7 +149,12 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
       <+> minHSize 15 (str "Version")
       <+> padLeft (Pad 1) (minHSize 25 $ str "Tags")
       <+> padLeft (Pad 5) (str "Notes")
-  renderList' = withDefAttr listAttr . drawListElements renderItem True
+  renderList' = withDefAttr listAttr . drawListElements renderItem True . filterStack
+  filterStack appState'
+    | showAllTools as = appState'
+    | let v = clr appState'
+          nv = V.filter (\ListResult{..} -> lTool /= Stack) v
+    , otherwise = BrickInternalState { clr = nv, ix = ix appState' }
   renderItem _ b listResult@ListResult{..} =
     let marks = if
           | lSet       -> (withAttr "set" $ str "✔✔")
@@ -194,6 +206,7 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
   printTool GHC = str "GHC"
   printTool GHCup = str "GHCup"
   printTool HLS = str "HLS"
+  printTool Stack = str "Stack"
 
   printNotes ListResult {..} =
     (if hlsPowered then [withAttr "hls-powered" $ str "hls-powered"] else mempty
@@ -351,7 +364,7 @@ constructList :: BrickData
               -> Maybe BrickInternalState
               -> BrickInternalState
 constructList appD appSettings =
-  replaceLR (filterVisible (showAll appSettings)) (lr appD)
+  replaceLR (filterVisible (showAllVersions appSettings)) (lr appD)
 
 listSelectedElement' :: BrickInternalState -> Maybe (Int, ListResult)
 listSelectedElement' BrickInternalState{..} = fmap (ix, ) $ clr !? ix
@@ -385,9 +398,9 @@ replaceLR filterF lr s =
 
 
 filterVisible :: Bool -> ListResult -> Bool
-filterVisible showAll e | lInstalled e = True
+filterVisible showAllVersions e | lInstalled e = True
-                        | showAll      = True
+                                | showAllVersions = True
-                        | otherwise    = not (elem Old (lTag e))
+                                | otherwise    = not (elem Old (lTag e))
 
 
 install' :: BrickState -> (Int, ListResult) -> IO (Either String ())
@@ -432,6 +445,9 @@ install' BrickState { appData = BrickData {..} } (_, ListResult {..}) = do
         HLS   -> do
           let vi = getVersionInfo lVer HLS dls
           liftE $ installHLSBin dls lVer pfreq $> vi
+        Stack -> do
+          let vi = getVersionInfo lVer Stack dls
+          liftE $ installStackBin dls lVer pfreq $> vi
     )
     >>= \case
           VRight vi                         -> do
@@ -460,6 +476,7 @@ set' _ (_, ListResult {..}) = do
         GHC   -> liftE $ setGHC (GHCTargetVersion lCross lVer) SetGHCOnly $> ()
         Cabal -> liftE $ setCabal lVer $> ()
         HLS   -> liftE $ setHLS lVer $> ()
+        Stack -> liftE $ setStack lVer $> ()
         GHCup -> pure ()
     )
     >>= \case
@@ -481,6 +498,7 @@ del' BrickState { appData = BrickData {..} } (_, ListResult {..}) = do
         GHC   -> liftE $ rmGHCVer (GHCTargetVersion lCross lVer) $> vi
         Cabal -> liftE $ rmCabalVer lVer $> vi
         HLS   -> liftE $ rmHLSVer lVer $> vi
+        Stack -> liftE $ rmStackVer lVer $> vi
         GHCup -> pure Nothing
     )
     >>= \case
@@ -501,7 +519,8 @@ changelog' BrickState { appData = BrickData {..} } (_, ListResult {..}) = do
             Darwin  -> "open"
             Linux _ -> "xdg-open"
             FreeBSD -> "xdg-open"
-      exec cmd True [serializeURIRef' uri] Nothing Nothing >>= \case
+            Windows -> "start"
+      exec cmd [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing >>= \case
         Right _ -> pure $ Right ()
         Left  e -> pure $ Left $ prettyShow e
 
@@ -564,7 +583,7 @@ brickMain s l av pfreq' = do
 
 
 defaultAppSettings :: BrickSettings
-defaultAppSettings = BrickSettings { showAll = False }
+defaultAppSettings = BrickSettings { showAllVersions = False, showAllTools = False }
 
 
 getDownloads' :: IO (Either String GHCupDownloads)

app/ghcup/Main.hs

@@ -53,8 +53,6 @@ import           Data.Versions           hiding ( str )
 import           Data.Void
 import           GHC.IO.Encoding
 import           Haskus.Utils.Variant.Excepts
-import           HPath
-import           HPath.IO
 import           Language.Haskell.TH
 import           Options.Applicative     hiding ( style )
 import           Options.Applicative.Help.Pretty ( text )
@@ -64,6 +62,7 @@ import           System.Console.Pretty   hiding ( color )
 import qualified System.Console.Pretty         as Pretty
 import           System.Environment
 import           System.Exit
+import           System.FilePath
 import           System.IO               hiding ( appendFile )
 import           Text.Read               hiding ( lift )
 import           Text.PrettyPrint.HughesPJClass ( prettyShow )
@@ -126,6 +125,7 @@ toSetToolVer Nothing = SetRecommended
 data InstallCommand = InstallGHC InstallOptions
                     | InstallCabal InstallOptions
                     | InstallHLS InstallOptions
+                    | InstallStack InstallOptions
 
 data InstallOptions = InstallOptions
   { instVer      :: Maybe ToolVersion
@@ -137,6 +137,7 @@ data InstallOptions = InstallOptions
 data SetCommand = SetGHC SetOptions
                 | SetCabal SetOptions
                 | SetHLS SetOptions
+                | SetStack SetOptions
 
 -- a superset of ToolVersion
 data SetToolVersion = SetToolVersion GHCTargetVersion
@@ -157,6 +158,7 @@ data ListOptions = ListOptions
 data RmCommand = RmGHC RmOptions
                | RmCabal Version
                | RmHLS Version
+               | RmStack Version
 
 data RmOptions = RmOptions
   { ghcVer :: GHCTargetVersion
@@ -165,28 +167,19 @@ data RmOptions = RmOptions
 
 data CompileCommand = CompileGHC GHCCompileOptions
 
-
 data GHCCompileOptions = GHCCompileOptions
-  { targetVer    :: Version
+  { targetGhc    :: Either Version GitBranch
-  , bootstrapGhc :: Either Version (Path Abs)
+  , bootstrapGhc :: Either Version FilePath
   , jobs         :: Maybe Int
-  , buildConfig  :: Maybe (Path Abs)
+  , buildConfig  :: Maybe FilePath
-  , patchDir     :: Maybe (Path Abs)
+  , patchDir     :: Maybe FilePath
   , crossTarget  :: Maybe Text
   , addConfArgs  :: [Text]
   , setCompile   :: Bool
   }
 
-data CabalCompileOptions = CabalCompileOptions
-  { targetVer    :: Version
-  , bootstrapGhc :: Either Version (Path Abs)
-  , jobs         :: Maybe Int
-  , buildConfig  :: Maybe (Path Abs)
-  , patchDir     :: Maybe (Path Abs)
-  }
-
 data UpgradeOpts = UpgradeInplace
-                 | UpgradeAt (Path Abs)
+                 | UpgradeAt FilePath
                  | UpgradeGHCupDir
                  deriving Show
 
@@ -441,6 +434,15 @@ installParser =
                  <> footerDoc (Just $ text installHLSFooter)
                  )
            )
+      <> command
+           "stack"
+           (   InstallStack
+           <$> info
+                 (installOpts (Just Stack) <**> helper)
+                 (  progDesc "Install stack"
+                 <> footerDoc (Just $ text installStackFooter)
+                 )
+           )
       )
     )
     <|> (Right <$> installOpts Nothing)
@@ -451,9 +453,17 @@ installParser =
   into "~/.ghcup/bin"
 
 Examples:
-  # install recommended GHC
+  # install recommended HLS
   ghcup install hls|]
 
+  installStackFooter :: String
+  installStackFooter = [s|Discussion:
+  Installs stack binaries into "~/.ghcup/bin"
+
+Examples:
+  # install recommended Stack
+  ghcup install stack|]
+
   installGHCFooter :: String
   installGHCFooter = [s|Discussion:
   Installs the specified GHC version (or a recommended default one) into
@@ -537,6 +547,15 @@ setParser =
                  <> footerDoc (Just $ text setHLSFooter)
                  )
            )
+      <> command
+           "stack"
+           (   SetStack
+           <$> info
+                 (setOpts (Just Stack) <**> helper)
+                 (  progDesc "Set stack version"
+                 <> footerDoc (Just $ text setStackFooter)
+                 )
+           )
       )
     )
     <|> (Right <$> setOpts Nothing)
@@ -551,6 +570,10 @@ setParser =
   setCabalFooter = [s|Discussion:
     Sets the the current Cabal version.|]
 
+  setStackFooter :: String
+  setStackFooter = [s|Discussion:
+    Sets the the current Stack version.|]
+
   setHLSFooter :: String
   setHLSFooter = [s|Discussion:
     Sets the the current haskell-language-server version.|]
@@ -603,6 +626,12 @@ rmParser =
            <$> info (versionParser' (Just ListInstalled) (Just HLS) <**> helper)
                     (progDesc "Remove haskell-language-server version")
            )
+      <> command
+           "stack"
+           (   RmStack
+           <$> info (versionParser' (Just ListInstalled) (Just Stack) <**> helper)
+                    (progDesc "Remove stack version")
+           )
       )
     )
     <|> (Right <$> rmOpts Nothing)
@@ -624,6 +653,7 @@ changelogP =
                 "ghc"   -> Right GHC
                 "cabal" -> Right Cabal
                 "ghcup" -> Right GHCup
+                "stack" -> Right Stack
                 e       -> Left e
               )
             )
@@ -659,7 +689,10 @@ ENV variables:
   such as: CC, LD, OBJDUMP, NM, AR, RANLIB.
 
 Examples:
+  # compile from known version
   ghcup compile ghc -j 4 -v 8.4.2 -b 8.2.2
+  # compile from git commit/reference
+  ghcup compile ghc -j 4 -g master -b 8.2.2
   # specify path to bootstrap ghc
   ghcup compile ghc -j 4 -v 8.4.2 -b /usr/bin/ghc-8.2.2
   # build cross compiler
@@ -668,39 +701,26 @@ Examples:
 
 ghcCompileOpts :: Parser GHCCompileOptions
 ghcCompileOpts =
-  (\CabalCompileOptions {..} crossTarget addConfArgs setCompile -> GHCCompileOptions { .. }
+  GHCCompileOptions
-    )
+    <$> ((Left <$> option
-    <$> cabalCompileOpts
-    <*> optional
-          (option
-            str
-            (short 'x' <> long "cross-target" <> metavar "CROSS_TARGET" <> help
-              "Build cross-compiler for this platform"
-            )
-          )
-    <*> many (argument str (metavar "CONFIGURE_ARGS" <> help "Additional arguments to configure, prefix with '-- ' (longopts)"))
-    <*> flag
-          False
-          True
-          (long "set" <> help
-            "Set as active version after install"
-          )
-
-cabalCompileOpts :: Parser CabalCompileOptions
-cabalCompileOpts =
-  CabalCompileOptions
-    <$> option
           (eitherReader
             (first (const "Not a valid version") . version . T.pack)
           )
           (short 'v' <> long "version" <> metavar "VERSION" <> help
             "The tool version to compile"
           )
+          ) <|>
+          (Right <$> (GitBranch <$> option
+          str
+          (short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help
+            "The git commit/branch/ref to build from"
+          ) <*>
+          optional (option str (short 'r' <> long "repository" <> metavar "GIT_REPOSITORY" <> help "The git repository to build from (defaults to GHC upstream)"))
+          )))
     <*> option
           (eitherReader
             (\x ->
-              (bimap (const "Not a valid version") Left . version . T.pack $ x)
+              (bimap (const "Not a valid version") Left . version . T.pack $ x) <|> (if isPathSeparator (head x) then pure $ Right x else Left "Not an absolute Path")
-                <|> (bimap show Right . parseAbs . E.encodeUtf8 . T.pack $ x)
             )
           )
           (  short 'b'
@@ -718,30 +738,32 @@ cabalCompileOpts =
           )
     <*> optional
           (option
-            (eitherReader
+            str
-              (\x ->
-                first show . parseAbs . E.encodeUtf8 . T.pack $ x :: Either
-                    String
-                    (Path Abs)
-              )
-            )
             (short 'c' <> long "config" <> metavar "CONFIG" <> help
               "Absolute path to build config file"
             )
           )
     <*> optional
           (option
-            (eitherReader
+            str
-              (\x ->
-                first show . parseAbs . E.encodeUtf8 . T.pack $ x :: Either
-                    String
-                    (Path Abs)
-              )
-            )
             (short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help
               "Absolute path to patch directory (applied in order, uses -p1)"
             )
           )
+    <*> optional
+          (option
+            str
+            (short 'x' <> long "cross-target" <> metavar "CROSS_TARGET" <> help
+              "Build cross-compiler for this platform"
+            )
+          )
+    <*> many (argument str (metavar "CONFIGURE_ARGS" <> help "Additional arguments to configure, prefix with '-- ' (longopts)"))
+    <*> flag
+          False
+          True
+          (long "set" <> help
+            "Set as active version after install"
+          )
 
 
 toolVersionParser :: Parser ToolVersion
@@ -990,7 +1012,8 @@ toSettings options = do
          , bUninstall = fromMaybe bUninstall kUninstall
          , bSet = fromMaybe bSet kSet
          , bChangelog = fromMaybe bChangelog kChangelog
-         , bShowAll = fromMaybe bShowAll kShowAll
+         , bShowAllVersions = fromMaybe bShowAllVersions kShowAll
+         , bShowAllTools = fromMaybe bShowAllTools kShowAllTools
          }
 
 
@@ -1003,13 +1026,7 @@ upgradeOptsP =
       )
     <|> (   UpgradeAt
         <$> option
-              (eitherReader
+              str
-                (\x ->
-                  first show . parseAbs . E.encodeUtf8 . T.pack $ x :: Either
-                      String
-                      (Path Abs)
-                )
-              )
               (short 't' <> long "target" <> metavar "TARGET_DIR" <> help
                 "Absolute filepath to write ghcup into"
               )
@@ -1021,9 +1038,9 @@ upgradeOptsP =
 describe_result :: String
 describe_result = $( LitE . StringL <$>
                      runIO (do
-                             CapturedProcess{..} <- executeOut [rel|git|] ["describe"] Nothing
+                             CapturedProcess{..} <- executeOut "git" ["describe"] Nothing
                              case _exitCode of
-                               ExitSuccess   -> pure . T.unpack . decUTF8Safe $ _stdOut
+                               ExitSuccess   -> pure . T.unpack . decUTF8Safe' $ _stdOut
                                ExitFailure _ -> pure numericVer
                      )
                    )
@@ -1073,11 +1090,11 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
           createDirRecursive' baseDir
 
           -- logger interpreter
-          logfile <- flip runReaderT appstate $ initGHCupFileLogging [rel|ghcup.log|]
+          logfile <- flip runReaderT appstate $ initGHCupFileLogging
           let loggerConfig = LoggerConfig
                 { lcPrintDebug = verbose settings
                 , colorOutter  = B.hPut stderr
-                , rawOutter    = appendFile logfile
+                , rawOutter    = B.appendFile logfile
                 }
           let runLogger = myLoggerT loggerConfig
 
@@ -1329,6 +1346,36 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                             $(logError) [i|Also check the logs in #{logsDir}|]
                           pure $ ExitFailure 4
 
+          let installStack InstallOptions{..} =
+                (case instBindist of
+                   Nothing -> runInstTool $ do
+                     (v, vi) <- liftE $ fromVersion dls instVer Stack
+                     liftE $ installStackBin dls (_tvVersion v) (fromMaybe pfreq instPlatform)
+                     pure vi
+                   Just uri -> runInstTool' appstate{ settings = settings { noVerify = True}} $ do
+                     (v, vi) <- liftE $ fromVersion dls instVer Stack
+                     liftE $ installStackBindist
+                         (DownloadInfo uri Nothing "")
+                         (_tvVersion v)
+                         (fromMaybe pfreq instPlatform)
+                     pure vi
+                  )
+                  >>= \case
+                        VRight vi -> do
+                          runLogger $ $(logInfo) "Stack installation successful"
+                          forM_ (_viPostInstall =<< vi) $ \msg ->
+                            runLogger $ $(logInfo) msg
+                          pure ExitSuccess
+                        VLeft (V (AlreadyInstalled _ v)) -> do
+                          runLogger $ $(logWarn)
+                            [i|Stack ver #{prettyVer v} already installed; if you really want to reinstall it, you may want to run 'ghcup rm stack #{prettyVer v}' first|]
+                          pure ExitSuccess
+                        VLeft e -> do
+                          runLogger $ do
+                            $(logError) $ T.pack $ prettyShow e
+                            $(logError) [i|Also check the logs in #{logsDir}|]
+                          pure $ ExitFailure 4
+
 
           let setGHC' SetOptions{..} =
                 runSetGHC (do
@@ -1377,6 +1424,22 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                           runLogger $ $(logError) $ T.pack $ prettyShow e
                           pure $ ExitFailure 14
 
+          let setStack' SetOptions{..} =
+                runSetCabal (do
+                    v <- liftE $ fst <$> fromVersion' dls sToolVer Stack
+                    liftE $ setStack (_tvVersion v)
+                    pure v
+                  )
+                  >>= \case
+                        VRight GHCTargetVersion{..} -> do
+                          runLogger
+                            $ $(logInfo)
+                                [i|Stack #{prettyVer _tvVersion} successfully set as default version|]
+                          pure ExitSuccess
+                        VLeft  e -> do
+                          runLogger $ $(logError) $ T.pack $ prettyShow e
+                          pure $ ExitFailure 14
+
           let rmGHC' RmOptions{..} =
                 runRm (do
                     liftE $
@@ -1422,6 +1485,20 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                           runLogger $ $(logError) $ T.pack $ prettyShow e
                           pure $ ExitFailure 15
 
+          let rmStack' tv =
+                runRm (do
+                    liftE $
+                      rmStackVer tv
+                    pure (getVersionInfo tv Stack dls)
+                  )
+                  >>= \case
+                        VRight vi -> do
+                          forM_ (_viPostRemove =<< vi) $ \msg ->
+                            runLogger $ $(logInfo) msg
+                          pure ExitSuccess
+                        VLeft  e -> do
+                          runLogger $ $(logError) $ T.pack $ prettyShow e
+                          pure $ ExitFailure 15
 
           res <- case optCommand of
 #if defined(BRICK)
@@ -1433,6 +1510,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
             Install (Left (InstallGHC iopts)) -> installGHC iopts
             Install (Left (InstallCabal iopts)) -> installCabal iopts
             Install (Left (InstallHLS iopts)) -> installHLS iopts
+            Install (Left (InstallStack iopts)) -> installStack iopts
             InstallCabalLegacy iopts -> do
               runLogger ($(logWarn) [i|This is an old-style command for installing cabal. Use 'ghcup install cabal' instead.|])
               installCabal iopts
@@ -1443,6 +1521,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
             Set (Left (SetGHC sopts)) -> setGHC' sopts
             Set (Left (SetCabal sopts)) -> setCabal' sopts
             Set (Left (SetHLS sopts)) -> setHLS' sopts
+            Set (Left (SetStack sopts)) -> setStack' sopts
 
             List ListOptions {..} ->
               runListGHC (do
@@ -1457,6 +1536,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
             Rm (Left (RmGHC rmopts)) -> rmGHC' rmopts
             Rm (Left (RmCabal rmopts)) -> rmCabal' rmopts
             Rm (Left (RmHLS rmopts)) -> rmHLS' rmopts
+            Rm (Left (RmStack rmopts)) -> rmStack' rmopts
 
             DInfo ->
               do runDebugInfo $ liftE getDebugInfo
@@ -1470,22 +1550,26 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
 
             Compile (CompileGHC GHCCompileOptions {..}) ->
               runCompileGHC (do
-                let vi = getVersionInfo targetVer GHC dls
+                case targetGhc of
-                forM_ (_viPreCompile =<< vi) $ \msg -> do
+                  Left targetVer -> do
-                  lift $ $(logInfo) msg
+                    let vi = getVersionInfo targetVer GHC dls
-                  lift $ $(logInfo)
+                    forM_ (_viPreCompile =<< vi) $ \msg -> do
-                    "...waiting for 5 seconds, you can still abort..."
+                      lift $ $(logInfo) msg
-                  liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
+                      lift $ $(logInfo)
-                liftE $ compileGHC dls
+                        "...waiting for 5 seconds, you can still abort..."
-                            (GHCTargetVersion crossTarget targetVer)
+                      liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
+                  Right _ -> pure ()
+                targetVer <- liftE $ compileGHC dls
+                            (first (GHCTargetVersion crossTarget) targetGhc)
                             bootstrapGhc
                             jobs
                             buildConfig
                             patchDir
                             addConfArgs
                             pfreq
+                let vi = getVersionInfo (_tvVersion targetVer) GHC dls
                 when setCompile $ void $ liftE $
-                  setGHC (GHCTargetVersion crossTarget targetVer) SetGHCOnly
+                  setGHC targetVer SetGHCOnly
                 pure vi
                 )
                 >>= \case
@@ -1512,12 +1596,9 @@ Make sure to clean up #{tmpdir} afterwards.|])
 
             Upgrade uOpts force -> do
               target <- case uOpts of
-                UpgradeInplace -> do
+                UpgradeInplace  -> Just <$> liftIO getExecutablePath
-                  efp <- liftIO getExecutablePath
-                  p   <- parseAbs . E.encodeUtf8 . T.pack $ efp
-                  pure $ Just p
                 (UpgradeAt p)   -> pure $ Just p
-                UpgradeGHCupDir -> pure (Just (binDir </> [rel|ghcup|]))
+                UpgradeGHCupDir -> pure (Just (binDir </> "ghcup"))
 
               runUpgrade (liftE $ upgradeGHCup dls target force pfreq) >>= \case
                 VRight v' -> do
@@ -1573,12 +1654,12 @@ Make sure to clean up #{tmpdir} afterwards.|])
                               Darwin  -> "open"
                               Linux _ -> "xdg-open"
                               FreeBSD -> "xdg-open"
+                              Windows -> "start"
 
                   if clOpen
                     then
                       exec cmd
-                           True
+                           [T.unpack $ decUTF8Safe $ serializeURIRef' uri]
-                           [serializeURIRef' uri]
                            Nothing
                            Nothing
                         >>= \case
@@ -1654,6 +1735,16 @@ fromVersion' av SetNext tool = do
         . cycle
         . sort
         $ hlses) ?? NoToolVersionSet tool
+    Stack -> do
+      set <- stackSet !? NoToolVersionSet tool
+      stacks <- rights <$> lift getInstalledStacks
+      (fmap (GHCTargetVersion Nothing)
+        . headMay
+        . tail
+        . dropWhile (/= set)
+        . cycle
+        . sort
+        $ stacks) ?? NoToolVersionSet tool
     GHCup -> fail "GHCup cannot be set"
   let vi = getVersionInfo (_tvVersion next) tool av
   pure (next, vi)
@@ -1852,14 +1943,21 @@ checkForUpdates dls pfreq = do
         $ $(logWarn)
             [i|New HLS version available: #{prettyVer l}. To upgrade, run 'ghcup install hls #{prettyVer l}'|]
 
+  forM_ (getLatest dls Stack) $ \(l, _) -> do
+    let mstack_ver = latestInstalled Stack
+    forM mstack_ver $ \stack_ver ->
+      when (l > stack_ver)
+        $ $(logWarn)
+            [i|New Stack version available: #{prettyVer l}. To upgrade, run 'ghcup install stack #{prettyVer l}'|]
+
 
 prettyDebugInfo :: DebugInfo -> String
 prettyDebugInfo DebugInfo {..} = [i|Debug Info
 ==========
-GHCup base dir: #{toFilePath diBaseDir}
+GHCup base dir: #{diBaseDir}
-GHCup bin dir: #{toFilePath diBinDir}
+GHCup bin dir: #{diBinDir}
-GHCup GHC directory: #{toFilePath diGHCDir}
+GHCup GHC directory: #{diGHCDir}
-GHCup cache directory: #{toFilePath diCacheDir}
+GHCup cache directory: #{diCacheDir}
 Architecture: #{prettyShow diArch}
 Platform: #{prettyShow diPlatform}
 Version: #{describe_result}|]

cabal.project

@@ -10,6 +10,11 @@ package ghcup
     tests: True
     flags: +tui
 
+source-repository-package
+    type: git
+    location: https://github.com/Bodigrim/tar
+    tag: ac197ec7ea4838dc2b4e22b9b888b080cedf29cf
+
 constraints: http-io-streams -brotli
 
 package libarchive

config.yaml

@@ -29,6 +29,8 @@ key-bindings:
     KChar: 'c'
   show-all:
     KChar: 'a'
+  show-all-tools:
+    KChar: 't'
 
 # Where to get GHC/cabal/hls download info/versions from. For more detailed explanation
 # check the 'URLSource' type in the code.

ghcup-0.0.4.yaml

@@ -170,6 +170,11 @@ ghcupDownloads:
               dlUri: https://downloads.haskell.org/~ghc/7.10.3/ghc-7.10.3-x86_64-portbld-freebsd.tar.bz2
               dlSubdir: ghc-7.10.3
               dlHash: 2aa396edd2bb651f4bc7eef7a396913ea24923de5aafdc76df6295333e487e48
+          Windows:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/~ghc/7.10.3/ghc-7.10.3-x86_64-unknown-mingw32.tar.xz
+              dlSubdir: ghc-7.10.3
+              dlHash: 63e1689fc9e2809ae4d7f422b4dc810052e54c9aa2afd08746e234180e711dde
         A_32:
           Linux_Debian:
             unknown_versioning: &ghc-7103-32-deb8
@@ -236,6 +241,11 @@ ghcupDownloads:
               dlUri: https://downloads.haskell.org/~ghc/8.0.2/ghc-8.0.2-x86_64-portbld-freebsd.tar.xz
               dlSubdir: ghc-8.0.2
               dlHash: b36a20e5cae24d70bbb6116ae486f21811e9384f15d3892d260f02fba3e3bb8c
+          Windows:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/~ghc/8.0.2/ghc-8.0.2-x86_64-unknown-mingw32.tar.xz
+              dlSubdir: ghc-8.0.2
+              dlHash: 8c42c1f4af995205b9816a1e97e2752fe758544c1f5fe77958cdcd319c9c2d53
         A_32:
           Linux_Debian:
             '( >= 7 && < 8 )':
@@ -300,6 +310,11 @@ ghcupDownloads:
               dlSubdir: ghc-8.2.2
               dlHash: cd351c704b92b9af23994024df07de8ca7090ea7675d5c8b14b2be857a46d804
             unknown_versioning: *ghc-822-64-fbsd11
+          Windows:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/~ghc/8.2.2/ghc-8.2.2-x86_64-unknown-mingw32.tar.xz
+              dlSubdir: ghc-8.2.2
+              dlHash: 1e033df2092aa546e763e7be63167720b32df64f76673ea1ce7ae7c9f564b223
         A_32:
           Linux_Debian:
             '( >= 7 && < 8 )':
@@ -359,6 +374,11 @@ ghcupDownloads:
               dlUri: https://downloads.haskell.org/~ghc/8.4.1/ghc-8.4.1-x86_64-portbld11-freebsd.tar.xz
               dlSubdir: ghc-8.4.1
               dlHash: e748daec098445c6190090fe32bb2817a1140553be5acd2188e1af05ad24e5aa
+          Windows:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/~ghc/8.4.1/ghc-8.4.1-x86_64-unknown-mingw32.tar.xz
+              dlSubdir: ghc-8.4.1
+              dlHash: 328b013fc651d34e075019107e58bb6c8a578f0155cf3ad4557e6f2661b03131
         A_32:
           Linux_Debian:
             unknown_versioning: &ghc-841-32-deb8
@@ -414,6 +434,11 @@ ghcupDownloads:
               dlUri: https://downloads.haskell.org/~ghc/8.4.2/ghc-8.4.2-x86_64-portbld-freebsd.tar.xz
               dlSubdir: ghc-8.4.2
               dlHash: e9ed417fdf94c2ff2c6e344ed16f332bf6b591511f6442c0d9ea94854882b66c
+          Windows:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/~ghc/8.4.2/ghc-8.4.2-x86_64-unknown-mingw32.tar.xz
+              dlSubdir: ghc-8.4.2
+              dlHash: 797634aa9812fc6b2084a24ddb4fde44fa83a2f59daea82e0af81ca3dd323fde
         A_32:
           Linux_Debian:
             unknown_versioning: &ghc-842-32-deb8
@@ -464,6 +489,11 @@ ghcupDownloads:
               dlUri: https://downloads.haskell.org/~ghc/8.4.3/ghc-8.4.3-x86_64-apple-darwin.tar.xz
               dlSubdir: ghc-8.4.3
               dlHash: af0b455f6c46b9802b4b48dad996619cfa27cc6e2bf2ce5532387b4a8c00aa64
+          Windows:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/~ghc/8.4.3/ghc-8.4.3-x86_64-unknown-mingw32.tar.xz
+              dlSubdir: ghc-8.4.3
+              dlHash: 8a83cfbf9ae84de0443c39c93b931693bdf2a6d4bf163ffb41855f80f4bf883e
         A_32:
           Linux_Debian:
             unknown_versioning: &ghc-843-32-deb8
@@ -532,6 +562,11 @@ ghcupDownloads:
               dlUri: https://downloads.haskell.org/~ghc/8.4.4/ghc-8.4.4-x86_64-portbld-freebsd11.tar.xz
               dlSubdir: ghc-8.4.4
               dlHash: 44fbd142d1c355d6110595c59c760e2c73866ff9259ec85ebf814edb244d1940
+          Windows:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/~ghc/8.4.4/ghc-8.4.4-x86_64-unknown-mingw32.tar.xz
+              dlSubdir: ghc-8.4.4
+              dlHash: da29dbb0f1199611c7d5bb7b0dd6a7426ca98f67dfd6da1526b033cd3830dc05
         A_32:
           Linux_Debian:
             unknown_versioning: &ghc-844-32-deb8
@@ -592,6 +627,11 @@ ghcupDownloads:
               dlUri: https://downloads.haskell.org/~ghc/8.6.1/ghc-8.6.1-x86_64-portbld-freebsd.tar.xz
               dlSubdir: ghc-8.6.1
               dlHash: 51403b054a3a649039ac988e1d1112561f96750bfced63df864091a3fab36f08
+          Windows:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/~ghc/8.6.1/ghc-8.6.1-x86_64-unknown-mingw32.tar.xz
+              dlSubdir: ghc-8.6.1
+              dlHash: 7316d9cb5e486460476754f872c7bac30ee2082e42f46da4342f872d10b88099
         A_32:
           Linux_Debian:
             unknown_versioning: &ghc-861-32-deb8
@@ -638,6 +678,11 @@ ghcupDownloads:
               dlUri: https://downloads.haskell.org/~ghc/8.6.2/ghc-8.6.2-x86_64-apple-darwin.tar.xz
               dlSubdir: ghc-8.6.2
               dlHash: 8ec46a25872226dd7e5cf7271e3f3450c05f32144b96e6b9cb44cc4079db50dc
+          Windows:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/~ghc/8.6.2/ghc-8.6.2-x86_64-unknown-mingw32.tar.xz
+              dlSubdir: ghc-8.6.2
+              dlHash: 9a398e133cab09ff2610834337355d4e26c35e0665403fb9ff8db79315f74d3d
         A_32:
           Linux_Debian:
             unknown_versioning: &ghc-862-32-deb8
@@ -702,6 +747,11 @@ ghcupDownloads:
               dlUri: https://downloads.haskell.org/~ghc/8.6.3/ghc-8.6.3-x86_64-portbld-freebsd.tar.xz
               dlSubdir: ghc-8.6.3
               dlHash: bc2419fa180f8a7808c49775987866435995df9bdd9ce08bcd38352d63ba6031
+          Windows:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/~ghc/8.6.3/ghc-8.6.3-x86_64-unknown-mingw32.tar.xz
+              dlSubdir: ghc-8.6.3
+              dlHash: 2fec383904e5fa79413e9afd328faf9bc700006c8c3d4bcdd8d4f2ccf0f7fa2a
         A_32:
           Linux_Debian:
             unknown_versioning: &ghc-863-32-deb8
@@ -752,6 +802,11 @@ ghcupDownloads:
               dlUri: https://downloads.haskell.org/~ghc/8.6.4/ghc-8.6.4-x86_64-apple-darwin.tar.xz
               dlSubdir: ghc-8.6.4
               dlHash: cccb58f142fe41b601d73690809f6089f7715b6a50a09aa3d0104176ab4db09e
+          Windows:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/~ghc/8.6.4/ghc-8.6.4-x86_64-unknown-mingw32.tar.xz
+              dlSubdir: ghc-8.6.4
+              dlHash: e8d021b7a90772fc559862079da20538498d991956d7557b468ca19ddda22a08
         A_32:
           Linux_Debian:
             unknown_versioning: &ghc-864-32-deb9
@@ -820,6 +875,11 @@ ghcupDownloads:
               dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/ghc/8.6.5/ghc-8.6.5-x86_64-portbld-freebsd.tar.xz
               dlSubdir: ghc-8.6.5
               dlHash: 83a3059a630d40a98e26cb5b520354e12094a96e36ba2f5ab002dad94cf2fb37
+          Windows:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/~ghc/8.6.5/ghc-8.6.5-x86_64-unknown-mingw32.tar.xz
+              dlSubdir: ghc-8.6.5
+              dlHash: 457024c6ea43bdce340af428d86319931f267089398b859b00efdfe2fd4ce93f
         A_32:
           Linux_Debian:
             unknown_versioning: &ghc-865-32-deb9
@@ -890,6 +950,11 @@ ghcupDownloads:
               dlUri: https://downloads.haskell.org/~ghc/8.8.1/ghc-8.8.1-x86_64-apple-darwin.tar.xz
               dlSubdir: ghc-8.8.1
               dlHash: 38c8917b47c31bedf58c9305dfca3abe198d8d35570366f0773c4e2948bd8abe
+          Windows:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/~ghc/8.8.1/ghc-8.8.1-x86_64-unknown-mingw32.tar.xz
+              dlSubdir: ghc-8.8.1
+              dlHash: 29e56e6af38017a5a76b2b6995a39d3988fa58131e4b55b62dd317ba7186ac9b
         A_32:
           Linux_Debian:
             unknown_versioning: &ghc-881-32-deb9
@@ -949,6 +1014,11 @@ ghcupDownloads:
               dlUri: https://downloads.haskell.org/~ghc/8.8.2/ghc-8.8.2-x86_64-apple-darwin.tar.xz
               dlSubdir: ghc-8.8.2
               dlHash: 25c5c1a70036abf3f22b2b19c10d26adfdb08e8f8574f89d4b2042de5947f990
+          Windows:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/~ghc/8.8.2/ghc-8.8.2-x86_64-unknown-mingw32.tar.xz
+              dlSubdir: ghc-8.8.2
+              dlHash: e25d9b16ee62cafc7387af2cd021eea676a99cd2c32b83533b016162c63065d9
         A_32:
           Linux_Debian:
             unknown_versioning: &ghc-882-32-deb9
@@ -1013,6 +1083,11 @@ ghcupDownloads:
               dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/ghc/8.8.3/ghc-8.8.3-x86_64-portbld-freebsd.tar.xz
               dlSubdir: ghc-8.8.3
               dlHash: 569719075b4d14b3875a899df522090ae31e6fe085e6dffe518e875b09a2f0be
+          Windows:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/~ghc/8.8.3/ghc-8.8.3-x86_64-unknown-mingw32.tar.xz
+              dlSubdir: ghc-8.8.3
+              dlHash: e22586762af0911c06e8140f1792e3ca381a3a482a20d67b9054883038b3a422
         A_32:
           Linux_Debian:
             unknown_versioning: &ghc-883-32-deb9
@@ -1087,6 +1162,11 @@ ghcupDownloads:
               dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/ghc/8.8.4/ghc-8.8.4-x86_64-portbld-freebsd.tar.xz
               dlSubdir: ghc-8.8.4
               dlHash: 8cebe5ccf454e82acd1ff52ca57590d1ab0f3f44a981b46257ec12158c8c447e
+          Windows:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/~ghc/8.8.4/ghc-8.8.4-x86_64-unknown-mingw32.tar.xz
+              dlSubdir: ghc-8.8.4
+              dlHash: d185055d2c8dc3bfe5b88afd59d6877eb1e722b672d1c9649f18296e148ed71f
         A_32:
           Linux_Debian:
             unknown_versioning: &ghc-884-32-deb9
@@ -1164,6 +1244,11 @@ ghcupDownloads:
               dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/ghc/8.10.1/ghc-8.10.1-x86_64-portbld-freebsd.tar.xz
               dlSubdir: ghc-8.10.1
               dlHash: e8646ec9b60fd40aa9505ee055f22f04601290ab7a1342c2cf37c34de9d3f142
+          Windows:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/~ghc/8.10.1/ghc-8.10.1-x86_64-unknown-mingw32.tar.xz
+              dlSubdir: ghc-8.10.1
+              dlHash: 38a3166ea50cccd5bae7e1680eae3aae2b4ae31b61f82a1d8168fb821f43bd67
         A_32:
           Linux_Debian:
             '( >= 9 && < 10 )': &ghc-8101-32-deb9
@@ -1254,6 +1339,11 @@ ghcupDownloads:
               dlUri: https://downloads.haskell.org/~ghc/8.10.2/ghc-8.10.2-x86_64-unknown-freebsd.tar.xz
               dlSubdir: ghc-8.10.2
               dlHash: 9e5957f3497f4b58ecd3699568d9caaa11a47a6d7e902032c261e450fa0f6686
+          Windows:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/~ghc/8.10.2/ghc-8.10.2-x86_64-unknown-mingw32.tar.xz
+              dlSubdir: ghc-8.10.2
+              dlHash: dcae4c173b9896e07ff048de5509aa0a4537233150e06e5ce8848303dfadc176
         A_32:
           Linux_Debian:
             '( >= 9 && < 10 )': &ghc-8102-32-deb9
@@ -1343,6 +1433,11 @@ ghcupDownloads:
               dlUri: https://downloads.haskell.org/~ghc/8.10.3/ghc-8.10.3-x86_64-portbld-freebsd.tar.xz
               dlSubdir: ghc-8.10.3
               dlHash: 749007e995104db05cf6e3ad5bc36238cab8afac8055145661e5730e8f8af040
+          Windows:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/~ghc/8.10.3/ghc-8.10.3-x86_64-unknown-mingw32.tar.xz
+              dlSubdir: ghc-8.10.3
+              dlHash: 927a6c699533a115cd49772ef2c753d9af2c13bf9f0b2d3bd13645cc6a144ee3
         A_32:
           Linux_Debian:
             '( >= 9 && < 10 )': &ghc-8103-32-deb9
@@ -1434,6 +1529,11 @@ ghcupDownloads:
               dlUri: https://downloads.haskell.org/~ghc/8.10.4/ghc-8.10.4-x86_64-portbld-freebsd.tar.xz
               dlSubdir: ghc-8.10.4
               dlHash: c9776a2ccf9629b03e967206a507fcdcb6c5189800a626e9461ababf6733c357
+          Windows:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/~ghc/8.10.4/ghc-8.10.4-x86_64-unknown-mingw32.tar.xz
+              dlSubdir: ghc-8.10.4
+              dlHash: e9175a276504c3390a5e0084954e6997d56078737dbe7158049518892cf6bfb2
         A_32:
           Linux_Debian:
             '( >= 9 && < 10 )': &ghc-8104-32-deb9
@@ -1524,6 +1624,11 @@ ghcupDownloads:
               dlUri: https://downloads.haskell.org/~ghc/9.0.1/ghc-9.0.1-x86_64-portbld-freebsd.tar.xz
               dlSubdir: ghc-9.0.1
               dlHash: 9dbc06d8832cae5c9f86dd7b2db729b3748a47beb4fd4b1e62bb66119817c3c1
+          Windows:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/~ghc/9.0.1/ghc-9.0.1-x86_64-unknown-mingw32.tar.xz
+              dlSubdir: ghc-9.0.1-x86_64-unknown-mingw32
+              dlHash: 4f4ab118df01cbc7e7c510096deca0cb25025339a97730de0466416296202493
         A_32:
           Linux_Debian:
             '( >= 9 && < 10 )': &ghc-901-32-deb9
@@ -1614,6 +1719,11 @@ ghcupDownloads:
               dlUri: https://downloads.haskell.org/~ghc/9.2.1-alpha2/ghc-9.2.0.20210422-x86_64-apple-darwin.tar.xz
               dlSubdir: ghc-9.2.0.20210422
               dlHash: 8884c059f2b76e4c4309ff6bd7a7dde37663f751fd26220e9a2bcabb4d69a401
+          Windows:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/~ghc/9.2.1-alpha2/ghc-9.2.0.20210422-x86_64-unknown-mingw32.tar.xz
+              dlSubdir: ghc-9.0.1-x86_64-unknown-mingw32
+              dlHash: 33f173b754d18f26bb27f52bb77a92fd22a48675daa2b43a1879bf01dddd7e8f
         A_32:
           Linux_Debian:
             '( >= 9 && < 10 )': &ghc-921-alpha2-32-deb9
@@ -1666,6 +1776,11 @@ ghcupDownloads:
               dlUri: https://downloads.haskell.org/~cabal/cabal-install-2.4.1.0/cabal-install-2.4.1.0-x86_64-portbld-freebsd.tar.xz
               dlSubdir:
               dlHash: 33b7d37ea0688c93436eac9ec139d9967687875aa1fa13f2bb73bf05a9a59a1d
+          Windows:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/~cabal/cabal-install-2.4.1.0/cabal-install-2.4.1.0-x86_64-unknown-mingw32.zip
+              dlSubdir:
+              dlHash: 95f233efedb1ebf0e6db015fa2f55c1ed00b9938d207ec63c066f706fb4b6373
         A_32:
           Linux_UnknownLinux:
             unknown_versioning:
@@ -1694,6 +1809,11 @@ ghcupDownloads:
             unknown_versioning:
               dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.0.0.0/cabal-install-3.0.0.0-x86_64-portbld-freebsd.tar.xz
               dlHash: 2240842ab2ae7b955feb8b526aba1c7991248c803383107adf39990441294d2a
+          Windows:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.0.0.0/cabal-install-3.0.0.0-x86_64-unknown-mingw32.zip
+              dlSubdir:
+              dlHash: 8889963ebef5e829d86329fdb59832c107efd117cf7862a605f2fe2d2360de1f
         A_32:
           Linux_Alpine:
             unknown_versioning:
@@ -1725,6 +1845,11 @@ ghcupDownloads:
             unknown_versioning:
               dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.2.0.0/cabal-install-3.2.0.0-x86_64-portbld-freebsd.tar.xz
               dlHash: f1e35151cca91541b0fb4bdb3ed18f3c348038eab751845ad19c11307d66c273
+          Windows:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.2.0.0/cabal-install-3.2.0.0-x86_64-unknown-mingw32.zip
+              dlSubdir:
+              dlHash: 17778c3ade0482bc37f451eec326f8fce8fbe1f12b1d6aacb2e2b9e34786c054
         A_32:
           Linux_Alpine:
             unknown_versioning:
@@ -1759,15 +1884,18 @@ ghcupDownloads:
             unknown_versioning:
               dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.4.0.0/cabal-install-3.4.0.0-x86_64-freebsd-12.1-release.tar.xz
               dlHash: a1e2db664ec00e42a1e071a4181f6476f6e0bad321f1ddc0cf27831119f4c6d4
+          Windows:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.4.0.0/cabal-install-3.4.0.0-x86_64-windows.zip
+              dlSubdir:
+              dlHash: 860fff2d39a82d1dc0ca924a77164d0988af49c2c5f45e15d615144122beb647
         A_32:
           Linux_UnknownLinux:
-            unknown_versioning:
+            unknown_versioning: &cabal-3400-32
-              dlUri: https://downloads.haskell.org/~cabal/cabal-install-3.4.0.0/cabal-install-3.4.0.0-i386-debian-9.tar.xz
+              dlUri: https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/3.4.0.0/cabal-install-3.4.0.0-i386-unknown-linux.tar.xz
-              dlHash: ef3750644a53f7b1fad141b2ad02d4c7a3b239ec0cbfa7f0528fb02c1dfcebce
+              dlHash: cc62a471e9e68a6a9933e54f75bf0cffae67a1d2220df1152ab887c38eb6bc8a
           Linux_Alpine:
-            unknown_versioning:
+            unknown_versioning: *cabal-3400-32
-              dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/cabal/3.4.0.0/cabal-install-3.4.0.0-i386-alpine-linux-musl.tar.gz
-              dlHash: 95adb65f3a72aa8d9ce83685bc06e1eee5b801f56e204e27e957e8a35abd9cf8
         A_ARM64:
           Linux_UnknownLinux:
             unknown_versioning:
@@ -1799,6 +1927,10 @@ ghcupDownloads:
             unknown_versioning:
               dlUri: https://downloads.haskell.org/~ghcup/0.1.14.1/x86_64-portbld-freebsd-ghcup-0.1.14.1
               dlHash: 89a70980d77888dae8b9fd0f05e7a7920f421bc3bb5192da8e73fd4e7b4cb86f
+          Windows:
+            unknown_versioning:
+              dlUri: https://TODO
+              dlHash: 89a70980d77888dae8b9fd0f05e7a7920f421bc3bb5192da8e73fd4e7b4cb86f
           Linux_Alpine:
             unknown_versioning: *ghcup-64
         A_32:
@@ -1835,5 +1967,63 @@ ghcupDownloads:
             unknown_versioning:
               dlUri: https://github.com/haskell/haskell-language-server/releases/download/1.1.0/haskell-language-server-macOS-1.1.0.tar.gz
               dlHash: 4e89b192e2f49637d772e974f2c17b16da067ecd5912575eaa542551de97681b
+          Windows:
+            unknown_versioning:
+              dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/hls/1.1.0/haskell-language-server-Windows-1.1.0.tar.gz
+              dlHash: a1d3f451e64a041aa527a25da29e4716a2de6ae347cef4ef9312fc7611e168cc
           Linux_Alpine:
             unknown_versioning: *hls-64
+  Stack:
+    2.5.1:
+      viTags: []
+      viChangeLog: https://github.com/commercialhaskell/stack/blob/master/ChangeLog.md#v251
+      viArch:
+        A_64:
+          Linux_UnknownLinux:
+            unknown_versioning: &stack-251-64
+              dlUri: https://github.com/commercialhaskell/stack/releases/download/v2.5.1/stack-2.5.1-linux-x86_64.tar.gz
+              dlHash: c83b6c93d6541c0bce2175085a04062020f4160a86116e20f3b343b562f2d1e8
+              dlSubdir:
+                RegexDir: "stack-.*"
+          Darwin:
+            unknown_versioning:
+              dlUri: https://github.com/commercialhaskell/stack/releases/download/v2.5.1/stack-2.5.1-osx-x86_64.tar.gz
+              dlHash: f4aedfa8fbe371f77286ee97ec5c3c553842e7ae15b2952a8b8442dccba04bf0
+              dlSubdir:
+                RegexDir: "stack-.*"
+          Windows:
+            unknown_versioning:
+              dlUri: https://github.com/commercialhaskell/stack/releases/download/v2.5.1/stack-2.5.1-windows-x86_64.tar.gz
+              dlHash: 57150b422cfd42249f5e629d0eb678df6d95dabe486ced57e8298d300b940d41
+              dlSubdir:
+                RegexDir: "stack-.*"
+          Linux_Alpine:
+            unknown_versioning: *stack-251-64
+    2.7.1:
+      viTags:
+        - Recommended
+        - Latest
+      viChangeLog: https://github.com/commercialhaskell/stack/blob/master/ChangeLog.md#v271
+      viArch:
+        A_64:
+          Linux_UnknownLinux:
+            unknown_versioning: &stack-64
+              dlUri: https://github.com/commercialhaskell/stack/releases/download/v2.7.1/stack-2.7.1-linux-x86_64.tar.gz
+              dlHash: 2bc47749ee4be5eccb52a2d4a6a00b0f3b28b92517742b40c675836d7db2777d
+              dlSubdir:
+                RegexDir: "stack-.*"
+          Darwin:
+            unknown_versioning:
+              dlUri: https://github.com/commercialhaskell/stack/releases/download/v2.7.1/stack-2.7.1-osx-x86_64.tar.gz
+              dlHash: 4248c6fbc87e8a2c06f39e867eb5ef28eae0d99470137cb415356c631c0dcbf2
+              dlSubdir:
+                RegexDir: "stack-.*"
+          Windows:
+            unknown_versioning:
+              dlUri: https://github.com/commercialhaskell/stack/releases/download/v2.7.1/stack-2.7.1-windows-x86_64.tar.gz
+              dlHash: 8452f5fc9235620a84863f2f68e5f681c72d0d181cde50482f178a966ee0ceb9
+              dlSubdir:
+                RegexDir: "stack-.*"
+          Linux_Alpine:
+            unknown_versioning: *stack-64
+

ghcup.cabal

@@ -1,6 +1,6 @@
 cabal-version:   3.0
 name:            ghcup
-version:         0.1.14.1
+version:         0.1.14.2
 license:         LGPL-3.0-only
 license-file:    LICENSE
 copyright:       Julian Ospald 2020
@@ -28,19 +28,23 @@ source-repository head
   location: https://gitlab.haskell.org/haskell/ghcup-hs.git
 
 flag tui
-  description: Build the brick powered tui (ghcup tui)
+  description:
+    Build the brick powered tui (ghcup tui). This is disabled on windows.
+
   default:     False
   manual:      True
 
 flag internal-downloader
   description:
-    Compile the internal downloader, which links against OpenSSL
+    Compile the internal downloader, which links against OpenSSL. This is disabled on windows.
 
   default:     False
   manual:      True
 
 flag tar
-  description: Use tar-bytestring instead of libarchive
+  description:
+    Use tar-bytestring instead of libarchive. This is always enabled on windows.
+
   default:     False
   manual:      True
 
@@ -58,6 +62,7 @@ library
     GHCup.Utils
     GHCup.Utils.Dirs
     GHCup.Utils.File
+    GHCup.Utils.File.Common
     GHCup.Utils.Logger
     GHCup.Utils.MegaParsec
     GHCup.Utils.Prelude
@@ -85,27 +90,24 @@ library
 
   build-depends:
     , aeson                 >=1.4        && <1.6
-    , ascii-string          ^>=1.0
     , async                 >=0.8        && <2.3
     , base                  >=4.13       && <5
     , base16-bytestring     >=0.1.1.6    && <1.1
     , binary                ^>=0.8.6.0
     , bytestring            ^>=0.10
-    , bz2                   >=0.5.0.5    && <1.1
     , case-insensitive      ^>=1.2.1.0
     , casing                ^>=0.1.4.1
     , concurrent-output     ^>=1.10.11
     , containers            ^>=0.6
     , cryptohash-sha256     ^>=0.11.101.0
+    , deepseq               ^>=1.4.4.0
+    , directory             ^>=1.3.6.0
     , disk-free-space       ^>=0.1.0.1
+    , extra                 ^>=1.7.9
+    , filepath              ^>=1.4.2.1
     , generics-sop          ^>=0.5
     , haskus-utils-types    ^>=1.5
     , haskus-utils-variant  >=3.0        && <3.2
-    , hpath                 >=0.11       && <0.13
-    , hpath-directory       ^>=0.14.1
-    , hpath-filepath        ^>=0.10.3
-    , hpath-io              ^>=0.14.1
-    , hpath-posix           ^>=0.13.2
     , lzma-static           ^>=5.2.5.2
     , megaparsec            >=8.0.0      && <9.1
     , monad-logger          ^>=0.3.31
@@ -116,6 +118,7 @@ library
     , parsec                ^>=3.1
     , pretty                ^>=1.1.3.1
     , pretty-terminal       ^>=0.1.0.0
+    , process               ^>=1.6.9.0
     , regex-posix           ^>=0.96
     , resourcet             ^>=1.2.2
     , safe                  ^>=0.3.18
@@ -123,27 +126,25 @@ library
     , split                 ^>=0.2.3.4
     , streamly              ^>=0.7.3
     , streamly-bytestring   ^>=0.1.2
-    , streamly-posix        ^>=0.1.0.0
     , strict-base           ^>=0.4
     , string-interpolate    >=0.2.0.0    && <0.4
     , template-haskell      >=2.7        && <2.17
+    , temporary             ^>=1.3
     , text                  ^>=1.2.4.0
     , time                  ^>=1.9.3
     , transformers          ^>=0.5
-    , unix                  ^>=2.7
-    , unix-bytestring       ^>=0.3
     , unliftio-core         ^>=0.2.0.1
     , unordered-containers  ^>=0.2.10.0
     , uri-bytestring        ^>=0.3.2.2
     , utf8-string           ^>=1.0
     , vector                ^>=0.12
     , versions              ^>=4.0.1
-    , vty                   >=5.28.2     && <5.34
     , word8                 ^>=0.1.3
     , yaml                  ^>=0.11.4.0
+    , zip                   ^>=1.7.0
     , zlib                  ^>=0.6.2.2
 
-  if flag(internal-downloader)
+  if (flag(internal-downloader) && !os(windows))
     exposed-modules: GHCup.Download.IOStreams
     cpp-options:     -DINTERNAL_DOWNLOADER
     build-depends:
@@ -152,13 +153,31 @@ library
       , io-streams             >=1.5
       , terminal-progress-bar  >=0.4.1
 
-  if flag(tar)
+  if (flag(tar) || os(windows))
     cpp-options:   -DTAR
-    build-depends: tar-bytestring ^>=0.6.3.1
+    build-depends: tar
 
   else
     build-depends: libarchive ^>=3.0.0.0
 
+  if os(windows)
+    cpp-options:   -DIS_WINDOWS
+    other-modules: GHCup.Utils.File.Windows
+    build-depends: bzlib
+
+  else
+    other-modules: GHCup.Utils.File.Posix
+    build-depends:
+        bz2              >=0.5.0.5 && <1.1
+      , hpath-posix      ^>=0.13.3
+      , streamly-posix   ^>=0.1.0.0
+      , unix             ^>=2.7
+      , unix-bytestring  ^>=0.3.7.3
+
+  if (flag(tui) && !os(windows))
+    cpp-options:   -DBRICK
+    build-depends: vty >=5.28.2 && <5.34
+
 executable ghcup
   main-is:            Main.hs
   hs-source-dirs:     app/ghcup
@@ -182,10 +201,9 @@ executable ghcup
     , base                  >=4.13     && <5
     , bytestring            ^>=0.10
     , containers            ^>=0.6
+    , filepath              ^>=1.4.2.1
     , ghcup
     , haskus-utils-variant  >=3.0      && <3.2
-    , hpath                 >=0.11     && <0.13
-    , hpath-io              ^>=0.14.1
     , megaparsec            >=8.0.0    && <9.1
     , monad-logger          ^>=0.3.31
     , mtl                   ^>=2.2
@@ -205,7 +223,7 @@ executable ghcup
   if flag(internal-downloader)
     cpp-options: -DINTERNAL_DOWNLOADER
 
-  if flag(tui)
+  if (flag(tui) && !os(windows))
     cpp-options:   -DBRICK
     other-modules: BrickMain
     build-depends:
@@ -213,7 +231,7 @@ executable ghcup
       , vector  ^>=0.12
       , vty     >=5.28.2 && <5.34
 
-  if flag(tar)
+  if (flag(tar) || os(windows))
     cpp-options: -DTAR
 
   else
@@ -242,10 +260,9 @@ executable ghcup-gen
     , base                  >=4.13     && <5
     , bytestring            ^>=0.10
     , containers            ^>=0.6
+    , filepath              ^>=1.4.2.1
     , ghcup
     , haskus-utils-variant  >=3.0      && <3.2
-    , hpath                 >=0.11     && <0.13
-    , hpath-filepath        ^>=0.10.3
     , monad-logger          ^>=0.3.31
     , mtl                   ^>=2.2
     , optics                >=0.2      && <0.5
@@ -263,9 +280,9 @@ executable ghcup-gen
     , versions              ^>=4.0.1
     , yaml                  ^>=0.11.4.0
 
-  if flag(tar)
+  if (flag(tar) || os(windows))
     cpp-options:   -DTAR
-    build-depends: tar-bytestring ^>=0.6.3.1
+    build-depends: tar
 
   else
     build-depends: libarchive ^>=3.0.0.0
@@ -298,9 +315,8 @@ test-suite ghcup-test
     , containers                ^>=0.6
     , generic-arbitrary         ^>=0.1.0
     , ghcup
-    , hpath                     >=0.11    && <0.13
+    , hspec                     ^>=2.7.10
-    , hspec                     ^>=2.7.4
+    , hspec-golden-aeson        >=0.9 && <0.10
-    , hspec-golden-aeson        >=0.7     && <0.10
     , QuickCheck                ^>=2.14.1
     , quickcheck-arbitrary-adt  ^>=0.3.1.0
     , text                      ^>=1.2.4.0

lib/GHCup/Download.hs

@@ -16,7 +16,7 @@ Copyright   : (c) Julian Ospald, 2020
 License     : LGPL-3.0
 Maintainer  : hasufell@hasufell.de
 Stability   : experimental
-Portability : POSIX
+Portability : portable
 
 Module for handling all download related functions.
 
@@ -53,11 +53,11 @@ import           Control.Monad.Trans.Resource
                                          hiding ( throwM )
 import           Data.Aeson
 import           Data.Bifunctor
-import           Data.ByteString                ( ByteString )
 #if defined(INTERNAL_DOWNLOADER)
+import           Data.ByteString                ( ByteString )
 import           Data.CaseInsensitive           ( CI )
 #endif
-import           Data.List                      ( find )
+import           Data.List.Extra
 import           Data.Maybe
 import           Data.String.Interpolate
 import           Data.Time.Clock
@@ -66,34 +66,29 @@ import           Data.Time.Clock.POSIX
 import           Data.Time.Format
 #endif
 import           Data.Versions
-import           Data.Word8
 import           GHC.IO.Exception
-import           HPath
-import           HPath.IO                     as HIO hiding ( hideError )
 import           Haskus.Utils.Variant.Excepts
 import           Optics
 import           Prelude                 hiding ( abs
                                                 , readFile
                                                 , writeFile
                                                 )
+import           System.Directory
+import           System.Environment
+import           System.FilePath
 import           System.IO.Error
-import           System.Posix.Env.ByteString    ( getEnv )
 import           URI.ByteString
 
 import qualified Crypto.Hash.SHA256            as SHA256
-import qualified Data.ByteString               as BS
 import qualified Data.ByteString.Base16        as B16
 import qualified Data.ByteString.Lazy          as L
 import qualified Data.Map.Strict               as M
 #if defined(INTERNAL_DOWNLOADER)
 import qualified Data.CaseInsensitive          as CI
-import qualified Data.Text                     as T
 #endif
+import qualified Data.Text                     as T
 import qualified Data.Text.Encoding            as E
 import qualified Data.Yaml                     as Y
-import qualified System.Posix.Files.ByteString as PF
-import qualified System.Posix.RawFilePath.Directory
-                                               as RD
 
 
 
@@ -158,12 +153,12 @@ readFromCache = do
   lift $ $(logWarn)
     [i|Could not get download info, trying cached version (this may not be recent!)|]
   let path = view pathL' ghcupURL
-  yaml_file <- (cacheDir </>) <$> urlBaseName path
+  let yaml_file = cacheDir </> (T.unpack . decUTF8Safe . urlBaseName $ path)
   bs        <-
     handleIO' NoSuchThing
-              (\_ -> throwE $ FileDoesNotExistError (toFilePath yaml_file))
+              (\_ -> throwE $ FileDoesNotExistError yaml_file)
     $ liftIO
-    $ readFile yaml_file
+    $ L.readFile yaml_file
   lE' JSONDecodeError $ first show $ Y.decodeEither' (L.toStrict bs)
 
 
@@ -207,29 +202,27 @@ getBase =
   smartDl uri' = do
     AppState {dirs = Dirs {..}} <- lift ask
     let path = view pathL' uri'
-    json_file <- (cacheDir </>) <$> urlBaseName path
+    let json_file = cacheDir </> (T.unpack . decUTF8Safe . urlBaseName $ path)
     e         <- liftIO $ doesFileExist json_file
     if e
       then do
-        accessTime <-
+        accessTime <- liftIO $ getAccessTime json_file
-          PF.accessTimeHiRes
+        currentTime <- liftIO getCurrentTime
-            <$> liftIO (PF.getFileStatus (toFilePath json_file))
-        currentTime <- liftIO getPOSIXTime
 
         -- access time won't work on most linuxes, but we can try regardless
-        if (currentTime - accessTime) > 300
+        if (utcTimeToPOSIXSeconds currentTime - utcTimeToPOSIXSeconds accessTime) > 300
           then do -- no access in last 5 minutes, re-check upstream mod time
             getModTime >>= \case
               Just modTime -> do
                 fileMod <- liftIO $ getModificationTime json_file
                 if modTime > fileMod
                   then dlWithMod modTime json_file
-                  else liftIO $ readFile json_file
+                  else liftIO $ L.readFile json_file
               Nothing -> do
                 lift $ $(logDebug) [i|Unable to get/parse Last-Modified header|]
                 dlWithoutMod json_file
           else -- access in less than 5 minutes, re-use file
-               liftIO $ readFile json_file
+               liftIO $ L.readFile json_file
       else do
         liftIO $ createDirRecursive' cacheDir
         getModTime >>= \case
@@ -247,9 +240,9 @@ getBase =
       pure bs
     dlWithoutMod json_file = do
       bs <- liftE $ downloadBS uri'
-      liftIO $ hideError doesNotExistErrorType $ deleteFile json_file
+      liftIO $ hideError doesNotExistErrorType $ removeFile json_file
-      liftIO $ writeFileL json_file (Just newFilePerms) bs
+      liftIO $ L.writeFile json_file bs
-      liftIO $ setModificationTime json_file (fromIntegral @Int 0)
+      liftIO $ setModificationTime json_file (posixSecondsToUTCTime (fromIntegral @Int 0))
       pure bs
 
 
@@ -278,11 +271,10 @@ getBase =
 
 #endif
 
-  writeFileWithModTime :: UTCTime -> Path Abs -> L.ByteString -> IO ()
+  writeFileWithModTime :: UTCTime -> FilePath -> L.ByteString -> IO ()
   writeFileWithModTime utctime path content = do
-    let mod_time = utcTimeToPOSIXSeconds utctime
+    L.writeFile path content
-    writeFileL path (Just newFilePerms) content
+    setModificationTime path utctime
-    setModificationTimeHiRes path mod_time
 
 
 getDownloadInfo :: Tool
@@ -334,9 +326,9 @@ download :: ( MonadMask m
             , MonadIO m
             )
          => DownloadInfo
-         -> Path Abs          -- ^ destination dir
+         -> FilePath          -- ^ destination dir
-         -> Maybe (Path Rel)  -- ^ optional filename
+         -> Maybe FilePath    -- ^ optional filename
-         -> Excepts '[DigestError , DownloadFailed] m (Path Abs)
+         -> Excepts '[DigestError , DownloadFailed] m FilePath
 download dli dest mfn
   | scheme == "https" = dl
   | scheme == "http"  = dl
@@ -348,9 +340,9 @@ download dli dest mfn
   cp     = do
     -- destination dir must exist
     liftIO $ createDirRecursive' dest
-    destFile <- getDestFile
+    let destFile = getDestFile
-    fromFile <- parseAbs path
+    let fromFile = T.unpack . decUTF8Safe $ path
-    liftIO $ copyFile fromFile destFile Strict
+    liftIO $ copyFile fromFile destFile
     pure destFile
   dl = do
     let uri' = decUTF8Safe (serializeURIRef' (view dlUri dli))
@@ -358,25 +350,25 @@ download dli dest mfn
 
     -- destination dir must exist
     liftIO $ createDirRecursive' dest
-    destFile <- getDestFile
+    let destFile = getDestFile
 
     -- download
     flip onException
-         (liftIO $ hideError doesNotExistErrorType $ deleteFile destFile)
+         (liftIO $ hideError doesNotExistErrorType $ removeFile destFile)
      $ catchAllE @_ @'[ProcessError, DownloadFailed, UnsupportedScheme]
           (\e ->
-            liftIO (hideError doesNotExistErrorType $ deleteFile destFile)
+            liftIO (hideError doesNotExistErrorType $ removeFile destFile)
               >> (throwE . DownloadFailed $ e)
           ) $ do
               lift getDownloader >>= \case
                 Curl -> do
                   o' <- liftIO getCurlOpts
-                  liftE $ lEM @_ @'[ProcessError] $ liftIO $ exec "curl" True
+                  liftE $ lEM @_ @'[ProcessError] $ liftIO $ exec "curl" 
-                    (o' ++ ["-fL", "-o", toFilePath destFile, serializeURIRef' $ view dlUri dli]) Nothing Nothing
+                    (o' ++ ["-fL", "-o", destFile, (T.unpack . decUTF8Safe) $ serializeURIRef' $ view dlUri dli]) Nothing Nothing
                 Wget -> do
                   o' <- liftIO getWgetOpts
-                  liftE $ lEM @_ @'[ProcessError] $ liftIO $ exec "wget" True
+                  liftE $ lEM @_ @'[ProcessError] $ liftIO $ exec "wget" 
-                    (o' ++ ["-O", toFilePath destFile , serializeURIRef' $ view dlUri dli]) Nothing Nothing
+                    (o' ++ ["-O", destFile , (T.unpack . decUTF8Safe) $ serializeURIRef' $ view dlUri dli]) Nothing Nothing
 #if defined(INTERNAL_DOWNLOADER)
                 Internal -> do
                   (https, host, fullPath, port) <- liftE $ uriToQuadruple (view dlUri dli)
@@ -387,8 +379,8 @@ download dli dest mfn
     pure destFile
 
   -- Manage to find a file we can write the body into.
-  getDestFile :: MonadThrow m => m (Path Abs)
+  getDestFile :: FilePath
-  getDestFile = maybe (urlBaseName path <&> (dest </>)) (pure . (dest </>)) mfn
+  getDestFile = maybe (dest </> T.unpack (decUTF8Safe (urlBaseName path))) (dest </>) mfn
 
   path        = view (dlUri % pathL') dli
 
@@ -404,14 +396,14 @@ downloadCached :: ( MonadMask m
                   , MonadReader AppState m
                   )
                => DownloadInfo
-               -> Maybe (Path Rel)  -- ^ optional filename
+               -> Maybe FilePath  -- ^ optional filename
-               -> Excepts '[DigestError , DownloadFailed] m (Path Abs)
+               -> Excepts '[DigestError , DownloadFailed] m FilePath
 downloadCached dli mfn = do
   cache <- lift getCache
   case cache of
     True -> do
       AppState {dirs = Dirs {..}} <- lift ask
-      fn       <- maybe (urlBaseName $ view (dlUri % pathL') dli) pure mfn
+      let fn = fromMaybe ((T.unpack . decUTF8Safe) $ urlBaseName $ view (dlUri % pathL') dli) mfn
       let cachfile = cacheDir </> fn
       fileExists <- liftIO $ doesFileExist cachfile
       if
@@ -453,8 +445,8 @@ downloadBS uri'
   | scheme == "http"
   = dl False
   | scheme == "file"
-  = liftIOException doesNotExistErrorType (FileDoesNotExistError path)
+  = liftIOException doesNotExistErrorType (FileDoesNotExistError $ T.unpack $ decUTF8Safe path)
-    (liftIO $ RD.readFile path)
+    (liftIO $ L.readFile (T.unpack $ decUTF8Safe path))
   | otherwise
   = throwE UnsupportedScheme
 
@@ -470,20 +462,20 @@ downloadBS uri'
     lift getDownloader >>= \case
       Curl -> do
         o' <- liftIO getCurlOpts
-        let exe = [rel|curl|]
+        let exe = "curl"
-            args = o' ++ ["-sSfL", serializeURIRef' uri']
+            args = o' ++ ["-sSfL", T.unpack $ decUTF8Safe $ serializeURIRef' uri']
         liftIO (executeOut exe args Nothing) >>= \case
           CapturedProcess ExitSuccess stdout _ -> do
-            pure $ L.fromStrict stdout
+            pure stdout
-          CapturedProcess (ExitFailure i') _ _ -> throwE $ NonZeroExit i' (toFilePath exe) args
+          CapturedProcess (ExitFailure i') _ _ -> throwE $ NonZeroExit i' exe args
       Wget -> do
         o' <- liftIO getWgetOpts
-        let exe = [rel|wget|]
+        let exe = "wget"
-            args = o' ++ ["-qO-", serializeURIRef' uri']
+            args = o' ++ ["-qO-", T.unpack $ decUTF8Safe $ serializeURIRef' uri']
         liftIO (executeOut exe args Nothing) >>= \case
           CapturedProcess ExitSuccess stdout _ -> do
-            pure $ L.fromStrict stdout
+            pure stdout
-          CapturedProcess (ExitFailure i') _ _ -> throwE $ NonZeroExit i' (toFilePath exe) args
+          CapturedProcess (ExitFailure i') _ _ -> throwE $ NonZeroExit i' exe args
 #if defined(INTERNAL_DOWNLOADER)
       Internal -> do
         (_, host', fullPath', port') <- liftE $ uriToQuadruple uri'
@@ -493,31 +485,31 @@ downloadBS uri'
 
 checkDigest :: (MonadIO m, MonadThrow m, MonadLogger m, MonadReader AppState m)
             => DownloadInfo
-            -> Path Abs
+            -> FilePath
             -> Excepts '[DigestError] m ()
 checkDigest dli file = do
   verify <- lift ask <&> (not . noVerify . settings)
   when verify $ do
-    p' <- toFilePath <$> basename file
+    let p' = takeFileName file
     lift $ $(logInfo) [i|verifying digest of: #{p'}|]
-    c <- liftIO $ readFile file
+    c <- liftIO $ L.readFile file
     cDigest <- throwEither . E.decodeUtf8' . B16.encode . SHA256.hashlazy $ c
     let eDigest = view dlHash dli
     when ((cDigest /= eDigest) && verify) $ throwE (DigestError cDigest eDigest)
 
 
 -- | Get additional curl args from env. This is an undocumented option.
-getCurlOpts :: IO [ByteString]
+getCurlOpts :: IO [String]
 getCurlOpts =
-  getEnv "GHCUP_CURL_OPTS" >>= \case
+  lookupEnv "GHCUP_CURL_OPTS" >>= \case
-    Just r  -> pure $ BS.split _space r
+    Just r  -> pure $ splitOn " " r
     Nothing -> pure []
 
 
 -- | Get additional wget args from env. This is an undocumented option.
-getWgetOpts :: IO [ByteString]
+getWgetOpts :: IO [String]
 getWgetOpts =
-  getEnv "GHCUP_WGET_OPTS" >>= \case
+  lookupEnv "GHCUP_WGET_OPTS" >>= \case
-    Just r  -> pure $ BS.split _space r
+    Just r  -> pure $ splitOn " " r
     Nothing -> pure []
 

lib/GHCup/Download/IOStreams.hs

@@ -24,8 +24,6 @@ import           Data.CaseInsensitive           ( CI )
 import           Data.IORef
 import           Data.Maybe
 import           Data.Text.Read
-import           HPath
-import           HPath.IO                      as HIO
 import           Haskus.Utils.Variant.Excepts
 import           Network.Http.Client     hiding ( URL )
 import           Optics
@@ -33,11 +31,8 @@ import           Prelude                 hiding ( abs
                                                 , readFile
                                                 , writeFile
                                                 )
-import "unix"    System.Posix.IO.ByteString
-                                         hiding ( fdWrite )
-import "unix-bytestring" System.Posix.IO.ByteString
-                                                ( fdWrite )
 import           System.ProgressBar
+import           System.IO
 import           URI.ByteString
 
 import qualified Data.ByteString               as BS
@@ -81,12 +76,12 @@ downloadToFile :: (MonadMask m, MonadIO m)
                -> ByteString       -- ^ host (e.g. "www.example.com")
                -> ByteString       -- ^ path (e.g. "/my/file") including query
                -> Maybe Int        -- ^ optional port (e.g. 3000)
-               -> Path Abs         -- ^ destination file to create and write to
+               -> FilePath         -- ^ destination file to create and write to
                -> Excepts '[DownloadFailed] m ()
 downloadToFile https host fullPath port destFile = do
-  fd <- liftIO $ createRegularFileFd newFilePerms destFile
+  fd <- liftIO $ openFile destFile WriteMode
-  let stepper = fdWrite fd
+  let stepper = BS.hPut fd
-  flip finally (liftIO $ closeFd fd)
+  flip finally (liftIO $ hClose fd)
     $ reThrowAll DownloadFailed $ downloadInternal True https host fullPath port stepper
 
 

lib/GHCup/Errors.hs

@@ -15,12 +15,11 @@ Copyright   : (c) Julian Ospald, 2020
 License     : LGPL-3.0
 Maintainer  : hasufell@hasufell.de
 Stability   : experimental
-Portability : POSIX
+Portability : portable
 -}
 module GHCup.Errors where
 
 import           GHCup.Types
-import           GHCup.Utils.Prelude
 
 #if !defined(TAR)
 import           Codec.Archive
@@ -28,11 +27,9 @@ import           Codec.Archive
 import qualified Codec.Archive.Tar             as Tar
 #endif
 import           Control.Exception.Safe
-import           Data.ByteString                ( ByteString )
 import           Data.String.Interpolate
 import           Data.Text                      ( Text )
 import           Data.Versions
-import           HPath
 import           Haskus.Utils.Variant
 import           Text.PrettyPrint
 import           Text.PrettyPrint.HughesPJClass
@@ -86,12 +83,12 @@ instance Pretty DistroNotFound where
     text "Unable to figure out the distribution of the host."
 
 -- | The archive format is unknown. We don't know how to extract it.
-data UnknownArchive = UnknownArchive ByteString
+data UnknownArchive = UnknownArchive FilePath
   deriving Show
 
 instance Pretty UnknownArchive where
   pPrint (UnknownArchive file) =
-    text [i|The archive format is unknown. We don't know how to extract the file "#{decUTF8Safe file}"|]
+    text [i|The archive format is unknown. We don't know how to extract the file "#{file}"|]
 
 -- | The scheme is not supported (such as ftp).
 data UnsupportedScheme = UnsupportedScheme
@@ -143,12 +140,12 @@ instance Pretty NotInstalled where
     text [i|The version "#{prettyShow ver}" of the tool "#{tool}" is not installed.|]
 
 -- | An executable was expected to be in PATH, but was not found.
-data NotFoundInPATH = NotFoundInPATH (Path Rel)
+data NotFoundInPATH = NotFoundInPATH FilePath
   deriving Show
 
 instance Pretty NotFoundInPATH where
   pPrint (NotFoundInPATH exe) =
-    text [i|The exe "#{decUTF8Safe . toFilePath $ exe}" was not found in PATH.|]
+    text [i|The exe "#{exe}" was not found in PATH.|]
 
 -- | JSON decoding failed.
 data JSONError = JSONDecodeError String
@@ -160,12 +157,12 @@ instance Pretty JSONError where
 
 -- | A file that is supposed to exist does not exist
 -- (e.g. when we use file scheme to "download" something).
-data FileDoesNotExistError = FileDoesNotExistError ByteString
+data FileDoesNotExistError = FileDoesNotExistError FilePath
   deriving Show
 
 instance Pretty FileDoesNotExistError where
   pPrint (FileDoesNotExistError file) =
-    text [i|File "#{decUTF8Safe file}" does not exist.|]
+    text [i|File "#{file}" does not exist.|]
 
 data TarDirDoesNotExist = TarDirDoesNotExist TarDir
   deriving Show
@@ -252,11 +249,11 @@ deriving instance Show DownloadFailed
 
 
 -- | A build failed.
-data BuildFailed = forall es . Show (V es) => BuildFailed (Path Abs) (V es)
+data BuildFailed = forall es . Show (V es) => BuildFailed FilePath (V es)
 
 instance Pretty BuildFailed where
   pPrint (BuildFailed path reason) =
-    text [i|BuildFailed failed in dir "#{decUTF8Safe . toFilePath $ path}": #{reason}|]
+    text [i|BuildFailed failed in dir "#{path}": #{reason}|]
 
 deriving instance Show BuildFailed
 

lib/GHCup/Platform.hs

@@ -13,7 +13,7 @@ Copyright   : (c) Julian Ospald, 2020
 License     : LGPL-3.0
 Maintainer  : hasufell@hasufell.de
 Stability   : experimental
-Portability : POSIX
+Portability : portable
 -}
 module GHCup.Platform where
 
@@ -36,18 +36,20 @@ import           Data.Maybe
 import           Data.String.Interpolate
 import           Data.Text                      ( Text )
 import           Data.Versions
-import           HPath
-import           HPath.IO
 import           Haskus.Utils.Variant.Excepts
 import           Prelude                 hiding ( abs
                                                 , readFile
                                                 , writeFile
                                                 )
 import           System.Info
+import           System.Directory
 import           System.OsRelease
 import           Text.Regex.Posix
 
 import qualified Data.Text                     as T
+import qualified Data.Text.IO                  as T
+
+
 
     --------------------------
     --[ Platform detection ]--
@@ -96,22 +98,23 @@ getPlatform = do
           . versioning
           -- TODO: maybe do this somewhere else
           . getMajorVersion
-          . decUTF8Safe
+          . decUTF8Safe'
         <$> getDarwinVersion
       pure $ PlatformResult { _platform = Darwin, _distroVersion = ver }
     "freebsd" -> do
       ver <-
-        either (const Nothing) Just . versioning . decUTF8Safe
+        either (const Nothing) Just . versioning . decUTF8Safe'
           <$> getFreeBSDVersion
       pure $ PlatformResult { _platform = FreeBSD, _distroVersion = ver }
+    "mingw32" -> pure PlatformResult { _platform = Windows, _distroVersion = Nothing }
     what -> throwE $ NoCompatiblePlatform what
   lift $ $(logDebug) [i|Identified Platform as: #{pfr}|]
   pure pfr
  where
   getMajorVersion = T.intercalate "." . take 2 . T.split (== '.')
   getFreeBSDVersion =
-    liftIO $ fmap _stdOut $ executeOut [rel|freebsd-version|] [] Nothing
+    liftIO $ fmap _stdOut $ executeOut "freebsd-version" [] Nothing
-  getDarwinVersion = liftIO $ fmap _stdOut $ executeOut [rel|sw_vers|]
+  getDarwinVersion = liftIO $ fmap _stdOut $ executeOut "sw_vers"
                                                         ["-productVersion"]
                                                         Nothing
 
@@ -147,12 +150,12 @@ getLinuxDistro = do
    where
     regex x = makeRegexOpts compIgnoreCase execBlank ([s|\<|] ++ x ++ [s|\>|])
 
-  lsb_release_cmd :: Path Rel
+  lsb_release_cmd :: FilePath
-  lsb_release_cmd = [rel|lsb-release|]
+  lsb_release_cmd = "lsb-release"
-  redhat_release :: Path Abs
+  redhat_release :: FilePath
-  redhat_release = [abs|/etc/redhat-release|]
+  redhat_release = "/etc/redhat-release"
-  debian_version :: Path Abs
+  debian_version :: FilePath
-  debian_version = [abs|/etc/debian_version|]
+  debian_version = "/etc/debian_version"
 
   try_os_release :: IO (Text, Maybe Text)
   try_os_release = do
@@ -165,11 +168,11 @@ getLinuxDistro = do
     (Just _) <- findExecutable lsb_release_cmd
     name     <- fmap _stdOut $ executeOut lsb_release_cmd ["-si"] Nothing
     ver      <- fmap _stdOut $ executeOut lsb_release_cmd ["-sr"] Nothing
-    pure (decUTF8Safe name, Just $ decUTF8Safe ver)
+    pure (decUTF8Safe' name, Just $ decUTF8Safe' ver)
 
   try_redhat_release :: IO (Text, Maybe Text)
   try_redhat_release = do
-    t <- fmap decUTF8Safe' $ readFile redhat_release
+    t <- T.readFile redhat_release
     let nameRegex n =
           makeRegexOpts compIgnoreCase
                         execBlank
@@ -191,5 +194,5 @@ getLinuxDistro = do
 
   try_debian_version :: IO (Text, Maybe Text)
   try_debian_version = do
-    ver <- readFile debian_version
+    ver <- T.readFile debian_version
-    pure (T.pack "debian", Just . decUTF8Safe' $ ver)
+    pure (T.pack "debian", Just ver)

lib/GHCup/Requirements.hs

@@ -7,7 +7,7 @@ Copyright   : (c) Julian Ospald, 2020
 License     : LGPL-3.0
 Maintainer  : hasufell@hasufell.de
 Stability   : experimental
-Portability : POSIX
+Portability : portable
 -}
 module GHCup.Requirements where
 

lib/GHCup/Types.hs

@@ -2,7 +2,6 @@
 {-# LANGUAGE CPP               #-}
 {-# LANGUAGE DeriveGeneric     #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes           #-}
 
 {-|
 Module      : GHCup.Types
@@ -11,26 +10,39 @@ Copyright   : (c) Julian Ospald, 2020
 License     : LGPL-3.0
 Maintainer  : hasufell@hasufell.de
 Stability   : experimental
-Portability : POSIX
+Portability : portable
 -}
-module GHCup.Types where
+module GHCup.Types
+  ( module GHCup.Types
+#if defined(BRICK)
+  , Key(..)
+#endif
+  )
+  where
 
 import           Data.Map.Strict                ( Map )
 import           Data.List.NonEmpty             ( NonEmpty (..) )
-import           Data.String.Interpolate
 import           Data.Text                      ( Text )
 import           Data.Versions
-import           HPath
 import           Text.PrettyPrint.HughesPJClass (Pretty, pPrint, text)
 import           URI.ByteString
+#if defined(BRICK)
+import           Graphics.Vty                   ( Key(..) )
+#endif
 
 import qualified Data.Text                     as T
-import qualified Data.Text.Encoding            as E
-import qualified Data.Text.Encoding.Error      as E
 import qualified GHC.Generics                  as GHC
-import qualified Graphics.Vty                  as Vty
 
 
+#if !defined(BRICK)
+data Key = KEsc  | KChar Char | KBS | KEnter
+         | KLeft | KRight | KUp | KDown
+         | KUpLeft | KUpRight | KDownLeft | KDownRight | KCenter
+         | KFun Int | KBackTab | KPrtScr | KPause | KIns
+         | KHome | KPageUp | KDel | KEnd | KPageDown | KBegin | KMenu
+    deriving (Eq,Show,Read,Ord,GHC.Generic)
+#endif
+
 
     --------------------
     --[ GHCInfo Tree ]--
@@ -85,6 +97,7 @@ data Tool = GHC
           | Cabal
           | GHCup
           | HLS
+          | Stack
   deriving (Eq, GHC.Generic, Ord, Show, Enum, Bounded)
 
 
@@ -156,12 +169,15 @@ data Platform = Linux LinuxDistro
               | Darwin
               -- ^ must exit
               | FreeBSD
+              | Windows
+              -- ^ must exit
   deriving (Eq, GHC.Generic, Ord, Show)
 
 platformToString :: Platform -> String
 platformToString (Linux distro) = "linux-" ++ distroToString distro
 platformToString Darwin = "darwin"
 platformToString FreeBSD = "freebsd"
+platformToString Windows = "windows"
 
 instance Pretty Platform where
   pPrint = text . platformToString
@@ -217,12 +233,12 @@ data DownloadInfo = DownloadInfo
 
 
 -- | How to descend into a tar archive.
-data TarDir = RealDir (Path Rel)
+data TarDir = RealDir FilePath
             | RegexDir String     -- ^ will be compiled to regex, the first match will "win"
             deriving (Eq, Ord, GHC.Generic, Show)
 
 instance Pretty TarDir where
-  pPrint (RealDir path) = text [i|#{E.decodeUtf8With E.lenientDecode . toFilePath $ path}|]
+  pPrint (RealDir path) = text path
   pPrint (RegexDir regex) = text regex
 
 
@@ -249,39 +265,42 @@ defaultUserSettings :: UserSettings
 defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing
 
 data UserKeyBindings = UserKeyBindings
-  { kUp        :: Maybe Vty.Key
+  { kUp        :: Maybe Key
-  , kDown      :: Maybe Vty.Key
+  , kDown      :: Maybe Key
-  , kQuit      :: Maybe Vty.Key
+  , kQuit      :: Maybe Key
-  , kInstall   :: Maybe Vty.Key
+  , kInstall   :: Maybe Key
-  , kUninstall :: Maybe Vty.Key
+  , kUninstall :: Maybe Key
-  , kSet       :: Maybe Vty.Key
+  , kSet       :: Maybe Key
-  , kChangelog :: Maybe Vty.Key
+  , kChangelog :: Maybe Key
-  , kShowAll   :: Maybe Vty.Key
+  , kShowAll   :: Maybe Key
+  , kShowAllTools :: Maybe Key
   }
   deriving (Show, GHC.Generic)
 
 data KeyBindings = KeyBindings
-  { bUp        :: Vty.Key
+  { bUp        :: Key
-  , bDown      :: Vty.Key
+  , bDown      :: Key
-  , bQuit      :: Vty.Key
+  , bQuit      :: Key
-  , bInstall   :: Vty.Key
+  , bInstall   :: Key
-  , bUninstall :: Vty.Key
+  , bUninstall :: Key
-  , bSet       :: Vty.Key
+  , bSet       :: Key
-  , bChangelog :: Vty.Key
+  , bChangelog :: Key
-  , bShowAll   :: Vty.Key
+  , bShowAllVersions :: Key
+  , bShowAllTools :: Key
   }
   deriving (Show, GHC.Generic)
 
 defaultKeyBindings :: KeyBindings
 defaultKeyBindings = KeyBindings
-  { bUp = Vty.KUp
+  { bUp = KUp
-  , bDown = Vty.KDown
+  , bDown = KDown
-  , bQuit = Vty.KChar 'q'
+  , bQuit = KChar 'q'
-  , bInstall = Vty.KChar 'i'
+  , bInstall = KChar 'i'
-  , bUninstall = Vty.KChar 'u'
+  , bUninstall = KChar 'u'
-  , bSet = Vty.KChar 's'
+  , bSet = KChar 's'
-  , bChangelog = Vty.KChar 'c'
+  , bChangelog = KChar 'c'
-  , bShowAll = Vty.KChar 'a'
+  , bShowAllVersions = KChar 'a'
+  , bShowAllTools = KChar 't'
   }
 
 data AppState = AppState
@@ -301,11 +320,11 @@ data Settings = Settings
   deriving (Show, GHC.Generic)
 
 data Dirs = Dirs
-  { baseDir  :: Path Abs
+  { baseDir  :: FilePath
-  , binDir   :: Path Abs
+  , binDir   :: FilePath
-  , cacheDir :: Path Abs
+  , cacheDir :: FilePath
-  , logsDir  :: Path Abs
+  , logsDir  :: FilePath
-  , confDir  :: Path Abs
+  , confDir  :: FilePath
   }
   deriving Show
 
@@ -322,10 +341,10 @@ data Downloader = Curl
   deriving (Eq, Show, Ord)
 
 data DebugInfo = DebugInfo
-  { diBaseDir  :: Path Abs
+  { diBaseDir  :: FilePath
-  , diBinDir   :: Path Abs
+  , diBinDir   :: FilePath
-  , diGHCDir   :: Path Abs
+  , diGHCDir   :: FilePath
-  , diCacheDir :: Path Abs
+  , diCacheDir :: FilePath
   , diArch     :: Architecture
   , diPlatform :: PlatformResult
   }
@@ -379,6 +398,11 @@ data GHCTargetVersion = GHCTargetVersion
   }
   deriving (Ord, Eq, Show)
 
+data GitBranch = GitBranch
+  { ref  :: String
+  , repo :: Maybe String
+  }
+  deriving (Ord, Eq, Show)
 
 mkTVer :: Version -> GHCTargetVersion
 mkTVer = GHCTargetVersion Nothing

lib/GHCup/Types/JSON.hs

@@ -17,7 +17,7 @@ Copyright   : (c) Julian Ospald, 2020
 License     : LGPL-3.0
 Maintainer  : hasufell@hasufell.de
 Stability   : experimental
-Portability : POSIX
+Portability : portable
 -}
 module GHCup.Types.JSON where
 
@@ -33,15 +33,11 @@ import           Data.List.NonEmpty             ( NonEmpty(..) )
 import           Data.Text.Encoding            as E
 import           Data.Versions
 import           Data.Void
-import           Data.Word8
-import           HPath
 import           URI.ByteString
 import           Text.Casing
 
-import qualified Data.ByteString               as BS
 import qualified Data.List.NonEmpty            as NE
 import qualified Data.Text                     as T
-import qualified Graphics.Vty                  as Vty
 import qualified Text.Megaparsec               as MP
 import qualified Text.Megaparsec.Char          as MPC
 
@@ -64,7 +60,7 @@ deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Downlo
 deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''URLSource
 deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "u-") . T.pack . kebab $ str' } ''UserSettings
 deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "k-") . T.pack . kebab $ str' } ''UserKeyBindings
-deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''Vty.Key
+deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''Key
 
 instance ToJSON Tag where
   toJSON Latest             = String "Latest"
@@ -128,11 +124,13 @@ instance ToJSONKey Platform where
     Darwin  -> T.pack "Darwin"
     FreeBSD -> T.pack "FreeBSD"
     Linux d -> T.pack ("Linux_" <> show d)
+    Windows -> T.pack "Windows"
 
 instance FromJSONKey Platform where
   fromJSONKey = FromJSONKeyTextParser $ \t -> if
     | T.pack "Darwin" == t -> pure Darwin
     | T.pack "FreeBSD" == t -> pure FreeBSD
+    | T.pack "Windows" == t -> pure Windows
     | T.pack "Linux_" `T.isPrefixOf` t -> case
         T.stripPrefix (T.pack "Linux_") t
       of
@@ -199,20 +197,6 @@ instance ToJSONKey Tool where
 instance FromJSONKey Tool where
   fromJSONKey = genericFromJSONKey defaultJSONKeyOptions
 
-instance ToJSON (Path Rel) where
-  toJSON p = case and . fmap isAscii . BS.unpack $ fp of
-    True  -> toJSON . decUTF8Safe $ fp
-    False -> String "/not/a/valid/path"
-    where fp = toFilePath p
-
-instance FromJSON (Path Rel) where
-  parseJSON = withText "HPath Rel" $ \t -> do
-    let d = encodeUtf8 t
-    case parseRel d of
-      Right x -> pure x
-      Left  e -> fail $ "Failure in HPath Rel (FromJSON)" <> show e
-
-
 instance ToJSON TarDir where
   toJSON (RealDir  p) = toJSON p
   toJSON (RegexDir r) = object ["RegexDir" .= r]

lib/GHCup/Types/Optics.hs

@@ -7,7 +7,7 @@ Copyright   : (c) Julian Ospald, 2020
 License     : LGPL-3.0
 Maintainer  : hasufell@hasufell.de
 Stability   : experimental
-Portability : POSIX
+Portability : portable
 -}
 module GHCup.Types.Optics where
 

lib/GHCup/Utils.hs

@@ -14,7 +14,7 @@ Copyright   : (c) Julian Ospald, 2020
 License     : LGPL-3.0
 Maintainer  : hasufell@hasufell.de
 Stability   : experimental
-Portability : POSIX
+Portability : portable
 
 This module contains GHCup helpers specific to
 installation and introspection of files/versions etc.
@@ -39,6 +39,7 @@ import           GHCup.Utils.String.QQ
 #if !defined(TAR)
 import           Codec.Archive           hiding ( Directory )
 #endif
+import           Codec.Archive.Zip
 import           Control.Applicative
 import           Control.Exception.Safe
 import           Control.Monad
@@ -51,28 +52,21 @@ import           Data.ByteString                ( ByteString )
 import           Data.Either
 import           Data.Foldable
 import           Data.List
+import           Data.List.Extra
 import           Data.List.NonEmpty             ( NonEmpty( (:|) ))
-import           Data.List.Split
 import           Data.Maybe
 import           Data.String.Interpolate
 import           Data.Text                      ( Text )
 import           Data.Versions
 import           Data.Word8
 import           GHC.IO.Exception
-import           HPath
-import           HPath.IO                hiding ( hideError )
 import           Haskus.Utils.Variant.Excepts
 import           Optics
-import           Prelude                 hiding ( abs
-                                                , readFile
-                                                , writeFile
-                                                )
 import           Safe
+import           System.Directory      hiding   ( findFiles )
+import           System.FilePath
 import           System.IO.Error
-import           System.Posix.FilePath          ( getSearchPath
+import           System.IO.Unsafe               ( unsafeInterleaveIO )
-                                                , takeFileName
-                                                )
-import           System.Posix.Files.ByteString  ( readSymbolicLink )
 import           Text.Regex.Posix
 import           URI.ByteString
 
@@ -85,9 +79,7 @@ import qualified Codec.Compression.Lzma        as Lzma
 import qualified Data.ByteString               as B
 import qualified Data.ByteString.Lazy          as BL
 import qualified Data.Map.Strict               as Map
-#if !defined(TAR)
 import qualified Data.Text                     as T
-#endif
 import qualified Data.Text.Encoding            as E
 import qualified Text.Megaparsec               as MP
 
@@ -102,14 +94,13 @@ import qualified Text.Megaparsec               as MP
 
 -- | The symlink destination of a ghc tool.
 ghcLinkDestination :: (MonadReader AppState m, MonadThrow m, MonadIO m)
-                   => ByteString -- ^ the tool, such as 'ghc', 'haddock' etc.
+                   => FilePath -- ^ the tool, such as 'ghc', 'haddock' etc.
                    -> GHCTargetVersion
-                   -> m ByteString
+                   -> m FilePath
 ghcLinkDestination tool ver = do
   AppState { dirs = Dirs {..} } <- ask
-  t <- parseRel tool
   ghcd <- ghcupGHCDir ver
-  pure (relativeSymlink binDir (ghcd </> [rel|bin|] </> t))
+  pure (relativeSymlink binDir (ghcd </> "bin" </> tool))
 
 
 -- | Removes the minor GHC symlinks, e.g. ghc-8.6.5.
@@ -127,10 +118,10 @@ rmMinorSymlinks tv@GHCTargetVersion{..} = do
 
   files                         <- liftE $ ghcToolFiles tv
   forM_ files $ \f -> do
-    f_xyz <- liftIO $ parseRel (toFilePath f <> B.singleton _hyphen <> verToBS _tvVersion)
+    let f_xyz = f <> "-" <> T.unpack (prettyVer _tvVersion) <> exeExt
     let fullF = binDir </> f_xyz
-    lift $ $(logDebug) [i|rm -f #{toFilePath fullF}|]
+    lift $ $(logDebug) [i|rm -f #{fullF}|]
-    liftIO $ hideError doesNotExistErrorType $ deleteFile fullF
+    liftIO $ hideError doesNotExistErrorType $ removeFile fullF
 
 
 -- | Removes the set ghc version for the given target, if any.
@@ -148,13 +139,13 @@ rmPlain target = do
   forM_ mtv $ \tv -> do
     files <- liftE $ ghcToolFiles tv
     forM_ files $ \f -> do
-      let fullF = binDir </> f
+      let fullF = binDir </> f <> exeExt
-      lift $ $(logDebug) [i|rm -f #{toFilePath fullF}|]
+      lift $ $(logDebug) [i|rm -f #{fullF}|]
-      liftIO $ hideError doesNotExistErrorType $ deleteFile fullF
+      liftIO $ hideError doesNotExistErrorType $ removeFile fullF
     -- old ghcup
-    let hdc_file = binDir </> [rel|haddock-ghc|]
+    let hdc_file = binDir </> "haddock-ghc" <> exeExt
-    lift $ $(logDebug) [i|rm -f #{toFilePath hdc_file}|]
+    lift $ $(logDebug) [i|rm -f #{hdc_file}|]
-    liftIO $ hideError doesNotExistErrorType $ deleteFile hdc_file
+    liftIO $ hideError doesNotExistErrorType $ removeFile hdc_file
 
 
 -- | Remove the major GHC symlink, e.g. ghc-8.6.
@@ -174,10 +165,10 @@ rmMajorSymlinks tv@GHCTargetVersion{..} = do
 
   files                         <- liftE $ ghcToolFiles tv
   forM_ files $ \f -> do
-    f_xyz <- liftIO $ parseRel (toFilePath f <> B.singleton _hyphen <> E.encodeUtf8 v')
+    let f_xy = f <> "-" <> T.unpack v' <> exeExt
-    let fullF = binDir </> f_xyz
+    let fullF = binDir </> f_xy
-    lift $ $(logDebug) [i|rm -f #{toFilePath fullF}|]
+    lift $ $(logDebug) [i|rm -f #{fullF}|]
-    liftIO $ hideError doesNotExistErrorType $ deleteFile fullF
+    liftIO $ hideError doesNotExistErrorType $ removeFile fullF
 
 
 
@@ -187,7 +178,7 @@ rmMajorSymlinks tv@GHCTargetVersion{..} = do
     -----------------------------------
 
 
--- | Whethe the given GHC versin is installed.
+-- | Whether the given GHC versin is installed.
 ghcInstalled :: (MonadIO m, MonadReader AppState m, MonadThrow m) => GHCTargetVersion -> m Bool
 ghcInstalled ver = do
   ghcdir <- ghcupGHCDir ver
@@ -208,42 +199,40 @@ ghcSet :: (MonadReader AppState m, MonadThrow m, MonadIO m)
        -> m (Maybe GHCTargetVersion)
 ghcSet mtarget = do
   AppState {dirs = Dirs {..}} <- ask
-  ghc    <- parseRel $ E.encodeUtf8 (maybe "ghc" (<> "-ghc") mtarget)
+  let ghc = maybe "ghc" (\t -> T.unpack t <> "-ghc") mtarget
-  let ghcBin = binDir </> ghc
+  let ghcBin = binDir </> ghc <> exeExt
 
   -- link destination is of the form ../ghc/<ver>/bin/ghc
   -- for old ghcup, it is ../ghc/<ver>/bin/ghc-<ver>
   liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ do
-    link <- readSymbolicLink $ toFilePath ghcBin
+    link <- liftIO $ getSymbolicLinkTarget ghcBin
     Just <$> ghcLinkVersion link
 
-ghcLinkVersion :: MonadThrow m => ByteString -> m GHCTargetVersion
+ghcLinkVersion :: MonadThrow m => FilePath -> m GHCTargetVersion
-ghcLinkVersion bs = do
+ghcLinkVersion (T.pack . dropSuffix exeExt -> t) = throwEither $ MP.parse parser "ghcLinkVersion" t
-  t <- throwEither $ E.decodeUtf8' bs
-  throwEither $ MP.parse parser "ghcLinkVersion" t
  where
   parser =
       (do
-         _    <- parseUntil1 (MP.chunk "/ghc/")
+         _    <- parseUntil1 ghcSubPath
-         _    <- MP.chunk "/ghc/"
+         _    <- ghcSubPath
-         r    <- parseUntil1 (MP.chunk "/")
+         r    <- parseUntil1 pathSep
          rest <- MP.getInput
          MP.setInput r
          x <- ghcTargetVerP
          MP.setInput rest
          pure x
        )
-      <* MP.chunk "/"
+      <* pathSep
       <* MP.takeRest
       <* MP.eof
-
+  ghcSubPath = pathSep <* MP.chunk "ghc" *> pathSep
 
 -- | Get all installed GHCs by reading ~/.ghcup/ghc/<dir>.
 -- If a dir cannot be parsed, returns left.
-getInstalledGHCs :: (MonadReader AppState m, MonadIO m) => m [Either (Path Rel) GHCTargetVersion]
+getInstalledGHCs :: (MonadReader AppState m, MonadIO m) => m [Either FilePath GHCTargetVersion]
 getInstalledGHCs = do
   ghcdir <- ghcupGHCBaseDir
-  fs     <- liftIO $ hideErrorDef [NoSuchThing] [] $ getDirsFiles' ghcdir
+  fs     <- liftIO $ hideErrorDef [NoSuchThing] [] $ listDirectory ghcdir
   forM fs $ \f -> case parseGHCupGHCDir f of
     Right r -> pure $ Right r
     Left  _ -> pure $ Left f
@@ -251,7 +240,7 @@ getInstalledGHCs = do
 
 -- | Get all installed cabals, by matching on @~\/.ghcup\/bin/cabal-*@.
 getInstalledCabals :: (MonadLogger m, MonadReader AppState m, MonadIO m, MonadCatch m)
-                   => m [Either (Path Rel) Version]
+                   => m [Either FilePath Version]
 getInstalledCabals = do
   cs <- cabalSet -- for legacy cabal
   getInstalledCabals' cs
@@ -259,13 +248,13 @@ getInstalledCabals = do
 
 getInstalledCabals' :: (MonadLogger m, MonadReader AppState m, MonadIO m, MonadCatch m)
                    => Maybe Version
-                   -> m [Either (Path Rel) Version]
+                   -> m [Either FilePath Version]
 getInstalledCabals' cs = do
   AppState {dirs = Dirs {..}} <- ask
   bins   <- liftIO $ handleIO (\_ -> pure []) $ findFiles
     binDir
     (makeRegexOpts compExtended execBlank ([s|^cabal-.*$|] :: ByteString))
-  vs <- forM bins $ \f -> case fmap (version . decUTF8Safe) . B.stripPrefix "cabal-" . toFilePath $ f of
+  vs <- forM bins $ \f -> case fmap (version . T.pack . dropSuffix exeExt) . stripPrefix "cabal-" $ f of
     Just (Right r) -> pure $ Right r
     Just (Left  _) -> pure $ Left f
     Nothing        -> pure $ Left f
@@ -283,22 +272,20 @@ cabalInstalled ver = do
 cabalSet :: (MonadLogger m, MonadReader AppState m, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
 cabalSet = do
   AppState {dirs = Dirs {..}} <- ask
-  let cabalbin = binDir </> [rel|cabal|]
+  let cabalbin = binDir </> "cabal" <> exeExt
-  b        <- handleIO (\_ -> pure False) $ fmap (== SymbolicLink) $ liftIO $ getFileType cabalbin
+  b        <- handleIO (\_ -> pure False) $ liftIO $ pathIsSymbolicLink cabalbin
   if
     | b -> do
       handleIO' NoSuchThing (\_ -> pure Nothing) $ do
         broken <- liftIO $ isBrokenSymlink cabalbin
         if broken
-          then do
+          then pure Nothing
-            $(logWarn) [i|Symlink #{cabalbin} is broken.|]
-            pure Nothing
           else do
-            link <- liftIO $ readSymbolicLink $ toFilePath cabalbin
+            link <- liftIO $ getSymbolicLinkTarget cabalbin
             case linkVersion link of
               Right v -> pure $ Just v
               Left err -> do
-                $(logWarn) [i|Failed to parse cabal symlink target with: "#{err}". The symlink #{toFilePath cabalbin} needs to point to valid cabal binary, such as 'cabal-3.4.0.0'.|]
+                $(logWarn) [i|Failed to parse cabal symlink target with: "#{err}". The symlink #{cabalbin} needs to point to valid cabal binary, such as 'cabal-3.4.0.0'.|]
                 pure Nothing
     | otherwise -> do -- legacy behavior
       mc <- liftIO $ handleIO (\_ -> pure Nothing) $ fmap Just $ executeOut
@@ -306,8 +293,8 @@ cabalSet = do
         ["--numeric-version"]
         Nothing
       fmap join $ forM mc $ \c -> if
-        | not (B.null (_stdOut c)), _exitCode c == ExitSuccess -> do
+        | not (BL.null (_stdOut c)), _exitCode c == ExitSuccess -> do
-          let reportedVer = fst . B.spanEnd (== _lf) . _stdOut $ c
+          let reportedVer = fst . B.spanEnd (== _lf) . BL.toStrict . _stdOut $ c
           case version $ decUTF8Safe reportedVer of
             Left  e -> throwM e
             Right r -> pure $ Just r
@@ -316,10 +303,8 @@ cabalSet = do
   -- We try to be extra permissive with link destination parsing,
   -- because of:
   --   https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/119
-  linkVersion :: MonadThrow m => ByteString -> m Version
+  linkVersion :: MonadThrow m => FilePath -> m Version
-  linkVersion bs = do
+  linkVersion = throwEither . MP.parse parser "" . T.pack . dropSuffix exeExt
-    t <- throwEither $ E.decodeUtf8' bs
-    throwEither $ MP.parse parser "" t
 
   parser
     =   MP.try (stripAbsolutePath *> cabalParse)
@@ -329,10 +314,10 @@ cabalSet = do
   cabalParse = MP.chunk "cabal-" *> version'
   -- parses any path component ending with path separator,
   -- e.g. "foo/"
-  stripPathComponet = parseUntil1 "/" *> MP.chunk "/"
+  stripPathComponet = parseUntil1 pathSep *> pathSep
   -- parses an absolute path up until the last path separator,
   -- e.g. "/bar/baz/foo" -> "/bar/baz/", leaving "foo"
-  stripAbsolutePath = MP.chunk "/" *> MP.many (MP.try stripPathComponet)
+  stripAbsolutePath = pathSep *> MP.many (MP.try stripPathComponet)
   -- parses a relative path up until the last path separator,
   -- e.g. "bar/baz/foo" -> "bar/baz/", leaving "foo"
   stripRelativePath = MP.many (MP.try stripPathComponet)
@@ -342,7 +327,7 @@ cabalSet = do
 -- | Get all installed hls, by matching on
 -- @~\/.ghcup\/bin/haskell-language-server-wrapper-<\hlsver\>@.
 getInstalledHLSs :: (MonadReader AppState m, MonadIO m, MonadCatch m)
-                 => m [Either (Path Rel) Version]
+                 => m [Either FilePath Version]
 getInstalledHLSs = do
   AppState { dirs = Dirs {..} } <- ask
   bins                          <- liftIO $ handleIO (\_ -> pure []) $ findFiles
@@ -353,12 +338,58 @@ getInstalledHLSs = do
     )
   forM bins $ \f ->
     case
-          fmap (version . decUTF8Safe) . B.stripPrefix "haskell-language-server-wrapper-" . toFilePath $ f
+          fmap (version . T.pack . dropSuffix exeExt) . stripPrefix "haskell-language-server-wrapper-" $ f
       of
         Just (Right r) -> pure $ Right r
         Just (Left  _) -> pure $ Left f
         Nothing        -> pure $ Left f
 
+-- | Get all installed stacks, by matching on
+-- @~\/.ghcup\/bin/stack-<\stackver\>@.
+getInstalledStacks :: (MonadReader AppState m, MonadIO m, MonadCatch m)
+                   => m [Either FilePath Version]
+getInstalledStacks = do
+  AppState { dirs = Dirs {..} } <- ask
+  bins                          <- liftIO $ handleIO (\_ -> pure []) $ findFiles
+    binDir
+    (makeRegexOpts compExtended
+                   execBlank
+                   ([s|^stack-.*$|] :: ByteString)
+    )
+  forM bins $ \f ->
+    case
+          fmap (version . T.pack . dropSuffix exeExt) . stripPrefix "stack-" $ f
+      of
+        Just (Right r) -> pure $ Right r
+        Just (Left  _) -> pure $ Left f
+        Nothing        -> pure $ Left f
+
+-- Return the currently set stack version, if any.
+-- TODO: there's a lot of code duplication here :>
+stackSet :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
+stackSet = do
+  AppState {dirs = Dirs {..}} <- ask
+  let stackBin = binDir </> "stack" <> exeExt
+
+  liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ do
+    broken <- isBrokenSymlink stackBin
+    if broken
+      then pure Nothing
+      else do
+        link <- liftIO $ getSymbolicLinkTarget stackBin
+        Just <$> linkVersion link
+ where
+  linkVersion :: MonadThrow m => FilePath -> m Version
+  linkVersion = throwEither . MP.parse parser "" . T.pack . dropSuffix exeExt
+   where
+    parser =
+      MP.chunk "stack-" *> version'
+
+-- | Whether the given Stack version is installed.
+stackInstalled :: (MonadIO m, MonadReader AppState m, MonadCatch m) => Version -> m Bool
+stackInstalled ver = do
+  vers <- fmap rights getInstalledStacks
+  pure $ elem ver vers
 
 -- | Whether the given HLS version is installed.
 hlsInstalled :: (MonadIO m, MonadReader AppState m, MonadCatch m) => Version -> m Bool
@@ -372,20 +403,18 @@ hlsInstalled ver = do
 hlsSet :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
 hlsSet = do
   AppState {dirs = Dirs {..}} <- ask
-  let hlsBin = binDir </> [rel|haskell-language-server-wrapper|]
+  let hlsBin = binDir </> "haskell-language-server-wrapper" <> exeExt
 
   liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ do
     broken <- isBrokenSymlink hlsBin
     if broken
       then pure Nothing
       else do
-        link <- readSymbolicLink $ toFilePath hlsBin
+        link <- liftIO $ getSymbolicLinkTarget hlsBin
         Just <$> linkVersion link
  where
-  linkVersion :: MonadThrow m => ByteString -> m Version
+  linkVersion :: MonadThrow m => FilePath -> m Version
-  linkVersion bs = do
+  linkVersion = throwEither . MP.parse parser "" . T.pack . dropSuffix exeExt
-    t <- throwEither $ E.decodeUtf8' bs
-    throwEither $ MP.parse parser "" t
    where
     parser =
       MP.chunk "haskell-language-server-wrapper-" *> version'
@@ -404,13 +433,12 @@ hlsGHCVersions = do
     bins <- hlsServerBinaries h'
     pure $ fmap
       (version
-        . decUTF8Safe
+        . T.pack
         . fromJust
-        . B.stripPrefix "haskell-language-server-"
+        . stripPrefix "haskell-language-server-"
         . head
-        . B.split _tilde
+        . splitOn "~"
-        . toFilePath
+        )
-      )
       bins
   pure . rights . concat . maybeToList $ vers
 
@@ -418,7 +446,7 @@ hlsGHCVersions = do
 -- | Get all server binaries for an hls version, if any.
 hlsServerBinaries :: (MonadReader AppState m, MonadIO m)
                   => Version
-                  -> m [Path Rel]
+                  -> m [FilePath]
 hlsServerBinaries ver = do
   AppState { dirs = Dirs {..} } <- ask
   liftIO $ handleIO (\_ -> pure []) $ findFiles
@@ -426,7 +454,7 @@ hlsServerBinaries ver = do
     (makeRegexOpts
       compExtended
       execBlank
-      ([s|^haskell-language-server-.*~|] <> escapeVerRex ver <> [s|$|] :: ByteString
+      ([s|^haskell-language-server-.*~|] <> escapeVerRex ver <> E.encodeUtf8 (T.pack exeExt) <> [s|$|] :: ByteString
       )
     )
 
@@ -434,7 +462,7 @@ hlsServerBinaries ver = do
 -- | Get the wrapper binary for an hls version, if any.
 hlsWrapperBinary :: (MonadReader AppState m, MonadThrow m, MonadIO m)
                  => Version
-                 -> m (Maybe (Path Rel))
+                 -> m (Maybe FilePath)
 hlsWrapperBinary ver = do
   AppState { dirs = Dirs {..} } <- ask
   wrapper                       <- liftIO $ handleIO (\_ -> pure []) $ findFiles
@@ -442,7 +470,7 @@ hlsWrapperBinary ver = do
     (makeRegexOpts
       compExtended
       execBlank
-      ([s|^haskell-language-server-wrapper-|] <> escapeVerRex ver <> [s|$|] :: ByteString
+      ([s|^haskell-language-server-wrapper-|] <> escapeVerRex ver <> E.encodeUtf8 (T.pack exeExt) <> [s|$|] :: ByteString
       )
     )
   case wrapper of
@@ -453,7 +481,7 @@ hlsWrapperBinary ver = do
 
 
 -- | Get all binaries for an hls version, if any.
-hlsAllBinaries :: (MonadReader AppState m, MonadIO m, MonadThrow m) => Version -> m [Path Rel]
+hlsAllBinaries :: (MonadReader AppState m, MonadIO m, MonadThrow m) => Version -> m [FilePath]
 hlsAllBinaries ver = do
   hls     <- hlsServerBinaries ver
   wrapper <- hlsWrapperBinary ver
@@ -461,7 +489,7 @@ hlsAllBinaries ver = do
 
 
 -- | Get the active symlinks for hls.
-hlsSymlinks :: (MonadReader AppState m, MonadIO m, MonadCatch m) => m [Path Rel]
+hlsSymlinks :: (MonadReader AppState m, MonadIO m, MonadCatch m) => m [FilePath]
 hlsSymlinks = do
   AppState { dirs = Dirs {..} } <- ask
   oldSyms                       <- liftIO $ handleIO (\_ -> pure []) $ findFiles
@@ -471,9 +499,8 @@ hlsSymlinks = do
                    ([s|^haskell-language-server-.*$|] :: ByteString)
     )
   filterM
-    ( fmap (== SymbolicLink)
+    ( liftIO
-    . liftIO
+    . pathIsSymbolicLink
-    . getFileType
     . (binDir </>)
     )
     oldSyms
@@ -537,61 +564,61 @@ getLatestGHCFor major' minor' dls =
 
 -- | Unpack an archive to a temporary directory and return that path.
 unpackToDir :: (MonadLogger m, MonadIO m, MonadThrow m)
-            => Path Abs       -- ^ destination dir
+            => FilePath       -- ^ destination dir
-            -> Path Abs       -- ^ archive path
+            -> FilePath       -- ^ archive path
             -> Excepts '[UnknownArchive
 #if !defined(TAR)
                         , ArchiveResult
 #endif
                         ] m ()
-unpackToDir dest av = do
+unpackToDir dfp av = do
-  fp <- decUTF8Safe . toFilePath <$> basename av
+  let fn = takeFileName av
-  let dfp = decUTF8Safe . toFilePath $ dest
+  lift $ $(logInfo) [i|Unpacking: #{fn} to #{dfp}|]
-  lift $ $(logInfo) [i|Unpacking: #{fp} to #{dfp}|]
-  fn <- toFilePath <$> basename av
 
 #if defined(TAR)
   let untar :: MonadIO m => BL.ByteString -> Excepts '[] m ()
-      untar = liftIO . Tar.unpack (toFilePath dest) . Tar.read
+      untar = liftIO . Tar.unpack dfp . Tar.read
 
-      rf :: MonadIO m => Path Abs -> Excepts '[] m BL.ByteString
+      rf :: MonadIO m => FilePath -> Excepts '[] m BL.ByteString
-      rf = liftIO . readFile
+      rf = liftIO . BL.readFile
 #else
   let untar :: MonadIO m => BL.ByteString -> Excepts '[ArchiveResult] m ()
-      untar = lEM . liftIO . runArchiveM . unpackToDirLazy (T.unpack . decUTF8Safe . toFilePath $ dest)
+      untar = lEM . liftIO . runArchiveM . unpackToDirLazy dfp
 
-      rf :: MonadIO m => Path Abs -> Excepts '[ArchiveResult] m BL.ByteString
+      rf :: MonadIO m => FilePath -> Excepts '[ArchiveResult] m BL.ByteString
-      rf = liftIO . readFile
+      rf = liftIO . BL.readFile
 #endif
 
   -- extract, depending on file extension
   if
-    | ".tar.gz" `B.isSuffixOf` fn -> liftE
+    | ".tar.gz" `isSuffixOf` fn -> liftE
       (untar . GZip.decompress =<< rf av)
-    | ".tar.xz" `B.isSuffixOf` fn -> do
+    | ".tar.xz" `isSuffixOf` fn -> do
       filecontents <- liftE $ rf av
       let decompressed = Lzma.decompress filecontents
       liftE $ untar decompressed
-    | ".tar.bz2" `B.isSuffixOf` fn ->
+    | ".tar.bz2" `isSuffixOf` fn ->
       liftE (untar . BZip.decompress =<< rf av)
-    | ".tar" `B.isSuffixOf` fn -> liftE (untar =<< rf av)
+    | ".tar" `isSuffixOf` fn -> liftE (untar =<< rf av)
+    | ".zip" `isSuffixOf` fn ->
+      withArchive av (unpackInto dfp)
     | otherwise -> throwE $ UnknownArchive fn
 
 
 getArchiveFiles :: (MonadLogger m, MonadIO m, MonadThrow m)
-                => Path Abs       -- ^ archive path
+                => FilePath       -- ^ archive path
                 -> Excepts '[UnknownArchive
 #if defined(TAR)
                             , Tar.FormatError
 #else
                             , ArchiveResult
 #endif
-                            ] m [ByteString]
+                            ] m [FilePath]
 getArchiveFiles av = do
-  fn <- toFilePath <$> basename av
+  let fn = takeFileName av
 
 #if defined(TAR)
-  let entries :: Monad m => BL.ByteString -> Excepts '[Tar.FormatError] m [ByteString]
+  let entries :: Monad m => BL.ByteString -> Excepts '[Tar.FormatError] m [FilePath]
       entries =
           lE @Tar.FormatError
           . Tar.foldEntries
@@ -600,41 +627,45 @@ getArchiveFiles av = do
             (\e -> Left e)
           . Tar.read
 
-      rf :: MonadIO m => Path Abs -> Excepts '[Tar.FormatError] m BL.ByteString
+      rf :: MonadIO m => FilePath -> Excepts '[Tar.FormatError] m BL.ByteString
-      rf = liftIO . readFile
+      rf = liftIO . BL.readFile
 #else
-  let entries :: Monad m => BL.ByteString -> Excepts '[ArchiveResult] m [ByteString]
+  let entries :: Monad m => BL.ByteString -> Excepts '[ArchiveResult] m [FilePath]
-      entries = (fmap . fmap) (E.encodeUtf8 . T.pack . filepath) . lE . readArchiveBSL
+      entries = (fmap . fmap) filepath . lE . readArchiveBSL
 
-      rf :: MonadIO m => Path Abs -> Excepts '[ArchiveResult] m BL.ByteString
+      rf :: MonadIO m => FilePath -> Excepts '[ArchiveResult] m BL.ByteString
-      rf = liftIO . readFile
+      rf = liftIO . BL.readFile
 #endif
 
   -- extract, depending on file extension
   if
-    | ".tar.gz" `B.isSuffixOf` fn -> liftE
+    | ".tar.gz" `isSuffixOf` fn -> liftE
       (entries . GZip.decompress =<< rf av)
-    | ".tar.xz" `B.isSuffixOf` fn -> do
+    | ".tar.xz" `isSuffixOf` fn -> do
       filecontents <- liftE $ rf av
       let decompressed = Lzma.decompress filecontents
       liftE $ entries decompressed
-    | ".tar.bz2" `B.isSuffixOf` fn ->
+    | ".tar.bz2" `isSuffixOf` fn ->
       liftE (entries . BZip.decompress =<< rf av)
-    | ".tar" `B.isSuffixOf` fn -> liftE (entries =<< rf av)
+    | ".tar" `isSuffixOf` fn -> liftE (entries =<< rf av)
+    | ".zip" `isSuffixOf` fn ->
+      withArchive av $ do
+        entries' <- getEntries
+        pure $ fmap unEntrySelector $ Map.keys entries'
     | otherwise -> throwE $ UnknownArchive fn
 
 
 intoSubdir :: (MonadLogger m, MonadIO m, MonadThrow m, MonadCatch m)
-           => Path Abs       -- ^ unpacked tar dir
+           => FilePath       -- ^ unpacked tar dir
            -> TarDir         -- ^ how to descend
-           -> Excepts '[TarDirDoesNotExist] m (Path Abs)
+           -> Excepts '[TarDirDoesNotExist] m FilePath
 intoSubdir bdir tardir = case tardir of
   RealDir pr -> do
     whenM (fmap not . liftIO . doesDirectoryExist $ (bdir </> pr))
           (throwE $ TarDirDoesNotExist tardir)
     pure (bdir </> pr)
   RegexDir r -> do
-    let rs = splitOn "/" r
+    let rs = split (`elem` pathSeparators) r
     foldlM
       (\y x ->
         (handleIO (\_ -> pure []) . liftIO . findFiles y . regex $ x) >>= (\case
@@ -695,108 +726,124 @@ getDownloader = ask <&> downloader . settings
     -------------
 
 
-urlBaseName :: MonadThrow m
+urlBaseName :: ByteString  -- ^ the url path (without scheme and host)
-            => ByteString  -- ^ the url path (without scheme and host)
+            -> ByteString
-            -> m (Path Rel)
+urlBaseName = snd . B.breakEnd (== _slash) . urlDecode False
-urlBaseName = parseRel . snd . B.breakEnd (== _slash) . urlDecode False
 
 
 -- | Get tool files from @~\/.ghcup\/bin\/ghc\/\<ver\>\/bin\/\*@
 -- while ignoring @*-\<ver\>@ symlinks and accounting for cross triple prefix.
 --
--- Returns unversioned relative files, e.g.:
+-- Returns unversioned relative files without extension, e.g.:
 --
 --   - @["hsc2hs","haddock","hpc","runhaskell","ghc","ghc-pkg","ghci","runghc","hp2ps"]@
 ghcToolFiles :: (MonadReader AppState m, MonadThrow m, MonadFail m, MonadIO m)
              => GHCTargetVersion
-             -> Excepts '[NotInstalled] m [Path Rel]
+             -> Excepts '[NotInstalled] m [FilePath]
 ghcToolFiles ver = do
   ghcdir <- lift $ ghcupGHCDir ver
-  let bindir = ghcdir </> [rel|bin|]
+  let bindir = ghcdir </> "bin"
 
   -- fail if ghc is not installed
   whenM (fmap not $ liftIO $ doesDirectoryExist ghcdir)
         (throwE (NotInstalled GHC ver))
 
-  files    <- liftIO $ getDirsFiles' bindir
+  files    <- liftIO $ listDirectory bindir
   -- figure out the <ver> suffix, because this might not be `Version` for
   -- alpha/rc releases, but x.y.a.somedate.
 
-  -- for cross, this won't be "ghc", but e.g.
+  ghcIsHadrian    <- liftIO $ isHadrian bindir
-  -- "armv7-unknown-linux-gnueabihf-ghc"
+  onlyUnversioned <- case ghcIsHadrian of
-  [ghcbin] <- liftIO $ findFiles
+    Right () -> pure id
-    bindir
+    Left (fmap (dropSuffix exeExt) -> [ghc, ghc_ver])
-    (makeRegexOpts compExtended
+      | (Just symver) <- stripPrefix (ghc <> "-") ghc_ver
-                   execBlank
+      , not (null symver) -> pure $ filter (\x -> not $ symver `isInfixOf` x)
-                   ([s|^([a-zA-Z0-9_-]*[a-zA-Z0-9_]-)?ghc$|] :: ByteString)
+    _ -> fail "Fatal: Could not find internal GHC version"
-    )
 
-  let ghcbinPath = bindir </> ghcbin
+  pure $ onlyUnversioned $ fmap (dropSuffix exeExt) files
-  ghcIsHadrian    <- liftIO $ isHadrian ghcbinPath
-  onlyUnversioned <- if ghcIsHadrian
-    then pure id
-    else do
-      (Just symver) <-
-        B.stripPrefix (toFilePath ghcbin <> "-") . takeFileName
-          <$> liftIO (readSymbolicLink $ toFilePath ghcbinPath)
-      when (B.null symver)
-           (throwIO $ userError "Fatal: ghc symlink target is broken")
-      pure $ filter (\x -> not $ symver `B.isSuffixOf` toFilePath x)
-
-  pure $ onlyUnversioned files
  where
+  isNotAnyInfix xs t = foldr (\a b -> not (a `isInfixOf` t) && b) True xs
     -- GHC is moving some builds to Hadrian for bindists,
     -- which doesn't create versioned binaries.
     -- https://gitlab.haskell.org/haskell/ghcup-hs/issues/31
-  isHadrian :: Path Abs -- ^ ghcbin path
+  isHadrian :: FilePath -- ^ ghcbin path
-            -> IO Bool
+            -> IO (Either [String] ()) -- ^ Right for Hadrian
-  isHadrian = fmap (/= SymbolicLink) . getFileType
+  isHadrian dir = do
+    -- Non-hadrian has e.g. ["ghc", "ghc-8.10.4"]
+    -- which also requires us to discover the internal version
+    -- to filter the correct tool files.
+    -- We can't use the symlink on windows, so we fall back to some
+    -- more complicated logic.
+    fs <- fmap
+         -- regex over-matches
+         (filter (isNotAnyInfix ["haddock", "ghc-pkg", "ghci"]))
+       $ liftIO $ findFiles
+      dir
+      (makeRegexOpts compExtended
+                     execBlank
+                     -- for cross, this won't be "ghc", but e.g.
+                     -- "armv7-unknown-linux-gnueabihf-ghc"
+                     ([s|^([a-zA-Z0-9_-]*[a-zA-Z0-9_]-)?ghc.*$|] :: ByteString)
+      )
+    if | length fs == 1 -> pure $ Right ()        -- hadrian
+       | length fs == 2 -> pure $ Left
+                              (sortOn length fs)  -- legacy make, result should
+                                                  -- be ["ghc", "ghc-8.10.4"]
+       | otherwise      -> fail "isHadrian failed!"
+
 
 
 -- | This file, when residing in @~\/.ghcup\/ghc\/\<ver\>\/@ signals that
 -- this GHC was built from source. It contains the build config.
-ghcUpSrcBuiltFile :: Path Rel
+ghcUpSrcBuiltFile :: FilePath
-ghcUpSrcBuiltFile = [rel|.ghcup_src_built|]
+ghcUpSrcBuiltFile = ".ghcup_src_built"
 
 
 -- | Calls gmake if it exists in PATH, otherwise make.
 make :: (MonadThrow m, MonadIO m, MonadReader AppState m)
-     => [ByteString]
+     => [String]
-     -> Maybe (Path Abs)
+     -> Maybe FilePath
      -> m (Either ProcessError ())
 make args workdir = do
-  spaths    <- catMaybes . fmap parseAbs <$> liftIO getSearchPath
+  spaths    <- liftIO getSearchPath
-  has_gmake <- isJust <$> liftIO (searchPath spaths [rel|gmake|])
+  has_gmake <- isJust <$> liftIO (searchPath spaths "gmake")
   let mymake = if has_gmake then "gmake" else "make"
-  execLogged mymake True args [rel|ghc-make|] workdir Nothing
+  execLogged mymake args workdir "ghc-make" Nothing
+
+makeOut :: [String]
+        -> Maybe FilePath
+        -> IO CapturedProcess
+makeOut args workdir = do
+  spaths    <- liftIO getSearchPath
+  has_gmake <- isJust <$> liftIO (searchPath spaths "gmake")
+  let mymake = if has_gmake then "gmake" else "make"
+  liftIO $ executeOut mymake args workdir
 
 
 -- | Try to apply patches in order. Fails with 'PatchFailed'
 -- on first failure.
 applyPatches :: (MonadLogger m, MonadIO m)
-             => Path Abs   -- ^ dir containing patches
+             => FilePath   -- ^ dir containing patches
-             -> Path Abs   -- ^ dir to apply patches in
+             -> FilePath   -- ^ dir to apply patches in
              -> Excepts '[PatchFailed] m ()
 applyPatches pdir ddir = do
-  patches <- liftIO $ getDirsFiles pdir
+  patches <- (fmap . fmap) (pdir </>) $ liftIO $ listDirectory pdir
   forM_ (sort patches) $ \patch' -> do
     lift $ $(logInfo) [i|Applying patch #{patch'}|]
     fmap (either (const Nothing) Just)
          (liftIO $ exec
            "patch"
-           True
+           ["-p1", "-i", patch']
-           ["-p1", "-i", toFilePath patch']
            (Just ddir)
            Nothing)
       !? PatchFailed
 
 
 -- | https://gitlab.haskell.org/ghc/ghc/-/issues/17353
-darwinNotarization :: Platform -> Path Abs -> IO (Either ProcessError ())
+darwinNotarization :: Platform -> FilePath -> IO (Either ProcessError ())
 darwinNotarization Darwin path = exec
   "xattr"
-  True
+  ["-r", "-d", "com.apple.quarantine", path]
-  ["-r", "-d", "com.apple.quarantine", toFilePath path]
   Nothing
   Nothing
 darwinNotarization _ _ = pure $ Right ()
@@ -814,19 +861,19 @@ getChangeLog dls tool (Right tag) =
 --   1. the build directory, depending on the KeepDirs setting
 --   2. the install destination, depending on whether the build failed
 runBuildAction :: (Show (V e), MonadReader AppState m, MonadIO m, MonadMask m)
-               => Path Abs          -- ^ build directory (cleaned up depending on Settings)
+               => FilePath          -- ^ build directory (cleaned up depending on Settings)
-               -> Maybe (Path Abs)  -- ^ dir to *always* clean up on exception
+               -> Maybe FilePath  -- ^ dir to *always* clean up on exception
                -> Excepts e m a
                -> Excepts '[BuildFailed] m a
 runBuildAction bdir instdir action = do
   AppState { settings = Settings {..} } <- lift ask
   let exAction = do
         forM_ instdir $ \dir ->
-          liftIO $ hideError doesNotExistErrorType $ deleteDirRecursive dir
+          liftIO $ hideError doesNotExistErrorType $ removeDirectoryRecursive dir
         when (keepDirs == Never)
           $ liftIO
           $ hideError doesNotExistErrorType
-          $ deleteDirRecursive bdir
+          $ removeDirectoryRecursive bdir
   v <-
     flip onException exAction
     $ catchAllE
@@ -835,32 +882,90 @@ runBuildAction bdir instdir action = do
           throwE (BuildFailed bdir es)
         ) action
 
-  when (keepDirs == Never || keepDirs == Errors) $ liftIO $ deleteDirRecursive
+  when (keepDirs == Never || keepDirs == Errors) $ liftIO $ removeDirectoryRecursive
     bdir
   pure v
 
 
 -- | More permissive version of 'createDirRecursive'. This doesn't
 -- error when the destination is a symlink to a directory.
-createDirRecursive' :: Path b -> IO ()
+createDirRecursive' :: FilePath -> IO ()
 createDirRecursive' p =
   handleIO (\e -> if isAlreadyExistsError e then isSymlinkDir e else throwIO e)
-    . createDirRecursive newDirPerms
+    . createDirectoryIfMissing True
     $ p
 
  where
   isSymlinkDir e = do
-    ft <- getFileType p
+    ft <- pathIsSymbolicLink p
     case ft of
-      SymbolicLink -> do
+      True -> do
         rp <- canonicalizePath p
-        rft <- getFileType rp
+        rft <- doesDirectoryExist rp
         case rft of
-          Directory -> pure ()
+          True -> pure ()
           _ -> throwIO e
       _ -> throwIO e
 
 
+-- | Recursively copy the contents of one directory to another path.
+--
+-- This is a rip-off of Cabal library.
+copyDirectoryRecursive :: FilePath -> FilePath -> IO ()
+copyDirectoryRecursive srcDir destDir = do
+  srcFiles <- getDirectoryContentsRecursive srcDir
+  copyFilesWith copyFile destDir [ (srcDir, f)
+                                   | f <- srcFiles ]
+  where
+    -- | Common implementation of 'copyFiles', 'installOrdinaryFiles',
+    -- 'installExecutableFiles' and 'installMaybeExecutableFiles'.
+    copyFilesWith :: (FilePath -> FilePath -> IO ())
+                  -> FilePath -> [(FilePath, FilePath)] -> IO ()
+    copyFilesWith doCopy targetDir srcFiles = do
+
+      -- Create parent directories for everything
+      let dirs = map (targetDir </>) . nub . map (takeDirectory . snd) $ srcFiles
+      traverse_ (createDirectoryIfMissing True) dirs
+
+      -- Copy all the files
+      sequence_ [ let src  = srcBase   </> srcFile
+                      dest = targetDir </> srcFile
+                   in doCopy src dest
+                | (srcBase, srcFile) <- srcFiles ]
+
+    -- | List all the files in a directory and all subdirectories.
+    --
+    -- The order places files in sub-directories after all the files in their
+    -- parent directories. The list is generated lazily so is not well defined if
+    -- the source directory structure changes before the list is used.
+    --
+    getDirectoryContentsRecursive :: FilePath -> IO [FilePath]
+    getDirectoryContentsRecursive topdir = recurseDirectories [""]
+      where
+        recurseDirectories :: [FilePath] -> IO [FilePath]
+        recurseDirectories []         = return []
+        recurseDirectories (dir:dirs) = unsafeInterleaveIO $ do
+          (files, dirs') <- collect [] [] =<< getDirectoryContents (topdir </> dir)
+          files' <- recurseDirectories (dirs' ++ dirs)
+          return (files ++ files')
+
+          where
+            collect files dirs' []              = return (reverse files
+                                                         ,reverse dirs')
+            collect files dirs' (entry:entries) | ignore entry
+                                                = collect files dirs' entries
+            collect files dirs' (entry:entries) = do
+              let dirEntry = dir </> entry
+              isDirectory <- doesDirectoryExist (topdir </> dirEntry)
+              if isDirectory
+                then collect files (dirEntry:dirs') entries
+                else collect (dirEntry:files) dirs' entries
+
+            ignore ['.']      = True
+            ignore ['.', '.'] = True
+            ignore _          = False
+
+
 getVersionInfo :: Version
                -> Tool
                -> GHCupDownloads
@@ -881,3 +986,13 @@ traverseFold f = foldl (\mb a -> (<>) <$> mb <*> f a) (pure mempty)
 -- | Gathering monoidal values
 forFold :: (Foldable t, Applicative m, Monoid b) => t a -> (a -> m b) -> m b
 forFold = \t -> (`traverseFold` t)
+
+
+-- | The file extension for executables.
+exeExt :: String
+#if defined(IS_WINDOWS)
+exeExt = ".exe"
+#else
+exeExt = ""
+#endif
+

lib/GHCup/Utils/Dirs.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP                   #-}
 {-# LANGUAGE DataKinds             #-}
 {-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE FlexibleContexts      #-}
@@ -12,7 +13,7 @@ Copyright   : (c) Julian Ospald, 2020
 License     : LGPL-3.0
 Maintainer  : hasufell@hasufell.de
 Stability   : experimental
-Portability : POSIX
+Portability : portable
 -}
 module GHCup.Utils.Dirs
   ( getDirs
@@ -34,7 +35,6 @@ import           GHCup.Types.JSON               ( )
 import           GHCup.Utils.MegaParsec
 import           GHCup.Utils.Prelude
 
-import           Control.Applicative
 import           Control.Exception.Safe
 import           Control.Monad
 import           Control.Monad.IO.Unlift
@@ -42,32 +42,20 @@ import           Control.Monad.Logger
 import           Control.Monad.Reader
 import           Control.Monad.Trans.Resource hiding (throwM)
 import           Data.Bifunctor
-import           Data.ByteString                ( ByteString )
 import           Data.Maybe
 import           Data.String.Interpolate
 import           GHC.IO.Exception               ( IOErrorType(NoSuchThing) )
 import           Haskus.Utils.Variant.Excepts
-import           HPath
-import           HPath.IO
 import           Optics
-import           Prelude                 hiding ( abs
+import           System.Directory
-                                                , readFile
-                                                , writeFile
-                                                )
 import           System.DiskSpace                                                
-import           System.Posix.Env.ByteString    ( getEnv
+import           System.Environment
-                                                , getEnvDefault
+import           System.FilePath
-                                                )
+import           System.IO.Temp
-import           System.Posix.FilePath   hiding ( (</>) )
-import           System.Posix.Temp.ByteString   ( mkdtemp )
 
-import qualified Data.ByteString.Lazy          as L
+import qualified Data.ByteString               as BS
-import qualified Data.ByteString.UTF8          as UTF8
 import qualified Data.Text                     as T
-import qualified Data.Text.Encoding            as E
 import qualified Data.Yaml                     as Y
-import qualified System.Posix.FilePath         as FP
-import qualified System.Posix.User             as PU
 import qualified Text.Megaparsec               as MP
 import Control.Concurrent (threadDelay)
 
@@ -82,96 +70,96 @@ import Control.Concurrent (threadDelay)
 --
 -- If 'GHCUP_USE_XDG_DIRS' is set (to anything),
 -- then uses 'XDG_DATA_HOME/ghcup' as per xdg spec.
-ghcupBaseDir :: IO (Path Abs)
+ghcupBaseDir :: IO FilePath
 ghcupBaseDir = do
   xdg <- useXDG
   if xdg
     then do
-      bdir <- getEnv "XDG_DATA_HOME" >>= \case
+      bdir <- lookupEnv "XDG_DATA_HOME" >>= \case
-        Just r  -> parseAbs r
+        Just r  -> pure r
         Nothing -> do
           home <- liftIO getHomeDirectory
-          pure (home </> [rel|.local/share|])
+          pure (home </> ".local" </> "share")
-      pure (bdir </> [rel|ghcup|])
+      pure (bdir </> "ghcup")
     else do
-      bdir <- getEnv "GHCUP_INSTALL_BASE_PREFIX" >>= \case
+      bdir <- lookupEnv "GHCUP_INSTALL_BASE_PREFIX" >>= \case
-        Just r  -> parseAbs r
+        Just r  -> pure r
         Nothing -> liftIO getHomeDirectory
-      pure (bdir </> [rel|.ghcup|])
+      pure (bdir </> ".ghcup")
 
 
 -- | ~/.ghcup by default
 --
 -- If 'GHCUP_USE_XDG_DIRS' is set (to anything),
 -- then uses 'XDG_CONFIG_HOME/ghcup' as per xdg spec.
-ghcupConfigDir :: IO (Path Abs)
+ghcupConfigDir :: IO FilePath
 ghcupConfigDir = do
   xdg <- useXDG
   if xdg
     then do
-      bdir <- getEnv "XDG_CONFIG_HOME" >>= \case
+      bdir <- lookupEnv "XDG_CONFIG_HOME" >>= \case
-        Just r  -> parseAbs r
+        Just r  -> pure r
         Nothing -> do
           home <- liftIO getHomeDirectory
-          pure (home </> [rel|.config|])
+          pure (home </> ".config")
-      pure (bdir </> [rel|ghcup|])
+      pure (bdir </> "ghcup")
     else do
-      bdir <- getEnv "GHCUP_INSTALL_BASE_PREFIX" >>= \case
+      bdir <- lookupEnv "GHCUP_INSTALL_BASE_PREFIX" >>= \case
-        Just r  -> parseAbs r
+        Just r  -> pure r
         Nothing -> liftIO getHomeDirectory
-      pure (bdir </> [rel|.ghcup|])
+      pure (bdir </> ".ghcup")
 
 
 -- | If 'GHCUP_USE_XDG_DIRS' is set (to anything),
 -- then uses 'XDG_BIN_HOME' env var or defaults to '~/.local/bin'
 -- (which, sadly is not strictly xdg spec).
-ghcupBinDir :: IO (Path Abs)
+ghcupBinDir :: IO FilePath
 ghcupBinDir = do
   xdg <- useXDG
   if xdg
     then do
-      getEnv "XDG_BIN_HOME" >>= \case
+      lookupEnv "XDG_BIN_HOME" >>= \case
-        Just r  -> parseAbs r
+        Just r  -> pure r
         Nothing -> do
           home <- liftIO getHomeDirectory
-          pure (home </> [rel|.local/bin|])
+          pure (home </> ".local" </> "bin")
-    else ghcupBaseDir <&> (</> [rel|bin|])
+    else ghcupBaseDir <&> (</> "bin")
 
 
 -- | Defaults to '~/.ghcup/cache'.
 --
 -- If 'GHCUP_USE_XDG_DIRS' is set (to anything),
 -- then uses 'XDG_CACHE_HOME/ghcup' as per xdg spec.
-ghcupCacheDir :: IO (Path Abs)
+ghcupCacheDir :: IO FilePath
 ghcupCacheDir = do
   xdg <- useXDG
   if xdg
     then do
-      bdir <- getEnv "XDG_CACHE_HOME" >>= \case
+      bdir <- lookupEnv "XDG_CACHE_HOME" >>= \case
-        Just r  -> parseAbs r
+        Just r  -> pure r
         Nothing -> do
           home <- liftIO getHomeDirectory
-          pure (home </> [rel|.cache|])
+          pure (home </> ".cache")
-      pure (bdir </> [rel|ghcup|])
+      pure (bdir </> "ghcup")
-    else ghcupBaseDir <&> (</> [rel|cache|])
+    else ghcupBaseDir <&> (</> "cache")
 
 
 -- | Defaults to '~/.ghcup/logs'.
 --
 -- If 'GHCUP_USE_XDG_DIRS' is set (to anything),
 -- then uses 'XDG_CACHE_HOME/ghcup/logs' as per xdg spec.
-ghcupLogsDir :: IO (Path Abs)
+ghcupLogsDir :: IO FilePath
 ghcupLogsDir = do
   xdg <- useXDG
   if xdg
     then do
-      bdir <- getEnv "XDG_CACHE_HOME" >>= \case
+      bdir <- lookupEnv "XDG_CACHE_HOME" >>= \case
-        Just r  -> parseAbs r
+        Just r  -> pure r
         Nothing -> do
           home <- liftIO getHomeDirectory
-          pure (home </> [rel|.cache|])
+          pure (home </> ".cache")
-      pure (bdir </> [rel|ghcup/logs|])
+      pure (bdir </> "ghcup" </> "logs")
-    else ghcupBaseDir <&> (</> [rel|logs|])
+    else ghcupBaseDir <&> (</> "logs")
 
 
 getDirs :: IO Dirs
@@ -194,11 +182,11 @@ ghcupConfigFile :: (MonadIO m)
                 => Excepts '[JSONError] m UserSettings
 ghcupConfigFile = do
   confDir <- liftIO ghcupConfigDir
-  let file = confDir </> [rel|config.yaml|]
+  let file = confDir </> "config.yaml"
-  bs <- liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ Just <$> readFile file
+  contents <- liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ Just <$> BS.readFile file
-  case bs of
+  case contents of
       Nothing -> pure defaultUserSettings
-      Just bs' -> lE' JSONDecodeError . first show . Y.decodeEither' . L.toStrict $ bs'
+      Just contents' -> lE' JSONDecodeError . first show . Y.decodeEither' $ contents'
 
 
     -------------------------
@@ -207,10 +195,10 @@ ghcupConfigFile = do
 
 
 -- | ~/.ghcup/ghc by default.
-ghcupGHCBaseDir :: (MonadReader AppState m) => m (Path Abs)
+ghcupGHCBaseDir :: (MonadReader AppState m) => m FilePath
 ghcupGHCBaseDir = do
   AppState { dirs = Dirs {..} } <- ask
-  pure (baseDir </> [rel|ghc|])
+  pure (baseDir </> "ghc")
 
 
 -- | Gets '~/.ghcup/ghc/<ghcupGHCDir>'.
@@ -219,35 +207,32 @@ ghcupGHCBaseDir = do
 --   * 8.8.4
 ghcupGHCDir :: (MonadReader AppState m, MonadThrow m)
             => GHCTargetVersion
-            -> m (Path Abs)
+            -> m FilePath
 ghcupGHCDir ver = do
-  ghcbasedir    <- ghcupGHCBaseDir
+  ghcbasedir <- ghcupGHCBaseDir
-  verdir        <- parseRel $ E.encodeUtf8 (tVerToText ver)
+  let verdir = T.unpack $ tVerToText ver
   pure (ghcbasedir </> verdir)
 
 
 -- | See 'ghcupToolParser'.
-parseGHCupGHCDir :: MonadThrow m => Path Rel -> m GHCTargetVersion
+parseGHCupGHCDir :: MonadThrow m => FilePath -> m GHCTargetVersion
-parseGHCupGHCDir (toFilePath -> f) = do
+parseGHCupGHCDir (T.pack -> fp) =
-  fp <- throwEither $ E.decodeUtf8' f
   throwEither $ MP.parse ghcTargetVerP "" fp
 
 
-mkGhcupTmpDir :: (MonadUnliftIO m, MonadLogger m, MonadCatch m, MonadThrow m, MonadIO m) => m (Path Abs)
+mkGhcupTmpDir :: (MonadUnliftIO m, MonadLogger m, MonadCatch m, MonadThrow m, MonadIO m) => m FilePath
 mkGhcupTmpDir = do
-  tmpdir <- liftIO $ getEnvDefault "TMPDIR" "/tmp"
+  tmpdir <- liftIO getCanonicalTemporaryDirectory
-  let fp = T.unpack $ decUTF8Safe tmpdir
 
   let minSpace = 5000 -- a rough guess, aight?
-  space <- handleIO (\_ -> pure Nothing) $ fmap Just $ liftIO $ getAvailSpace fp
+  space <- handleIO (\_ -> pure Nothing) $ fmap Just $ liftIO $ getAvailSpace tmpdir
   when (maybe False (toBytes minSpace >) space) $ do
-    $(logWarn) [i|Possibly insufficient disk space on #{fp}. At least #{minSpace} MB are recommended, but only #{toMB (fromJust space)} are free. Consider freeing up disk space or setting TMPDIR env variable.|]
+    $(logWarn) [i|Possibly insufficient disk space on #{tmpdir}. At least #{minSpace} MB are recommended, but only #{toMB (fromJust space)} are free. Consider freeing up disk space or setting TMPDIR env variable.|]
     $(logWarn)
       "...waiting for 10 seconds before continuing anyway, you can still abort..."
     liftIO $ threadDelay 10000000 -- give the user a sec to intervene
 
-  tmp <- liftIO $ mkdtemp (tmpdir FP.</> "ghcup-")
+  liftIO $ createTempDirectory tmpdir "ghcup"
-  parseAbs tmp
  where
   toBytes mb = mb * 1024 * 1024
   toMB b = show (truncate' (fromIntegral b / (1024 * 1024) :: Double) 2)
@@ -256,8 +241,8 @@ mkGhcupTmpDir = do
       where t = 10^n
 
 
-withGHCupTmpDir :: (MonadUnliftIO m, MonadLogger m, MonadCatch m, MonadResource m, MonadThrow m, MonadIO m) => m (Path Abs)
+withGHCupTmpDir :: (MonadUnliftIO m, MonadLogger m, MonadCatch m, MonadResource m, MonadThrow m, MonadIO m) => m FilePath
-withGHCupTmpDir = snd <$> withRunInIO (\run -> run $ allocate (run mkGhcupTmpDir) deleteDirRecursive)
+withGHCupTmpDir = snd <$> withRunInIO (\run -> run $ allocate (run mkGhcupTmpDir) removeDirectoryRecursive)
 
 
 
@@ -267,29 +252,19 @@ withGHCupTmpDir = snd <$> withRunInIO (\run -> run $ allocate (run mkGhcupTmpDir
     --------------
 
 
-getHomeDirectory :: IO (Path Abs)
-getHomeDirectory = do
-  e <- getEnv "HOME"
-  case e of
-    Just fp -> parseAbs fp
-    Nothing -> do
-      h <- PU.homeDirectory <$> (PU.getEffectiveUserID >>= PU.getUserEntryForID)
-      parseAbs $ UTF8.fromString h -- this is a guess
-
-
 useXDG :: IO Bool
-useXDG = isJust <$> getEnv "GHCUP_USE_XDG_DIRS"
+useXDG = isJust <$> lookupEnv "GHCUP_USE_XDG_DIRS"
 
 
-relativeSymlink :: Path Abs  -- ^ the path in which to create the symlink
+relativeSymlink :: FilePath  -- ^ the path in which to create the symlink
-                -> Path Abs  -- ^ the symlink destination
+                -> FilePath  -- ^ the symlink destination
-                -> ByteString
+                -> FilePath
-relativeSymlink (toFilePath -> p1) (toFilePath -> p2) =
+relativeSymlink p1 p2 =
   let d1      = splitDirectories p1
       d2      = splitDirectories p2
       common  = takeWhile (\(x, y) -> x == y) $ zip d1 d2
       cPrefix = drop (length common) d1
   in  joinPath (replicate (length cPrefix) "..")
-        <> joinPath ("/" : drop (length common) d2)
+        <> joinPath ([pathSeparator] : drop (length common) d2)
 
 

lib/GHCup/Utils/File.hs

@@ -1,494 +1,17 @@
-{-# LANGUAGE QuasiQuotes       #-}
+{-# LANGUAGE CPP #-}
-{-# LANGUAGE OverloadedStrings #-}
+
-{-# LANGUAGE FlexibleContexts  #-}
+module GHCup.Utils.File (
-{-# LANGUAGE TemplateHaskell   #-}
+  module GHCup.Utils.File.Common,
-{-# LANGUAGE ViewPatterns      #-}
+#if IS_WINDOWS
-
+  module GHCup.Utils.File.Windows
-{-|
+#else
-Module      : GHCup.Utils.File
+  module GHCup.Utils.File.Posix
-Description : File and unix APIs
+#endif
-Copyright   : (c) Julian Ospald, 2020
+) where
-License     : LGPL-3.0
+
-Maintainer  : hasufell@hasufell.de
+import GHCup.Utils.File.Common
-Stability   : experimental
+#if IS_WINDOWS
-Portability : POSIX
+import GHCup.Utils.File.Windows
-
+#else
-This module handles file and executable handling.
+import GHCup.Utils.File.Posix
-Some of these functions use sophisticated logging.
+#endif
--}
-module GHCup.Utils.File where
-
-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
-import           Control.Monad.Logger
-import           Control.Monad.Reader
-import           Control.Monad.Trans.State.Strict
-import           Data.ByteString                ( ByteString )
-import           Data.Foldable
-import           Data.Functor
-import           Data.IORef
-import           Data.Maybe
-import           Data.Sequence                  ( Seq, (|>) )
-import           Data.String.Interpolate
-import           Data.Text                      ( Text )
-import           Data.Void
-import           Data.Word8
-import           GHC.IO.Exception
-import           HPath
-import           HPath.IO                hiding ( hideError )
-import           Optics                  hiding ((<|), (|>))
-import           System.Console.Pretty   hiding ( Pretty )
-import           System.Console.Regions
-import           System.IO.Error
-import           System.Posix.Directory.ByteString
-import           System.Posix.FD               as FD
-import           System.Posix.FilePath   hiding ( (</>) )
-import           System.Posix.Files.ByteString
-import           System.Posix.Foreign           ( oExcl )
-import "unix"    System.Posix.IO.ByteString
-                                         hiding ( openFd )
-import           System.Posix.Process           ( ProcessStatus(..) )
-import           System.Posix.Types
-import           Text.PrettyPrint.HughesPJClass hiding ( (<>) )
-import           Text.Regex.Posix
-
-
-import qualified Control.Exception             as EX
-import qualified Data.Sequence                 as Sq
-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
-import qualified Streamly.Prelude              as S
-import qualified Text.Megaparsec               as MP
-import qualified Data.ByteString               as BS
-import qualified "unix-bytestring" System.Posix.IO.ByteString
-                                               as SPIB
-
-
-
-data ProcessError = NonZeroExit Int ByteString [ByteString]
-                  | PTerminated ByteString [ByteString]
-                  | PStopped ByteString [ByteString]
-                  | NoSuchPid ByteString [ByteString]
-                  deriving Show
-
-instance Pretty ProcessError where
-  pPrint (NonZeroExit e exe args) =
-    text [i|Process "#{decUTF8Safe exe}" with arguments #{fmap decUTF8Safe args} failed with exit code #{e}.|]
-  pPrint (PTerminated exe args) =
-    text [i|Process "#{decUTF8Safe exe}" with arguments #{fmap decUTF8Safe args} terminated.|]
-  pPrint (PStopped exe args) =
-    text [i|Process "#{decUTF8Safe exe}" with arguments #{fmap decUTF8Safe args} stopped.|]
-  pPrint (NoSuchPid exe args) =
-    text [i|Could not find PID for process running "#{decUTF8Safe exe}" with arguments #{fmap decUTF8Safe args}.|]
-
-data CapturedProcess = CapturedProcess
-  { _exitCode :: ExitCode
-  , _stdOut   :: ByteString
-  , _stdErr   :: ByteString
-  }
-  deriving (Eq, Show)
-
-makeLenses ''CapturedProcess
-
-
--- | Find the given executable by searching all *absolute* PATH components.
--- Relative paths in PATH are ignored.
---
--- This shouldn't throw IO exceptions, unless getting the environment variable
--- PATH does.
-findExecutable :: Path Rel -> IO (Maybe (Path Abs))
-findExecutable ex = do
-  sPaths <- fmap (catMaybes . fmap parseAbs) getSearchPath
-  -- We don't want exceptions to mess up our result. If we can't
-  -- figure out if a file exists, then treat it as a negative result.
-  asum $ fmap
-    (handleIO (\_ -> pure Nothing)
-      -- asum for short-circuiting behavior
-      . (\s' -> (isExecutable (s' </> ex) >>= guard) $> Just (s' </> ex))
-    )
-    sPaths
-
-
--- | 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'
-           -> [ByteString]      -- ^ arguments to the command
-           -> Maybe (Path Abs)  -- ^ chdir to this path
-           -> IO CapturedProcess
-executeOut path args chdir = captureOutStreams $ do
-  maybe (pure ()) (changeWorkingDirectory . toFilePath) chdir
-  SPPB.executeFile (toFilePath path) True args Nothing
-
-
-execLogged :: (MonadReader AppState m, MonadIO m, MonadThrow m)
-           => ByteString       -- ^ thing to execute
-           -> Bool             -- ^ whether to search PATH for the thing
-           -> [ByteString]     -- ^ args for the thing
-           -> Path Rel         -- ^ log filename
-           -> Maybe (Path Abs) -- ^ optionally chdir into this
-           -> Maybe [(ByteString, ByteString)] -- ^ optional environment
-           -> m (Either ProcessError ())
-execLogged exe spath args lfile chdir env = do
-  AppState { settings = Settings {..}, dirs = Dirs {..} } <- ask
-  logfile       <- (logsDir </>) <$> parseRel (toFilePath lfile <> ".log")
-  liftIO $ bracket (createFile (toFilePath logfile) newFilePerms)
-                   closeFd
-                   (action verbose)
- where
-  action verbose fd = do
-    actionWithPipes $ \(stdoutRead, stdoutWrite) -> do
-      -- start the thread that logs to stdout
-      pState <- newEmptyMVar
-      done   <- newEmptyMVar
-      void
-        $ forkIO
-        $ EX.handle (\(_ :: IOException) -> pure ())
-        $ EX.finally
-            (if verbose
-              then tee fd stdoutRead
-              else printToRegion fd stdoutRead 6 pState
-            )
-            (putMVar done ())
-
-      -- fork the subprocess
-      pid <- SPPB.forkProcess $ do
-        void $ dupTo stdoutWrite stdOutput
-        void $ dupTo stdoutWrite stdError
-        closeFd stdoutRead
-        closeFd stdoutWrite
-
-        -- execute the action
-        maybe (pure ()) (changeWorkingDirectory . toFilePath) chdir
-        void $ SPPB.executeFile exe spath args env
-
-      closeFd stdoutWrite
-
-      -- wait for the subprocess to finish
-      e <- toProcessError exe args <$!> SPPB.getProcessStatus True True pid
-      putMVar pState (either (const False) (const True) e)
-
-      void $ race (takeMVar done) (threadDelay (1000000 * 3))
-      closeFd stdoutRead
-
-      pure e
-
-  tee :: Fd -> Fd -> IO ()
-  tee fileFd fdIn = readTilEOF lineAction fdIn
-
-   where
-    lineAction :: ByteString -> IO ()
-    lineAction bs' = do
-      void $ SPIB.fdWrite fileFd (bs' <> "\n")
-      void $ SPIB.fdWrite stdOutput (bs' <> "\n")
-
-  -- Reads fdIn and logs the output in a continous scrolling area
-  -- of 'size' terminal lines. Also writes to a log file.
-  printToRegion :: Fd -> Fd -> Int -> MVar Bool -> IO ()
-  printToRegion fileFd fdIn size pState = do
-    void $ displayConsoleRegions $ do
-      rs <-
-        liftIO
-        . fmap Sq.fromList
-        . sequence
-        . replicate size
-        . openConsoleRegion
-        $ Linear
-      flip runStateT mempty
-        $ handle
-            (\(ex :: SomeException) -> do
-              ps <- liftIO $ takeMVar pState
-              when ps (forM_ rs (liftIO . closeConsoleRegion))
-              throw ex
-            )
-        $ readTilEOF (lineAction rs) fdIn
-
-   where
-    -- action to perform line by line
-    -- TODO: do this with vty for efficiency
-    lineAction :: (MonadMask m, MonadIO m)
-               => Seq ConsoleRegion
-               -> ByteString
-               -> StateT (Seq ByteString) m ()
-    lineAction rs = \bs' -> do
-      void $ liftIO $ SPIB.fdWrite fileFd (bs' <> "\n")
-      modify (swapRegs bs')
-      regs <- get
-      liftIO $ forM_ (Sq.zip regs rs) $ \(bs, r) -> setConsoleRegion r $ do
-        w <- consoleWidth
-        return
-          . T.pack
-          . color Blue
-          . T.unpack
-          . decUTF8Safe
-          . trim w
-          . (\b -> "[ " <> toFilePath lfile <> " ] " <> b)
-          $ bs
-
-    swapRegs :: a -> Seq a -> Seq a
-    swapRegs bs = \regs -> if
-      | Sq.length regs < size -> regs |> bs
-      | otherwise             -> Sq.drop 1 regs |> bs
-
-    -- trim output line to terminal width
-    trim :: Int -> ByteString -> ByteString
-    trim w = \bs -> if
-      | 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 = 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
-
-  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
-
-
--- | Capture the stdout and stderr of the given action, which
--- is run in a subprocess. Stdin is closed. You might want to
--- 'race' this to make sure it terminates.
-captureOutStreams :: IO a
-                     -- ^ the action to execute in a subprocess
-                  -> IO CapturedProcess
-captureOutStreams action = do
-  actionWithPipes $ \(parentStdoutRead, childStdoutWrite) ->
-    actionWithPipes $ \(parentStderrRead, childStderrWrite) -> do
-      pid <- SPPB.forkProcess $ do
-        -- dup stdout
-        void $ dupTo childStdoutWrite stdOutput
-        closeFd childStdoutWrite
-        closeFd parentStdoutRead
-
-        -- dup stderr
-        void $ dupTo childStderrWrite stdError
-        closeFd childStderrWrite
-        closeFd parentStderrRead
-
-        -- execute the action
-        a <- action
-        void $ evaluate a
-
-      -- close everything we don't need
-      closeFd childStdoutWrite
-      closeFd childStderrWrite
-
-      -- start thread that writes the output
-      refOut <- newIORef BS.empty
-      refErr <- newIORef BS.empty
-      done   <- newEmptyMVar
-      _      <-
-        forkIO
-        $ EX.handle (\(_ :: IOException) -> pure ())
-        $ flip EX.finally (putMVar done ())
-        $ writeStds parentStdoutRead parentStderrRead refOut refErr
-
-      status <- SPPB.getProcessStatus True True pid
-      void $ race (takeMVar done) (threadDelay (1000000 * 3))
-
-      case status of
-        -- readFd will take care of closing the fd
-        Just (SPPB.Exited es) -> do
-          stdout' <- readIORef refOut
-          stderr' <- readIORef refErr
-          pure $ CapturedProcess { _exitCode = es
-                                 , _stdOut   = stdout'
-                                 , _stdErr   = stderr'
-                                 }
-
-        _ -> throwIO $ userError ("No such PID " ++ show pid)
-
- where
-  writeStds pout perr rout rerr = do
-    doneOut <- newEmptyMVar
-    void
-      $ forkIO
-      $ hideError eofErrorType
-      $ flip EX.finally (putMVar doneOut ())
-      $ readTilEOF (\x -> modifyIORef' rout (<> x)) pout
-    doneErr <- newEmptyMVar
-    void
-      $ forkIO
-      $ hideError eofErrorType
-      $ flip EX.finally (putMVar doneErr ())
-      $ readTilEOF (\x -> modifyIORef' rerr (<> x)) perr
-    takeMVar doneOut
-    takeMVar doneErr
-
-  readTilEOF ~action' fd' = do
-    bs <- SPIB.fdRead fd' 512
-    void $ action' bs
-    readTilEOF action' 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
-
-
-
--- | Create a new regular file in write-only mode. The file must not exist.
-createRegularFileFd :: FileMode -> Path b -> IO Fd
-createRegularFileFd fm dest =
-  FD.openFd (toFilePath dest) WriteOnly [oExcl] (Just fm)
-
-
--- | Thin wrapper around `executeFile`.
-exec :: ByteString       -- ^ thing to execute
-     -> Bool             -- ^ whether to search PATH for the thing
-     -> [ByteString]     -- ^ args for the thing
-     -> Maybe (Path Abs) -- ^ optionally chdir into this
-     -> Maybe [(ByteString, ByteString)] -- ^ optional environment
-     -> IO (Either ProcessError ())
-exec exe spath args chdir env = do
-  pid <- SPPB.forkProcess $ do
-    maybe (pure ()) (changeWorkingDirectory . toFilePath) chdir
-    SPPB.executeFile exe spath args env
-
-  fmap (toProcessError exe args) $ SPPB.getProcessStatus True True pid
-
-
-toProcessError :: ByteString
-               -> [ByteString]
-               -> Maybe ProcessStatus
-               -> Either ProcessError ()
-toProcessError exe args mps = case mps of
-  Just (SPPB.Exited (ExitFailure xi)) -> Left $ NonZeroExit xi exe args
-  Just (SPPB.Exited ExitSuccess    ) -> Right ()
-  Just (Terminated _ _             ) -> Left $ PTerminated exe args
-  Just (Stopped _                  ) -> Left $ PStopped exe args
-  Nothing                            -> Left $ NoSuchPid exe args
-
-
--- | Search for a file in the search paths.
---
--- Catches `PermissionDenied` and `NoSuchThing` and returns `Nothing`.
-searchPath :: [Path Abs] -> Path Rel -> IO (Maybe (Path Abs))
-searchPath paths needle = go paths
- where
-  go [] = pure Nothing
-  go (x : xs) =
-    hideErrorDefM [InappropriateType, PermissionDenied, NoSuchThing] (go xs)
-      $ do
-          dirStream <- openDirStream (toFilePath x)
-          S.findM (\(_, p) -> isMatch x p) (dirContentsStream dirStream)
-            >>= \case
-                  Just _  -> pure $ Just (x </> needle)
-                  Nothing -> go xs
-  isMatch basedir p = do
-    if p == toFilePath needle
-      then isExecutable (basedir </> needle)
-      else pure False
-
-
--- | Check wether a binary is shadowed by another one that comes before
--- it in PATH. Returns the path to said binary, if any.
-isShadowed :: Path Abs -> IO (Maybe (Path Abs))
-isShadowed p = do
-  let dir = dirname p
-  fn <- basename p
-  spaths <- catMaybes . fmap parseAbs <$> liftIO getSearchPath
-  if dir `elem` spaths
-  then do
-    let shadowPaths = takeWhile (/= dir) spaths
-    searchPath shadowPaths fn
-  else pure Nothing
-
-
--- | Check whether the binary is in PATH. This returns only `True`
--- if the directory containing the binary is part of PATH.
-isInPath :: Path Abs -> IO Bool
-isInPath p = do
-  let dir = dirname p
-  fn <- basename p
-  spaths <- catMaybes . fmap parseAbs <$> liftIO getSearchPath
-  if dir `elem` spaths
-  then isJust <$> searchPath [dir] fn
-  else pure False
-
-
-findFiles :: Path Abs -> Regex -> IO [Path Rel]
-findFiles path regex = do
-  dirStream <- openDirStream (toFilePath path)
-  f         <-
-    (fmap . fmap) snd
-    . S.toList
-    . S.filter (\(_, p) -> match regex p)
-    $ dirContentsStream dirStream
-  pure $ parseRel =<< f
-
-
-findFiles' :: Path Abs -> MP.Parsec Void Text () -> IO [Path Rel]
-findFiles' path parser = do
-  dirStream <- openDirStream (toFilePath path)
-  f         <-
-    (fmap . fmap) snd
-    . S.toList
-    . S.filter (\(_, p) -> case E.decodeUtf8' p of
-                             Left _ -> False
-                             Right p' -> isJust $ MP.parseMaybe parser p')
-    $ dirContentsStream dirStream
-  pure $ parseRel =<< f
-
-
-isBrokenSymlink :: Path Abs -> IO Bool
-isBrokenSymlink p =
-  handleIO
-      (\e -> if ioeGetErrorType e == NoSuchThing then pure True else throwIO e)
-    $ do
-        _ <- canonicalizePath p
-        pure False
-
-
-chmod_755 :: (MonadLogger m, MonadIO m) => Path a -> m ()
-chmod_755 (toFilePath -> fp) = do
-  let exe_mode =
-          nullFileMode
-            `unionFileModes` ownerExecuteMode
-            `unionFileModes` ownerReadMode
-            `unionFileModes` ownerWriteMode
-            `unionFileModes` groupExecuteMode
-            `unionFileModes` groupReadMode
-            `unionFileModes` otherExecuteMode
-            `unionFileModes` otherReadMode
-  $(logDebug) [i|chmod 755 #{fp}|]
-  liftIO $ setFileMode fp exe_mode

lib/GHCup/Utils/File/Common.hs

@@ -0,0 +1,122 @@
+{-# LANGUAGE QuasiQuotes       #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE TemplateHaskell   #-}
+{-# LANGUAGE ViewPatterns      #-}
+
+module GHCup.Utils.File.Common where
+
+import           GHCup.Utils.Prelude
+
+import           Control.Exception
+import           Control.Monad.Extra
+import           Control.Monad.Reader
+import           Data.Maybe
+import           Data.String.Interpolate
+import           GHC.IO.Exception
+import           Optics                  hiding ((<|), (|>))
+import           System.Directory
+import           System.FilePath
+import           System.IO.Error
+import           Text.PrettyPrint.HughesPJClass hiding ( (<>) )
+import           Text.Regex.Posix
+
+import qualified Data.ByteString.Lazy          as BL
+
+
+
+data ProcessError = NonZeroExit Int FilePath [String]
+                  | PTerminated FilePath [String]
+                  | PStopped FilePath [String]
+                  | NoSuchPid FilePath [String]
+                  deriving Show
+
+instance Pretty ProcessError where
+  pPrint (NonZeroExit e exe args) =
+    text [i|Process "#{exe}" with arguments #{args} failed with exit code #{e}.|]
+  pPrint (PTerminated exe args) =
+    text [i|Process "#{exe}" with arguments #{args} terminated.|]
+  pPrint (PStopped exe args) =
+    text [i|Process "#{exe}" with arguments #{args} stopped.|]
+  pPrint (NoSuchPid exe args) =
+    text [i|Could not find PID for process running "#{exe}" with arguments #{args}.|]
+
+data CapturedProcess = CapturedProcess
+  { _exitCode :: ExitCode
+  , _stdOut   :: BL.ByteString
+  , _stdErr   :: BL.ByteString
+  }
+  deriving (Eq, Show)
+
+makeLenses ''CapturedProcess
+
+
+
+-- | Search for a file in the search paths.
+--
+-- Catches `PermissionDenied` and `NoSuchThing` and returns `Nothing`.
+searchPath :: [FilePath] -> FilePath -> IO (Maybe FilePath)
+searchPath paths needle = go paths
+ where
+  go [] = pure Nothing
+  go (x : xs) =
+    hideErrorDefM [InappropriateType, PermissionDenied, NoSuchThing] (go xs)
+      $ do
+          contents <- listDirectory x
+          findM (isMatch x) contents >>= \case
+            Just _ -> pure $ Just (x </> needle)
+            Nothing -> go xs
+  isMatch basedir p = do
+    if p == needle
+      then isExecutable (basedir </> needle)
+      else pure False
+
+  isExecutable :: FilePath -> IO Bool
+  isExecutable file = executable <$> getPermissions file
+
+
+-- | Check wether a binary is shadowed by another one that comes before
+-- it in PATH. Returns the path to said binary, if any.
+isShadowed :: FilePath -> IO (Maybe FilePath)
+isShadowed p = do
+  let dir = takeDirectory p
+  let fn = takeFileName p
+  spaths <- liftIO getSearchPath
+  if dir `elem` spaths
+  then do
+    let shadowPaths = takeWhile (/= dir) spaths
+    searchPath shadowPaths fn
+  else pure Nothing
+
+
+-- | Check whether the binary is in PATH. This returns only `True`
+-- if the directory containing the binary is part of PATH.
+isInPath :: FilePath -> IO Bool
+isInPath p = do
+  let dir = takeDirectory p
+  let fn = takeFileName p
+  spaths <- liftIO getSearchPath
+  if dir `elem` spaths
+  then isJust <$> searchPath [dir] fn
+  else pure False
+
+
+findFiles :: FilePath -> Regex -> IO [FilePath]
+findFiles path regex = do
+  contents <- listDirectory path
+  pure $ filter (match regex) contents
+
+
+isBrokenSymlink :: FilePath -> IO Bool
+isBrokenSymlink fp = do
+  try (pathIsSymbolicLink fp) >>= \case
+    Right True -> do
+      let symDir = takeDirectory fp
+      tfp <- getSymbolicLinkTarget fp
+      not <$> doesPathExist
+        -- this drops 'symDir' if 'tfp' is absolute
+        (symDir </> tfp)
+    Right b -> pure b
+    Left e | isDoesNotExistError e -> pure False
+           | otherwise -> throwIO e
+

lib/GHCup/Utils/File/Posix.hs

@@ -0,0 +1,368 @@
+{-# LANGUAGE QuasiQuotes       #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE TemplateHaskell   #-}
+{-# LANGUAGE ViewPatterns      #-}
+
+{-|
+Module      : GHCup.Utils.File.Posix
+Description : File and unix APIs
+Copyright   : (c) Julian Ospald, 2020
+License     : LGPL-3.0
+Maintainer  : hasufell@hasufell.de
+Stability   : experimental
+Portability : POSIX
+
+This module handles file and executable handling.
+Some of these functions use sophisticated logging.
+-}
+module GHCup.Utils.File.Posix where
+
+import           GHCup.Utils.File.Common
+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
+import           Control.Monad.Logger
+import           Control.Monad.Reader
+import           Control.Monad.Trans.State.Strict
+import           Data.ByteString                ( ByteString )
+import           Data.Foldable
+import           Data.IORef
+import           Data.Sequence                  ( Seq, (|>) )
+import           Data.String.Interpolate
+import           Data.List
+import           Data.Word8
+import           GHC.IO.Exception
+import           System.Console.Pretty   hiding ( Pretty )
+import           System.Console.Regions
+import           System.IO.Error
+import           System.FilePath
+import           System.Posix.Directory
+import           System.Posix.Files
+import           System.Posix.IO
+import           System.Posix.Process           ( ProcessStatus(..) )
+import           System.Posix.Types
+
+
+import qualified Control.Exception             as EX
+import qualified Data.Sequence                 as Sq
+import qualified Data.Text                     as T
+import qualified Data.Text.Encoding            as E
+import qualified System.Posix.Process          as SPP
+import qualified Data.ByteString               as BS
+import qualified Data.ByteString.Lazy          as BL
+import qualified "unix-bytestring" System.Posix.IO.ByteString
+                                               as SPIB
+
+
+
+-- | Execute the given command and collect the stdout, stderr and the exit code.
+-- The command is run in a subprocess.
+executeOut :: FilePath          -- ^ command as filename, e.g. 'ls'
+           -> [String]          -- ^ arguments to the command
+           -> Maybe FilePath    -- ^ chdir to this path
+           -> IO CapturedProcess
+executeOut path args chdir = captureOutStreams $ do
+  maybe (pure ()) changeWorkingDirectory chdir
+  SPP.executeFile path True args Nothing
+
+
+execLogged :: (MonadReader AppState m, MonadIO m, MonadThrow m)
+           => FilePath         -- ^ thing to execute
+           -> [String]         -- ^ args for the thing
+           -> Maybe FilePath   -- ^ optionally chdir into this
+           -> FilePath         -- ^ log filename (opened in append mode)
+           -> Maybe [(String, String)] -- ^ optional environment
+           -> m (Either ProcessError ())
+execLogged exe args chdir lfile env = do
+  AppState { settings = Settings {..}, dirs = Dirs {..} } <- ask
+  let logfile = logsDir </> lfile <> ".log"
+  liftIO $ bracket (openFd logfile WriteOnly (Just newFilePerms) defaultFileFlags{ append = True })
+                   closeFd
+                   (action verbose)
+ where
+  action verbose fd = do
+    actionWithPipes $ \(stdoutRead, stdoutWrite) -> do
+      -- start the thread that logs to stdout
+      pState <- newEmptyMVar
+      done   <- newEmptyMVar
+      void
+        $ forkIO
+        $ EX.handle (\(_ :: IOException) -> pure ())
+        $ EX.finally
+            (if verbose
+              then tee fd stdoutRead
+              else printToRegion fd stdoutRead 6 pState
+            )
+            (putMVar done ())
+
+      -- fork the subprocess
+      pid <- SPP.forkProcess $ do
+        void $ dupTo stdoutWrite stdOutput
+        void $ dupTo stdoutWrite stdError
+        closeFd stdoutRead
+        closeFd stdoutWrite
+
+        -- execute the action
+        maybe (pure ()) changeWorkingDirectory chdir
+        void $ SPP.executeFile exe (not ("./" `isPrefixOf` exe)) args env
+
+      closeFd stdoutWrite
+
+      -- wait for the subprocess to finish
+      e <- toProcessError exe args <$!> SPP.getProcessStatus True True pid
+      putMVar pState (either (const False) (const True) e)
+
+      void $ race (takeMVar done) (threadDelay (1000000 * 3))
+      closeFd stdoutRead
+
+      pure e
+
+  tee :: Fd -> Fd -> IO ()
+  tee fileFd fdIn = readTilEOF lineAction fdIn
+
+   where
+    lineAction :: ByteString -> IO ()
+    lineAction bs' = do
+      void $ SPIB.fdWrite fileFd (bs' <> "\n")
+      void $ SPIB.fdWrite stdOutput (bs' <> "\n")
+
+  -- Reads fdIn and logs the output in a continous scrolling area
+  -- of 'size' terminal lines. Also writes to a log file.
+  printToRegion :: Fd -> Fd -> Int -> MVar Bool -> IO ()
+  printToRegion fileFd fdIn size pState = do
+    void $ displayConsoleRegions $ do
+      rs <-
+        liftIO
+        . fmap Sq.fromList
+        . sequence
+        . replicate size
+        . openConsoleRegion
+        $ Linear
+      flip runStateT mempty
+        $ handle
+            (\(ex :: SomeException) -> do
+              ps <- liftIO $ takeMVar pState
+              when ps (forM_ rs (liftIO . closeConsoleRegion))
+              throw ex
+            )
+        $ readTilEOF (lineAction rs) fdIn
+
+   where
+    -- action to perform line by line
+    -- TODO: do this with vty for efficiency
+    lineAction :: (MonadMask m, MonadIO m)
+               => Seq ConsoleRegion
+               -> ByteString
+               -> StateT (Seq ByteString) m ()
+    lineAction rs = \bs' -> do
+      void $ liftIO $ SPIB.fdWrite fileFd (bs' <> "\n")
+      modify (swapRegs bs')
+      regs <- get
+      liftIO $ forM_ (Sq.zip regs rs) $ \(bs, r) -> setConsoleRegion r $ do
+        w <- consoleWidth
+        return
+          . T.pack
+          . color Blue
+          . T.unpack
+          . decUTF8Safe
+          . trim w
+          . (\b -> "[ " <> E.encodeUtf8 (T.pack lfile) <> " ] " <> b)
+          $ bs
+
+    swapRegs :: a -> Seq a -> Seq a
+    swapRegs bs = \regs -> if
+      | Sq.length regs < size -> regs |> bs
+      | otherwise             -> Sq.drop 1 regs |> bs
+
+    -- trim output line to terminal width
+    trim :: Int -> ByteString -> ByteString
+    trim w = \bs -> if
+      | 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 = 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
+
+  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
+
+
+-- | Capture the stdout and stderr of the given action, which
+-- is run in a subprocess. Stdin is closed. You might want to
+-- 'race' this to make sure it terminates.
+captureOutStreams :: IO a
+                     -- ^ the action to execute in a subprocess
+                  -> IO CapturedProcess
+captureOutStreams action = do
+  actionWithPipes $ \(parentStdoutRead, childStdoutWrite) ->
+    actionWithPipes $ \(parentStderrRead, childStderrWrite) -> do
+      pid <- SPP.forkProcess $ do
+        -- dup stdout
+        void $ dupTo childStdoutWrite stdOutput
+        closeFd childStdoutWrite
+        closeFd parentStdoutRead
+
+        -- dup stderr
+        void $ dupTo childStderrWrite stdError
+        closeFd childStderrWrite
+        closeFd parentStderrRead
+
+        -- execute the action
+        a <- action
+        void $ evaluate a
+
+      -- close everything we don't need
+      closeFd childStdoutWrite
+      closeFd childStderrWrite
+
+      -- start thread that writes the output
+      refOut <- newIORef BL.empty
+      refErr <- newIORef BL.empty
+      done   <- newEmptyMVar
+      _      <-
+        forkIO
+        $ EX.handle (\(_ :: IOException) -> pure ())
+        $ flip EX.finally (putMVar done ())
+        $ writeStds parentStdoutRead parentStderrRead refOut refErr
+
+      status <- SPP.getProcessStatus True True pid
+      void $ race (takeMVar done) (threadDelay (1000000 * 3))
+
+      case status of
+        -- readFd will take care of closing the fd
+        Just (SPP.Exited es) -> do
+          stdout' <- readIORef refOut
+          stderr' <- readIORef refErr
+          pure $ CapturedProcess { _exitCode = es
+                                 , _stdOut   = stdout'
+                                 , _stdErr   = stderr'
+                                 }
+
+        _ -> throwIO $ userError ("No such PID " ++ show pid)
+
+ where
+  writeStds :: Fd -> Fd -> IORef BL.ByteString -> IORef BL.ByteString -> IO ()
+  writeStds pout perr rout rerr = do
+    doneOut <- newEmptyMVar
+    void
+      $ forkIO
+      $ hideError eofErrorType
+      $ flip EX.finally (putMVar doneOut ())
+      $ readTilEOF (\x -> modifyIORef' rout (<> BL.fromStrict x)) pout
+    doneErr <- newEmptyMVar
+    void
+      $ forkIO
+      $ hideError eofErrorType
+      $ flip EX.finally (putMVar doneErr ())
+      $ readTilEOF (\x -> modifyIORef' rerr (<> BL.fromStrict x)) perr
+    takeMVar doneOut
+    takeMVar doneErr
+
+  readTilEOF ~action' fd' = do
+    bs <- SPIB.fdRead fd' 512
+    void $ action' bs
+    readTilEOF action' 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
+
+
+
+-- | Create a new regular file in write-only mode. The file must not exist.
+createRegularFileFd :: FileMode -> FilePath -> IO Fd
+createRegularFileFd fm dest =
+  openFd dest WriteOnly (Just fm) defaultFileFlags{ exclusive = True }
+
+
+-- | Thin wrapper around `executeFile`.
+exec :: String           -- ^ thing to execute
+     -> [String]         -- ^ args for the thing
+     -> Maybe FilePath   -- ^ optionally chdir into this
+     -> Maybe [(String, String)] -- ^ optional environment
+     -> IO (Either ProcessError ())
+exec exe args chdir env = do
+  pid <- SPP.forkProcess $ do
+    maybe (pure ()) changeWorkingDirectory chdir
+    SPP.executeFile exe (not ("./" `isPrefixOf` exe)) args env
+
+  fmap (toProcessError exe args) $ SPP.getProcessStatus True True pid
+
+
+toProcessError :: FilePath
+               -> [String]
+               -> Maybe ProcessStatus
+               -> Either ProcessError ()
+toProcessError exe args mps = case mps of
+  Just (SPP.Exited (ExitFailure xi)) -> Left $ NonZeroExit xi exe args
+  Just (SPP.Exited ExitSuccess    ) -> Right ()
+  Just (Terminated _ _             ) -> Left $ PTerminated exe args
+  Just (Stopped _                  ) -> Left $ PStopped exe args
+  Nothing                            -> Left $ NoSuchPid exe args
+
+
+
+chmod_755 :: (MonadLogger m, MonadIO m) => FilePath -> m ()
+chmod_755 fp = do
+  let exe_mode =
+          nullFileMode
+            `unionFileModes` ownerExecuteMode
+            `unionFileModes` ownerReadMode
+            `unionFileModes` ownerWriteMode
+            `unionFileModes` groupExecuteMode
+            `unionFileModes` groupReadMode
+            `unionFileModes` otherExecuteMode
+            `unionFileModes` otherReadMode
+  $(logDebug) [i|chmod 755 #{fp}|]
+  liftIO $ setFileMode fp exe_mode
+
+
+-- |Default permissions for a new file.
+newFilePerms :: FileMode
+newFilePerms =
+  ownerWriteMode
+    `unionFileModes` ownerReadMode
+    `unionFileModes` groupWriteMode
+    `unionFileModes` groupReadMode
+    `unionFileModes` otherWriteMode
+    `unionFileModes` otherReadMode

lib/GHCup/Utils/File/Windows.hs

@@ -0,0 +1,202 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts  #-}
+
+{-|
+Module      : GHCup.Utils.File.Windows
+Description : File and windows APIs
+Copyright   : (c) Julian Ospald, 2020
+License     : LGPL-3.0
+Maintainer  : hasufell@hasufell.de
+Stability   : experimental
+Portability : Windows
+
+This module handles file and executable handling.
+Some of these functions use sophisticated logging.
+-}
+module GHCup.Utils.File.Windows where
+
+import           GHCup.Utils.File.Common
+import           GHCup.Types
+
+import           Control.Concurrent
+import           Control.DeepSeq
+import           Control.Exception.Safe
+import           Control.Monad
+import           Control.Monad.Reader
+import           Foreign.C.Error
+import           GHC.IO.Exception
+import           GHC.IO.Handle
+import           System.Directory
+import           System.FilePath
+import           System.IO
+import           System.Process
+ 
+import qualified Control.Exception             as EX
+import qualified Data.ByteString               as BS
+import qualified Data.ByteString.Lazy          as BL
+
+
+
+toProcessError :: FilePath
+               -> [FilePath]
+               -> ExitCode
+               -> Either ProcessError ()
+toProcessError exe args exitcode = case exitcode of
+  (ExitFailure xi) -> Left $ NonZeroExit xi exe args
+  ExitSuccess -> Right ()
+
+
+-- | @readCreateProcessWithExitCode@ works exactly like 'readProcessWithExitCode' except that it
+-- lets you pass 'CreateProcess' giving better flexibility.
+--
+-- Note that @Handle@s provided for @std_in@, @std_out@, or @std_err@ via the CreateProcess
+-- record will be ignored.
+--
+-- @since 1.2.3.0
+readCreateProcessWithExitCodeBS
+    :: CreateProcess
+    -> BL.ByteString
+    -> IO (ExitCode, BL.ByteString, BL.ByteString) -- ^ exitcode, stdout, stderr
+readCreateProcessWithExitCodeBS cp input = do
+    let cp_opts = cp {
+                    std_in  = CreatePipe,
+                    std_out = CreatePipe,
+                    std_err = CreatePipe
+                  }
+    withCreateProcess_ "readCreateProcessWithExitCode" cp_opts $
+      \mb_inh mb_outh mb_errh ph ->
+        case (mb_inh, mb_outh, mb_errh) of
+          (Just inh, Just outh, Just errh) -> do
+
+            out <- BS.hGetContents outh
+            err <- BS.hGetContents errh
+
+            -- fork off threads to start consuming stdout & stderr
+            withForkWait  (EX.evaluate $ rnf out) $ \waitOut ->
+             withForkWait (EX.evaluate $ rnf err) $ \waitErr -> do
+
+              -- now write any input
+              unless (BL.null input) $
+                ignoreSigPipe $ BL.hPut inh input
+              -- hClose performs implicit hFlush, and thus may trigger a SIGPIPE
+              ignoreSigPipe $ hClose inh
+
+              -- wait on the output
+              waitOut
+              waitErr
+
+              hClose outh
+              hClose errh
+
+            -- wait on the process
+            ex <- waitForProcess ph
+            return (ex, BL.fromStrict out, BL.fromStrict err)
+
+          (Nothing,_,_) -> error "readCreateProcessWithExitCodeBS: Failed to get a stdin handle."
+          (_,Nothing,_) -> error "readCreateProcessWithExitCodeBS: Failed to get a stdout handle."
+          (_,_,Nothing) -> error "readCreateProcessWithExitCodeBS: Failed to get a stderr handle."
+ where
+  ignoreSigPipe :: IO () -> IO ()
+  ignoreSigPipe = EX.handle $ \e -> case e of
+                                     IOError { ioe_type  = ResourceVanished
+                                             , ioe_errno = Just ioe }
+                                       | Errno ioe == ePIPE -> return ()
+                                     _ -> throwIO e
+  -- wrapper so we can get exceptions with the appropriate function name.
+  withCreateProcess_
+    :: String
+    -> CreateProcess
+    -> (Maybe Handle -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
+    -> IO a
+  withCreateProcess_ fun c action =
+      EX.bracketOnError (createProcess_ fun c) cleanupProcess
+                       (\(m_in, m_out, m_err, ph) -> action m_in m_out m_err ph)
+
+-- | Fork a thread while doing something else, but kill it if there's an
+-- exception.
+--
+-- This is important in the cases above because we want to kill the thread
+-- that is holding the Handle lock, because when we clean up the process we
+-- try to close that handle, which could otherwise deadlock.
+--
+withForkWait :: IO () -> (IO () ->  IO a) -> IO a
+withForkWait async' body = do
+  waitVar <- newEmptyMVar :: IO (MVar (Either SomeException ()))
+  mask $ \restore -> do
+    tid <- forkIO $ try (restore async') >>= putMVar waitVar
+    let wait' = takeMVar waitVar >>= either throwIO return
+    restore (body wait') `EX.onException` killThread tid
+
+
+-- | Execute the given command and collect the stdout, stderr and the exit code.
+-- The command is run in a subprocess.
+executeOut :: FilePath          -- ^ command as filename, e.g. 'ls'
+           -> [String]          -- ^ arguments to the command
+           -> Maybe FilePath    -- ^ chdir to this path
+           -> IO CapturedProcess
+executeOut path args chdir = do
+  (exit, out, err) <- readCreateProcessWithExitCodeBS (proc path args){ cwd = chdir } ""
+  pure $ CapturedProcess exit out err
+
+
+execLogged :: (MonadReader AppState m, MonadIO m, MonadThrow m)
+           => FilePath         -- ^ thing to execute
+           -> [String]         -- ^ args for the thing
+           -> Maybe FilePath   -- ^ optionally chdir into this
+           -> FilePath         -- ^ log filename (opened in append mode)
+           -> Maybe [(String, String)] -- ^ optional environment
+           -> m (Either ProcessError ())
+execLogged exe args chdir lfile env = do
+  AppState { dirs = Dirs {..} } <- ask
+  let stdoutLogfile = logsDir </> lfile <> ".stdout.log"
+      stderrLogfile = logsDir </> lfile <> ".stderr.log"
+  fmap (toProcessError exe args)
+    $ liftIO
+    $ withCreateProcess
+        (proc exe args){ cwd = chdir
+                       , env = env
+                       , std_in = CreatePipe
+                       , std_out = CreatePipe
+                       , std_err = CreatePipe
+        }
+    $ \_ mout merr ph ->
+        case (mout, merr) of
+          (Just cStdout, Just cStderr) -> do
+            withForkWait (tee stdoutLogfile cStdout) $ \waitOut ->
+              withForkWait (tee stderrLogfile cStderr) $ \waitErr -> do
+                waitOut
+                waitErr
+            waitForProcess ph
+          _ -> fail "Could not acquire out/err handle"
+
+ where
+  tee :: FilePath -> Handle -> IO ()
+  tee logFile handle' = go
+    where
+      go = do
+        some <- BS.hGetSome handle' 512
+        if BS.null some
+          then pure ()
+          else do
+            void $ BS.appendFile logFile some
+            void $ BS.hPut stdout some
+            go
+        
+
+-- | Thin wrapper around `executeFile`.
+exec :: FilePath       -- ^ thing to execute
+     -> [FilePath]     -- ^ args for the thing
+     -> Maybe FilePath   -- ^ optionally chdir into this
+     -> Maybe [(String, String)] -- ^ optional environment
+     -> IO (Either ProcessError ())
+exec exe args chdir env = do
+  exit_code <- withCreateProcess
+                 (proc exe args) { cwd = chdir, env = env } $ \_ _ _ p ->
+                 waitForProcess p
+  pure $ toProcessError exe args exit_code
+
+
+chmod_755 :: MonadIO m => FilePath -> m ()
+chmod_755 fp =
+  let perm = setOwnerWritable True emptyPermissions
+  in liftIO $ setPermissions fp perm

lib/GHCup/Utils/Logger.hs

@@ -1,4 +1,5 @@
-{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE QuasiQuotes      #-}
 
 {-|
 Module      : GHCup.Utils.Logger
@@ -7,26 +8,29 @@ Copyright   : (c) Julian Ospald, 2020
 License     : LGPL-3.0
 Maintainer  : hasufell@hasufell.de
 Stability   : experimental
-Portability : POSIX
+Portability : portable
 
 Here we define our main logger.
 -}
 module GHCup.Utils.Logger where
 
 import           GHCup.Types
-import           GHCup.Utils
+import           GHCup.Utils.File
+import           GHCup.Utils.String.QQ
 
 import           Control.Monad
 import           Control.Monad.IO.Class
 import           Control.Monad.Reader
 import           Control.Monad.Logger
-import           HPath
-import           HPath.IO
 import           Prelude                 hiding ( appendFile )
 import           System.Console.Pretty
+import           System.Directory        hiding ( findFiles )
+import           System.FilePath
 import           System.IO.Error
+import           Text.Regex.Posix
 
 import qualified Data.ByteString               as B
+import GHCup.Utils.Prelude
 
 
 data LoggerConfig = LoggerConfig
@@ -64,12 +68,19 @@ myLoggerT LoggerConfig {..} loggingt = runLoggingT loggingt mylogger
     rawOutter outr
 
 
-initGHCupFileLogging :: (MonadIO m, MonadReader AppState m) => Path Rel -> m (Path Abs)
+initGHCupFileLogging :: (MonadIO m, MonadReader AppState m) => m FilePath
-initGHCupFileLogging context = do
+initGHCupFileLogging = do
   AppState {dirs = Dirs {..}} <- ask
-  let logfile = logsDir </> context
+  let logfile = logsDir </> "ghcup.log"
   liftIO $ do
-    createDirRecursive' logsDir
+    createDirectoryIfMissing True logsDir
-    hideError doesNotExistErrorType $ deleteFile logfile
+    logFiles <- findFiles
-    createRegularFile newFilePerms logfile
+      logsDir
+      (makeRegexOpts compExtended
+                     execBlank
+                     ([s|^.*\.log$|] :: B.ByteString)
+      )
+    forM_ logFiles $ hideError doesNotExistErrorType . removeFile . (logsDir </>)
+
+    writeFile logfile ""
     pure logfile

lib/GHCup/Utils/MegaParsec.hs

@@ -8,7 +8,7 @@ Copyright   : (c) Julian Ospald, 2020
 License     : LGPL-3.0
 Maintainer  : hasufell@hasufell.de
 Stability   : experimental
-Portability : POSIX
+Portability : portable
 -}
 module GHCup.Utils.MegaParsec where
 
@@ -23,6 +23,7 @@ import           Data.Maybe
 import           Data.Text                      ( Text )
 import           Data.Versions
 import           Data.Void
+import           System.FilePath
 
 import qualified Data.List.NonEmpty            as NE
 import qualified Data.Text                     as T
@@ -67,6 +68,15 @@ ghcTargetBinP t =
     <*> (MP.chunk t <* MP.eof)
 
 
+-- | Extracts the version from @ProjectVersion="8.10.5"@.
+ghcProjectVersion :: MP.Parsec Void Text Version
+ghcProjectVersion = do
+  _ <- MP.chunk "ProjectVersion=\""
+  ver <- parseUntil1 $ MP.chunk "\""
+  MP.setInput ver
+  version'
+
+
 -- | Extracts target triple and version from e.g.
 --   * armv7-unknown-linux-gnueabihf-8.8.3
 --   * armv7-unknown-linux-gnueabihf-8.8.3
@@ -108,3 +118,7 @@ verP suffix = do
       v <- versioning'
       MP.setInput rest
       pure v
+
+
+pathSep :: MP.Parsec Void Text Char
+pathSep = MP.oneOf pathSeparators

lib/GHCup/Utils/Prelude.hs

@@ -12,7 +12,7 @@ Copyright   : (c) Julian Ospald, 2020
 License     : LGPL-3.0
 Maintainer  : hasufell@hasufell.de
 Stability   : experimental
-Portability : POSIX
+Portability : portable
 
 GHCup specific prelude. Lots of Excepts functionality.
 -}
@@ -32,8 +32,6 @@ import           Data.Word8
 import           Haskus.Utils.Types.List
 import           Haskus.Utils.Variant.Excepts
 import           System.IO.Error
-import           System.Posix.Env.ByteString    ( getEnvironment )
-
 import qualified Data.ByteString               as B
 import qualified Data.ByteString.Lazy          as L
 import qualified Data.Strict.Maybe             as S
@@ -242,6 +240,8 @@ throwEither' e eth = case eth of
 verToBS :: Version -> ByteString
 verToBS = E.encodeUtf8 . prettyVer
 
+verToS :: Version -> String
+verToS = T.unpack . prettyVer
 
 intToText :: Integral a => a -> T.Text
 intToText = TL.toStrict . B.toLazyText . B.decimal
@@ -252,14 +252,6 @@ removeLensFieldLabel str' =
   maybe str' T.unpack . T.stripPrefix (T.pack "_") . T.pack $ str'
 
 
-addToCurrentEnv :: MonadIO m
-                => [(ByteString, ByteString)]
-                -> m [(ByteString, ByteString)]
-addToCurrentEnv adds = do
-  cEnv <- liftIO getEnvironment
-  pure (adds ++ cEnv)
-
-
 pvpToVersion :: PVP -> Version
 pvpToVersion =
   either (\_ -> error "Couldn't convert PVP to Version") id

lib/GHCup/Utils/String/QQ.hs

@@ -7,7 +7,7 @@ Copyright   : (c) Audrey Tang <audreyt@audreyt.org> 2019, Julian Ospald <hasufel
 License     : LGPL-3.0
 Maintainer  : hasufell@hasufell.de
 Stability   : experimental
-Portability : POSIX
+Portability : portable
 
 QuasiQuoter for non-interpolated strings, texts and bytestrings.
 

lib/GHCup/Utils/Version/QQ.hs

@@ -14,7 +14,7 @@ Copyright   : (c) Julian Ospald, 2020
 License     : LGPL-3.0
 Maintainer  : hasufell@hasufell.de
 Stability   : experimental
-Portability : POSIX
+Portability : portable
 -}
 module GHCup.Utils.Version.QQ where
 

lib/GHCup/Version.hs

@@ -8,7 +8,7 @@ Copyright   : (c) Julian Ospald, 2020
 License     : LGPL-3.0
 Maintainer  : hasufell@hasufell.de
 Stability   : experimental
-Portability : POSIX
+Portability : portable
 -}
 module GHCup.Version where
 

stack.yaml

@@ -1,4 +1,4 @@
-resolver: lts-17.4
+resolver: lts-17.11
 
 packages:
   - .
@@ -7,6 +7,9 @@ extra-deps:
   - git: https://github.com/hasufell/text-conversions.git
     commit: 9abf0e5e5664a3178367597c32db19880477a53c
 
+  - git: https://github.com/Bodigrim/tar
+    commit: ac197ec7ea4838dc2b4e22b9b888b080cedf29cf
+
   - IfElse-0.85@sha256:6939b94acc6a55f545f63a168a349dd2fbe4b9a7cca73bf60282db5cc6aa47d2,445
   - ascii-string-1.0.1.4@sha256:fa34f1d9ba57e8e89c0d4c9cef5e01ba32cb2d4373d13f92dcc0b531a6c6749b,2582
   - brotli-0.0.0.0@sha256:2bf383a4cd308745740986be0b18381c5a0784393fe69b91456aacb2d603de46,2964
@@ -17,16 +20,18 @@ extra-deps:
   - haskus-utils-data-1.3@sha256:f62c4e49021b463185d043f7b69c727b63af641a71d7edd582d9f4f98e80e500,1466
   - haskus-utils-types-1.5.1@sha256:991c472f4e751e2f0d7aab6ad4220ef151d6160876dcf0511bbf876bbd432020,1298
   - haskus-utils-variant-3.0@sha256:8d51e45d3b664e61ccc25a58b37c0ccc4ee7537138b9fee21cd15c356906dd34,2159
-  - hpath-0.11.0@sha256:12b8405bee13d0007d644a888ef8407069ce7bbbd76970f8746b801447124ade,1440
-  - hpath-directory-0.14.1@sha256:548ac1321222c34caa843a41a2379a77d961141082a4695bb37cc4731e91b2c7,5312
-  - hpath-filepath-0.10.4@sha256:e9e44fb5fdbade7f30b5b5451257dbee15b6ef1aae4060034d73008bb3b5d878,1269
-  - hpath-io-0.14.1@sha256:d91373cd81483eb370a1c683e4add6182250dccce32f9b682bb1104f7765c750,1522
-  - hpath-posix-0.13.2@sha256:eec4ff2b00dc86be847aca0f409fc8f6212ffd2170ec36a17dc9a52b46562392,1615
   - http-io-streams-0.1.6.0@sha256:53f5bab177efb52cd65ec396fd04ed59b93e5f919fb3700cd7dacd6cfce6f06d,3582
+  - hpath-filepath-0.10.4@sha256:e9e44fb5fdbade7f30b5b5451257dbee15b6ef1aae4060034d73008bb3b5d878,1269
+  - hpath-posix-0.13.3@sha256:abe472cf16bccd3a8b8814865ed3551a728fde0f3a2baea2acc03023bec6c565,1615
+  - hspec-2.7.10@sha256:c9e82c90086acebac576552a06f3cabd249bba048edd1667c7fae0b1313d5bce,1712
+  - hspec-core-2.7.10@sha256:2aba6ea126442b29e8183ab27f1c811706b19b1d83b02f193a896f6fc1589d13,4621
+  - hspec-discover-2.7.10@sha256:d08bf5dd785629f589571477d9beb7cd91529471bd89f39517c1cb4b9b38160f,2184
+  - hspec-golden-aeson-0.9.0.0@sha256:aa17274114026661ba4dfc9c60c230673c8f408bd86482fd611d2d5cb6aff996,2179
   - lzma-static-5.2.5.2@sha256:ac38dcad9ab423342a72ba48415bd75f62234e9c9e11831495b75603b5a060f6,7184
   - libarchive-3.0.2.1@sha256:40ebf2a278e585802427bc58826867208bb33822f63d56107a1fcc3ca04d691d,10990
   - os-release-1.0.1@sha256:1281c62081f438fc3f0874d3bae6a4887d5964ac25261ba06e29d368ab173467,2716
   - primitive-0.7.0.1@sha256:a381571c36edc7dca28b77fe8159b43c14c640087ec5946adacf949feec64231,3433
+  - regex-posix-clib-2.7
   - streamly-0.7.3@sha256:ad2a488fe802692ed47cab9fd0416c2904aac9e51cf2d8aafd1c3a40064c42f5,27421
   - streamly-bytestring-0.1.2@sha256:cc828f41d1c714c711d38fb213b4ed186febabba598ab080e13255f69c20b13c,2469
   - streamly-posix-0.1.0.1@sha256:5d89b806281035d34020387ed99dde1ddab282c7ed66df3b7cd010b38fd3517b,2138
@@ -40,13 +45,8 @@ flags:
   libarchive:
     system-libarchive: false
 
-  ghcup:
+  regex-posix:
-    tui: true
+    _regex-posix-clib: true
-    internal-downloader: true
-
-system-ghc: true
-compiler: ghc-8.10.4
-compiler-check: match-exact
 
 ghc-options:
   "$locals": -O2

test/GHCup/ArbitraryTypes.hs

@@ -11,7 +11,6 @@ import           GHCup.Types
 import           Data.ByteString                ( ByteString )
 import           Data.Versions
 import           Data.List.NonEmpty
-import           HPath
 import           Test.QuickCheck
 import           Test.QuickCheck.Arbitrary.ADT  ( ToADTArbitrary )
 import           Test.QuickCheck.Arbitrary.Generic
@@ -164,11 +163,6 @@ instance Arbitrary VersionCmp where
   arbitrary = genericArbitrary
   shrink    = genericShrink
 
-instance Arbitrary (Path Rel) where
-  arbitrary =
-    either (error . show) id . parseRel . E.encodeUtf8 . T.pack
-      <$> listOf1 (elements ['a' .. 'z'])
-
 instance Arbitrary TarDir where
   arbitrary = genericArbitrary
   shrink    = genericShrink