Make readDirEntPortable more robust

Fixes #775

.github/scripts/bootstrap.sh

@@ -13,4 +13,6 @@ git describe --always
 ./scripts/bootstrap/bootstrap-haskell
 
 [ "$(ghc --numeric-version)" = "${BOOTSTRAP_HASKELL_GHC_VERSION}" ]
+# https://github.com/actions/runner-images/issues/7061
+[ "$(ghcup config | grep --color=never meta-mode)" = "meta-mode: Lax" ]
 

.github/workflows/docker.yaml

@@ -26,7 +26,9 @@ jobs:
           context: ./docker/alpine32
           push: true
           tags: hasufell/i386-alpine-haskell:3.12
-          platforms: linux/i386
+          platforms: |
+            linux/i386
+            linux/amd64
 
   docker-alpine:
     runs-on: ubuntu-latest

app/ghcup/GHCup/OptParse/Config.hs

@@ -59,7 +59,7 @@ data ConfigCommand
     --[ Parsers ]--
     ---------------
 
-          
+
 configP :: Parser ConfigCommand
 configP = subparser
       (  command "init" initP
@@ -120,21 +120,38 @@ formatConfig :: UserSettings -> String
 formatConfig = UTF8.toString . Y.encode
 
 
-updateSettings :: UserSettings -> Settings -> Settings
+updateSettings :: UserSettings -> UserSettings -> UserSettings
-updateSettings UserSettings{..} Settings{..} =
+updateSettings usl usr =
-   let cache'      = fromMaybe cache uCache
+   let cache'      = uCache usl      <|> uCache usr
-       metaCache'  = fromMaybe metaCache uMetaCache
+       metaCache'  = uMetaCache usl  <|> uMetaCache usr
-       metaMode'   = fromMaybe metaMode uMetaMode
+       metaMode'   = uMetaMode usl   <|> uMetaMode usr
-       noVerify'   = fromMaybe noVerify uNoVerify
+       noVerify'   = uNoVerify usl   <|> uNoVerify usr
-       keepDirs'   = fromMaybe keepDirs uKeepDirs
+       verbose'    = uVerbose usl    <|> uVerbose usr
-       downloader' = fromMaybe downloader uDownloader
+       keepDirs'   = uKeepDirs usl   <|> uKeepDirs usr
-       verbose'    = fromMaybe verbose uVerbose
+       downloader' = uDownloader usl <|> uDownloader usr
-       urlSource'  = fromMaybe urlSource uUrlSource
+       urlSource'  = uUrlSource usl  <|> uUrlSource usr
-       noNetwork'  = fromMaybe noNetwork uNoNetwork
+       noNetwork'  = uNoNetwork usl  <|> uNoNetwork usr
-       gpgSetting' = fromMaybe gpgSetting uGPGSetting
+       gpgSetting' = uGPGSetting usl <|> uGPGSetting usr
-       platformOverride' = uPlatformOverride <|> platformOverride
+       platformOverride' = uPlatformOverride usl <|> uPlatformOverride usr
-       mirrors' = fromMaybe mirrors uMirrors
+       mirrors' = uMirrors usl <|> uMirrors usr
-   in Settings cache' metaCache' metaMode' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' noColor platformOverride' mirrors'
+   in UserSettings cache' metaCache' metaMode' noVerify' verbose' keepDirs' downloader' (updateKeyBindings (uKeyBindings usl) (uKeyBindings usr)) urlSource' noNetwork' gpgSetting' platformOverride' mirrors'
+ where
+  updateKeyBindings :: Maybe UserKeyBindings -> Maybe UserKeyBindings -> Maybe UserKeyBindings
+  updateKeyBindings Nothing Nothing = Nothing
+  updateKeyBindings (Just kbl) Nothing = Just kbl
+  updateKeyBindings Nothing (Just kbr) = Just kbr
+  updateKeyBindings (Just kbl) (Just kbr) =
+       Just $ UserKeyBindings {
+           kUp = kUp kbl <|> kUp kbr
+         , kDown = kDown kbl <|> kDown kbr
+         , kQuit = kQuit kbl <|> kQuit kbr
+         , kInstall = kInstall kbl <|> kInstall kbr
+         , kUninstall = kUninstall kbl <|> kUninstall kbr
+         , kSet = kSet kbl <|> kSet kbr
+         , kChangelog = kChangelog kbl <|> kChangelog kbr
+         , kShowAll = kShowAll kbl <|> kShowAll kbr
+         , kShowAllTools = kShowAllTools kbl <|> kShowAllTools kbr
+         }
 
 
 
@@ -151,10 +168,11 @@ config :: forall m. ( Monad m
           )
      => ConfigCommand
      -> Settings
+     -> UserSettings
      -> KeyBindings
      -> (ReaderT LeanAppState m () -> m ())
      -> m ExitCode
-config configCommand settings keybindings runLogger = case configCommand of
+config configCommand settings userConf keybindings runLogger = case configCommand of
   InitConfig -> do
     path <- getConfigFilePath
     liftIO $ writeFile path $ formatConfig $ fromSettings settings (Just keybindings)
@@ -203,9 +221,9 @@ config configCommand settings keybindings runLogger = case configCommand of
  where
   doConfig :: MonadIO m => UserSettings -> m ()
   doConfig usersettings = do
-    let settings' = updateSettings usersettings settings
+    let settings' = updateSettings usersettings userConf
     path <- liftIO getConfigFilePath
-    liftIO $ writeFile path $ formatConfig $ fromSettings settings' (Just keybindings)
+    liftIO $ writeFile path $ formatConfig $ settings'
     runLogger $ logDebug $ T.pack $ show settings'
     pure ()
 

app/ghcup/GHCup/OptParse/Set.hs

@@ -259,7 +259,7 @@ set :: forall m env.
         -> m (VEither eff GHCTargetVersion))
     -> (ReaderT LeanAppState m () -> m ())
     -> m ExitCode
-set setCommand runAppState runLeanAppState runLogger = case setCommand of
+set setCommand runAppState _ runLogger = case setCommand of
   (Right sopts) -> do
     runLogger (logWarn "This is an old-style command for setting GHC. Use 'ghcup set ghc' instead.")
     setGHC' sopts
@@ -271,10 +271,7 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
  where
   setGHC' :: SetOptions
           -> m ExitCode
-  setGHC' SetOptions{ sToolVer } =
+  setGHC' SetOptions{ sToolVer } = runSetGHC runAppState (do
-    case sToolVer of
-      (SetGHCVersion v) -> runSetGHC runLeanAppState (liftE $ setGHC v SetGHCOnly Nothing >> pure v)
-      _ -> runSetGHC runAppState (do
           v <- liftE $ fst <$> fromVersion' sToolVer GHC
           liftE $ setGHC v SetGHCOnly Nothing
         )
@@ -291,10 +288,7 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
 
   setCabal' :: SetOptions
             -> m ExitCode
-  setCabal' SetOptions{ sToolVer } =
+  setCabal' SetOptions{ sToolVer } = runSetCabal runAppState (do
-    case sToolVer of
-      (SetToolVersion v) -> runSetCabal runLeanAppState (liftE $ setCabal v >> pure (mkTVer v))
-      _ -> runSetCabal runAppState (do
           v <- liftE $ fst <$> fromVersion' sToolVer Cabal
           liftE $ setCabal (_tvVersion v)
           pure v
@@ -311,10 +305,7 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
 
   setHLS' :: SetOptions
           -> m ExitCode
-  setHLS' SetOptions{ sToolVer } =
+  setHLS' SetOptions{ sToolVer } = runSetHLS runAppState (do
-    case sToolVer of
-      (SetToolVersion v) -> runSetHLS runLeanAppState (liftE $ setHLS v SetHLSOnly Nothing >> pure (mkTVer v))
-      _ -> runSetHLS runAppState (do
           v <- liftE $ fst <$> fromVersion' sToolVer HLS
           liftE $ setHLS (_tvVersion v) SetHLSOnly Nothing
           pure v
@@ -332,10 +323,7 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
 
   setStack' :: SetOptions
             -> m ExitCode
-  setStack' SetOptions{ sToolVer } =
+  setStack' SetOptions{ sToolVer } = runSetStack runAppState (do
-    case sToolVer of
-      (SetToolVersion v) -> runSetStack runLeanAppState (liftE $ setStack v >> pure (mkTVer v))
-      _ -> runSetStack runAppState (do
             v <- liftE $ fst <$> fromVersion' sToolVer Stack
             liftE $ setStack (_tvVersion v)
             pure v

app/ghcup/Main.hs

@@ -63,7 +63,7 @@ import qualified GHCup.Types                   as Types
 
 
 
-toSettings :: Options -> IO (Settings, KeyBindings)
+toSettings :: Options -> IO (Settings, KeyBindings, UserSettings)
 toSettings options = do
   noColor <- isJust <$> lookupEnv "NO_COLOR"
   userConf <- runE @'[ JSONError ] ghcupConfigFile >>= \case
@@ -73,7 +73,7 @@ toSettings options = do
       pure defaultUserSettings
     _ -> do
       die "Unexpected error!"
-  pure $ mergeConf options userConf noColor
+  pure $ (\(s', k) -> (s', k, userConf)) $ mergeConf options userConf noColor
  where
    mergeConf :: Options -> UserSettings -> Bool -> (Settings, KeyBindings)
    mergeConf Options{..} UserSettings{..} noColor =
@@ -176,7 +176,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
           -- create ~/.ghcup dir
           ensureDirectories dirs
 
-          (settings, keybindings) <- toSettings opt
+          (settings, keybindings, userConf) <- toSettings opt
 
           -- logger interpreter
           logfile <- runReaderT initGHCupFileLogging dirs
@@ -303,7 +303,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
             Rm rmCommand               -> rm rmCommand runAppState runLogger
             DInfo                      -> dinfo runAppState runLogger
             Compile compileCommand     -> compile compileCommand settings dirs runAppState runLogger
-            Config configCommand       -> config configCommand settings keybindings runLogger
+            Config configCommand       -> config configCommand settings userConf keybindings runLogger
             Whereis whereisOptions
                     whereisCommand     -> whereis whereisCommand whereisOptions runAppState leanAppstate runLogger
             Upgrade uOpts force' fatal -> upgrade uOpts force' fatal dirs runAppState runLogger

docker/alpine32/Dockerfile

@@ -1,4 +1,4 @@
-FROM i386/alpine:3.12
+FROM --platform=linux/i386 i386/alpine:3.12
 
 ENV LANG C.UTF-8
 

docs/index.md

@@ -35,7 +35,7 @@ hide:
       <span>
       </span>
 	<div class="footer">
-		<a href="https://github.com/haskell/ghcup-hs/blob/master/scripts/bootstrap/bootstrap-haskell" target="_blank">What does this do?</a> <b>&nbsp;&middot;&nbsp;</b> <a href="https://www.haskell.org/ghcup/install/#manual-install">I don't like curl | sh</a> <div class="show-all-platforms"><b>&nbsp;&middot;&nbsp;</b> <a class="show-all-platforms-button" href="#">Show all platforms</a></div></p>
+		<a href="https://github.com/haskell/ghcup-hs/blob/master/scripts/bootstrap/bootstrap-haskell" target="_blank">What does this do?</a> <b>&nbsp;&middot;&nbsp;</b> <a href="https://www.haskell.org/ghcup/install/#manual-installation">I don't like curl | sh</a> <div class="show-all-platforms"><b>&nbsp;&middot;&nbsp;</b> <a class="show-all-platforms-button" href="#">Show all platforms</a></div></p>
 	</div>
     </div>
 
@@ -51,7 +51,7 @@ hide:
         <button class="btn" onclick="copyToClipboardWin()" id="ghcup-windows-button"><i class="fa fa-copy"></i></button>
       </div>
 	<div class="footer">
-		<a href="https://github.com/haskell/ghcup-hs/blob/master/scripts/bootstrap/bootstrap-haskell.ps1" target="_blank">What does this do?</a> <b>&nbsp;&middot;&nbsp;</b> <a href="https://www.haskell.org/ghcup/install/#manual-install">I don't like curl | sh</a> <div class="show-all-platforms"><b>&nbsp;&middot;&nbsp;</b> <a class="show-all-platforms-button" href="#">Show all platforms</a></div></p>
+		<a href="https://github.com/haskell/ghcup-hs/blob/master/scripts/bootstrap/bootstrap-haskell.ps1" target="_blank">What does this do?</a> <b>&nbsp;&middot;&nbsp;</b> <a href="https://www.haskell.org/ghcup/install/#manual-installation">I don't like curl | sh</a> <div class="show-all-platforms"><b>&nbsp;&middot;&nbsp;</b> <a class="show-all-platforms-button" href="#">Show all platforms</a></div></p>
 	</div>
     </div>
 </section>

docs/install.md

@@ -1,7 +1,7 @@
 # Installation
 
 GHCup makes it easy to install specific versions of GHC on GNU/Linux,
-macOS (aka Darwin), FreeBSD and Windows and can also bootstrap a fresh [Haskell developer environment](./install/#supported-tools) from scratch.
+macOS (aka Darwin), FreeBSD and Windows and can also bootstrap a fresh [Haskell developer environment](./#supported-tools) from scratch.
 It follows the UNIX philosophy of [do one thing and do it well](https://en.wikipedia.org/wiki/Unix_philosophy#Do_One_Thing_and_Do_It_Well). 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).
 
 ## How to install
@@ -24,7 +24,7 @@ Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager
 
 There's also a [youtube video](https://www.youtube.com/watch?v=bB4fmQiUYPw) explaining installation on windows.
 
-If you want to know what these scripts do, check out the [source code at the repository](https://github.com/haskell/ghcup-hs/tree/master/scripts/bootstrap). Advanced users may want to perform a [manual installation](#manual-install) and GPG verify the binaries.
+If you want to know what these scripts do, check out the [source code at the repository](https://github.com/haskell/ghcup-hs/tree/master/scripts/bootstrap). Advanced users may want to perform a [manual installation](#manual-installation) and GPG verify the binaries.
 
 ### Which versions get installed?
 

lib/GHCup/Prelude/File/Posix.hs

@@ -279,11 +279,11 @@ removeEmptyDirectory = PD.removeDirectory
 
 -- | Create an 'Unfold' of directory contents.
 unfoldDirContents :: (MonadMask m, MonadIO m, S.MonadAsync m) => Unfold m FilePath (FD.DirType, FilePath)
-unfoldDirContents = U.bracket (liftIO . openDirStream) (liftIO . closeDirStream) (Unfold step return)
+unfoldDirContents = U.bracket (liftIO . openDirStreamPortable) (liftIO . closeDirStreamPortable) (Unfold step return)
  where
   {-# INLINE [0] step #-}
   step dirstream = do
-    (typ, e) <- liftIO $ readDirEnt dirstream
+    (typ, e) <- liftIO $ readDirEntPortable dirstream
     return $ if
       | null e    -> D.Stop
       | "." == e  -> D.Skip dirstream
@@ -308,8 +308,8 @@ getDirectoryContentsRecursiveUnfold = Unfold step (\s -> return (s, Nothing, [""
   step (_, Nothing, []) = return D.Stop
 
   step (topdir, Just (cdir, dirstream, finalizer), dirs) = flip onException (runIOFinalizer finalizer) $ do
-    (dt, f) <- liftIO $ readDirEnt dirstream
+    (dt, f) <- liftIO $ readDirEntPortable dirstream
-    if | FD.dtUnknown == dt -> do
+    if | f == "" -> do
            runIOFinalizer finalizer
            return $ D.Skip (topdir, Nothing, dirs)
        | f == "." || f == ".."
@@ -323,8 +323,8 @@ getDirectoryContentsRecursiveUnfold = Unfold step (\s -> return (s, Nothing, [""
 
   acquire dir =
     withRunInIO $ \run -> mask_ $ run $ do
-        dirstream <- liftIO $ openDirStream dir
+        dirstream <- liftIO $ openDirStreamPortable dir
-        ref <- newIOFinalizer (liftIO $ closeDirStream dirstream)
+        ref <- newIOFinalizer (liftIO $ closeDirStreamPortable dirstream)
         return (dirstream, ref)
 
 getDirectoryContentsRecursiveBFSUnsafe :: (MonadMask m, MonadIO m, S.MonadAsync m)

lib/GHCup/Prelude/File/Posix/Traversals.hsc

@@ -10,9 +10,20 @@
 module GHCup.Prelude.File.Posix.Traversals (
 -- lower-level stuff
   readDirEnt
+, readDirEntPortable
+, openDirStreamPortable
+, closeDirStreamPortable
 , unpackDirStream
+, DirStreamPortable
 ) where
 
+#include <limits.h>
+#include <stdlib.h>
+#include <dirent.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <fcntl.h>
+
 
 #if __GLASGOW_HASKELL__ < 710
 import Control.Applicative ((<$>))
@@ -28,6 +39,7 @@ import Foreign.Storable
 import System.Posix
 import Foreign (alloca)
 import System.Posix.Internals (peekFilePath)
+import System.FilePath
 
 
 
@@ -90,3 +102,38 @@ readDirEnt (unpackDirStream -> dirp) =
                     then return (dtUnknown, mempty)
                     else throwErrno "readDirEnt"
 
+
+newtype DirStreamPortable = DirStreamPortable (FilePath, DirStream)
+
+openDirStreamPortable :: FilePath -> IO DirStreamPortable
+openDirStreamPortable fp = do
+  dirs <- openDirStream fp
+  pure $ DirStreamPortable (fp, dirs)
+
+closeDirStreamPortable :: DirStreamPortable -> IO ()
+closeDirStreamPortable (DirStreamPortable (_, dirs)) = closeDirStream dirs
+
+readDirEntPortable :: DirStreamPortable -> IO (DirType, FilePath)
+readDirEntPortable (DirStreamPortable (basedir, dirs)) = do
+  (dt, fp) <- readDirEnt dirs
+  case (dt, fp) of
+    (DirType #{const DT_BLK}, _)     -> pure (dt, fp)
+    (DirType #{const DT_CHR}, _)     -> pure (dt, fp)
+    (DirType #{const DT_DIR}, _)     -> pure (dt, fp)
+    (DirType #{const DT_FIFO}, _)    -> pure (dt, fp)
+    (DirType #{const DT_LNK}, _)     -> pure (dt, fp)
+    (DirType #{const DT_REG}, _)     -> pure (dt, fp)
+    (DirType #{const DT_SOCK}, _)    -> pure (dt, fp)
+    (DirType #{const DT_UNKNOWN}, _) -> pure (dt, fp)
+    (_, _)
+      | fp /= "" -> do
+          stat <- getSymbolicLinkStatus (basedir </> fp)
+          pure $ (, fp) $ if | isBlockDevice stat     -> DirType #{const DT_BLK}
+                             | isCharacterDevice stat -> DirType #{const DT_CHR}
+                             | isDirectory stat       -> DirType #{const DT_DIR}
+                             | isNamedPipe stat       -> DirType #{const DT_FIFO}
+                             | isSymbolicLink stat    -> DirType #{const DT_LNK}
+                             | isRegularFile stat     -> DirType #{const DT_REG}
+                             | isSocket stat          -> DirType #{const DT_SOCK}
+                             | otherwise              -> DirType #{const DT_UNKNOWN}
+

scripts/bootstrap/bootstrap-haskell

@@ -119,20 +119,26 @@ edo() {
     "$@" || die "\"$*\" failed!"
 }
 
+eghcup_raw() {
+	"${GHCUP_BIN}/ghcup" "$@" || die "\"ghcup $*\" failed!"
+}
+
 eghcup() {
-	edo _eghcup "$@"
+	_eghcup "$@"
 }
 
 _eghcup() {
 	if [ -n "${BOOTSTRAP_HASKELL_YAML}" ] ; then
-		args="-s ${BOOTSTRAP_HASKELL_YAML}"
+		args="-s ${BOOTSTRAP_HASKELL_YAML} --metadata-fetching-mode=Strict"
+    else
+		args="--metadata-fetching-mode=Strict"
 	fi
     if [ -z "${BOOTSTRAP_HASKELL_VERBOSE}" ] ; then
         # shellcheck disable=SC2086
-        "${GHCUP_BIN}/ghcup" ${args} "$@"
+        "${GHCUP_BIN}/ghcup" ${args} "$@" || die "\"ghcup ${args} $*\" failed!"
     else
         # shellcheck disable=SC2086
-        "${GHCUP_BIN}/ghcup" ${args} --verbose "$@"
+        "${GHCUP_BIN}/ghcup" ${args} --verbose "$@" || die "\"ghcup ${args} --verbose $*\" failed!"
     fi
 }
 
@@ -147,7 +153,7 @@ _ecabal() {
 }
 
 ecabal() {
-	edo _ecabal "$@"
+	_ecabal "$@" || die "\"cabal $*\" failed!"
 }
 
 _done() {
@@ -282,14 +288,6 @@ download_ghcup() {
 			esac
 			;;
         "FreeBSD"|"freebsd")
-            if freebsd-version | grep -E '^12.*' ; then
-                freebsd_ver=12
-            elif freebsd-version | grep -E '^13.*' ; then
-                freebsd_ver=13
-            else
-                die "Unsupported FreeBSD version! Please report a bug at https://github.com/haskell/ghcup-hs/issues"
-            fi
-
 			case "${arch}" in
 				x86_64|amd64)
 					;;
@@ -299,7 +297,7 @@ download_ghcup() {
 				*) die "Unknown architecture: ${arch}"
 					;;
 			esac
-			_url=${GHCUP_BASE_URL}/${ghver}/x86_64-freebsd${freebsd_ver}-ghcup-${ghver}
+			_url=${GHCUP_BASE_URL}/${ghver}/x86_64-portbld-freebsd-ghcup-${ghver}
             ;;
         "Darwin"|"darwin")
 			case "${arch}" in
@@ -387,10 +385,10 @@ download_ghcup() {
     edo . "${GHCUP_DIR}"/env
     case "${BOOTSTRAP_HASKELL_DOWNLOADER}" in
         "curl")
-            eghcup config set downloader Curl
+            eghcup_raw config set downloader Curl
             ;;
         "wget")
-            eghcup config set downloader Wget
+            eghcup_raw config set downloader Wget
             ;;
         *)
             die "Unknown downloader: ${BOOTSTRAP_HASKELL_DOWNLOADER}"
@@ -795,7 +793,7 @@ edo mkdir -p "${GHCUP_BIN}"
 
 if command -V "ghcup" >/dev/null 2>&1 ; then
     if [ -z "${BOOTSTRAP_HASKELL_NO_UPGRADE}" ] ; then
-        _eghcup upgrade || download_ghcup
+        ( _eghcup upgrade ) || download_ghcup
     fi
 else
 	download_ghcup
@@ -842,17 +840,17 @@ fi
 
 case $ask_hls_answer in
 	1)
-		_eghcup --cache install hls || warn "HLS installation failed, continuing anyway"
+        (_eghcup --cache install hls) || warn "HLS installation failed, continuing anyway"
 		;;
 	*) ;;
 esac
 
 case $ask_stack_answer in
 	1)
-		_eghcup --cache install stack || die "Stack installation failed"
+        (_eghcup --cache install stack) || die "Stack installation failed"
 		;;
 	2)
-		_eghcup --cache install stack || die "Stack installation failed"
+        (_eghcup --cache install stack) || die "Stack installation failed"
         edo mkdir -p "${STACK_ROOOT:-$HOME/.stack}"/hooks
         hook_exe="${STACK_ROOOT:-$HOME/.stack}"/hooks/ghc-install.sh
         hook_url="https://www.haskell.org/ghcup/sh/hooks/stack/ghc-install.sh"

test/GHCup/Prelude/File/Posix/TraversalsSpec.hs

@@ -24,11 +24,11 @@ spec = do
   -- https://github.com/haskell/ghcup-hs/issues/415
   describe "GHCup.Prelude.File.Posix.Traversals" $ do
     it "readDirEnt" $ do
-      dirstream <- liftIO $ openDirStream "test/data"
+      dirstream <- liftIO $ openDirStreamPortable "test/data"
-      (dt1, fp1) <- readDirEnt dirstream
+      (dt1, fp1) <- readDirEntPortable dirstream
-      (dt2, fp2) <- readDirEnt dirstream
+      (dt2, fp2) <- readDirEntPortable dirstream
-      (dt3, fp3) <- readDirEnt dirstream
+      (dt3, fp3) <- readDirEntPortable dirstream
-      (dt4, fp4) <- readDirEnt dirstream
+      (dt4, fp4) <- readDirEntPortable dirstream
       let xs = sortOn snd [ (dt1, fp1), (dt2, fp2)
                           , (dt3, fp3), (dt4, fp4)
                           ]