Use streamly-core instead of streamly

ghcup.cabal

@@ -97,7 +97,7 @@ common app-common-depends
     , utf8-string            ^>=1.0
     , vector                 >=0.12     && <0.14
     , versions               >=6.0.5      && <6.1
-    , yaml-streamly          ^>=0.12.0
+    , yaml-streamly          >=0.12.5 && <0.13
 
   if flag(tar)
     cpp-options:   -DTAR
@@ -202,7 +202,7 @@ library
     , safe                  ^>=0.3.18
     , safe-exceptions       ^>=0.1
     , split                 ^>=0.2.3.4
-    , streamly              ^>=0.8.2
+    , streamly-core         >=0.2.0 && <0.3.0
     , strict-base           ^>=0.4
     , template-haskell       >=2.7      && <2.22
     , temporary             ^>=1.3
@@ -403,7 +403,7 @@ test-suite ghcup-test
     , hspec-golden-aeson        ^>=0.9
     , QuickCheck                ^>=2.14.1
     , quickcheck-arbitrary-adt  ^>=0.3.1.0
-    , streamly                  ^>=0.8.2
+    , streamly-core             >=0.2.0 && <0.3.0
     , text                      ^>=2.0
     , time                      >=1.9.3   && <1.12
     , uri-bytestring            ^>=0.3.2.2

lib/GHCup.hs

@@ -77,7 +77,7 @@ import           System.IO.Temp
 import           Text.Regex.Posix
 
 import qualified Data.Text                     as T
-import qualified Streamly.Prelude              as S
+import qualified Streamly.Data.Stream          as S
 
 
 
@@ -673,5 +673,3 @@ rmTmp = do
   forM_ ghcup_dirs $ \f -> do
     logDebug $ "rm -rf " <> T.pack (fromGHCupPath f)
     rmPathForcibly f
-
-

lib/GHCup/Prelude/File.hs

@@ -73,7 +73,8 @@ import           System.FilePath
 import           Text.PrettyPrint.HughesPJClass (prettyShow)
 
 import qualified Data.Text                     as T
-import qualified Streamly.Prelude              as S
+import qualified Streamly.Data.Stream          as S
+import qualified Streamly.Data.Fold            as F
 import Control.DeepSeq (force)
 import Control.Exception (evaluate)
 import GHC.IO.Exception
@@ -88,7 +89,7 @@ import System.IO.Error
 -- If any copy operation fails, the record file is deleted, as well
 -- as the partially installed files.
 mergeFileTree :: ( MonadMask m
-                 , S.MonadAsync m
+                 , MonadIO m
                  , MonadReader env m
                  , HasDirs env
                  , HasLog env
@@ -127,7 +128,7 @@ mergeFileTree sourceBase destBase tool v' copyOp = do
   -- we want the cleanup action to leak through in case of exception
   onE_ (cleanupOnPartialInstall recFile) $ wrapInExcepts $ do
     logDebug "Starting merge"
-    lift $ flip S.mapM_ (getDirectoryContentsRecursive sourceBase) $ \f -> do
+    lift $ flip S.fold (getDirectoryContentsRecursive sourceBase) $ F.drainMapM $ \f -> do
       copy f
       logDebug $ T.pack "Recording installed file: " <> T.pack f
       recordInstalledFile f recFile
@@ -189,26 +190,26 @@ copyFileE from to = handleIO (throwE . CopyError . show) . liftIO . copyFile fro
 -- the source directory structure changes before the list is used.
 --
 -- depth first
-getDirectoryContentsRecursiveDFS :: (MonadCatch m, S.MonadAsync m, MonadMask m)
+getDirectoryContentsRecursiveDFS :: (MonadCatch m, MonadIO m, MonadMask m)
                                  => GHCupPath
-                                 -> S.SerialT m FilePath
+                                 -> S.Stream m FilePath
 getDirectoryContentsRecursiveDFS (fromGHCupPath -> fp) = getDirectoryContentsRecursiveDFSUnsafe fp
 
 -- breadth first
-getDirectoryContentsRecursiveBFS :: (MonadCatch m, S.MonadAsync m, MonadMask m)
+getDirectoryContentsRecursiveBFS :: (MonadCatch m, MonadIO m, MonadMask m)
                                  => GHCupPath
-                                 -> S.SerialT m FilePath
+                                 -> S.Stream m FilePath
 getDirectoryContentsRecursiveBFS (fromGHCupPath -> fp) = getDirectoryContentsRecursiveBFSUnsafe fp
 
 
-getDirectoryContentsRecursive :: (MonadCatch m, S.MonadAsync m, MonadMask m)
+getDirectoryContentsRecursive :: (MonadCatch m, MonadIO m, MonadMask m)
                               => GHCupPath
-                              -> S.SerialT m FilePath
+                              -> S.Stream m FilePath
 getDirectoryContentsRecursive = getDirectoryContentsRecursiveBFS
 
-getDirectoryContentsRecursiveUnsafe :: (MonadCatch m, S.MonadAsync m, MonadMask m)
+getDirectoryContentsRecursiveUnsafe :: (MonadCatch m, MonadIO m, MonadMask m)
                                     => FilePath
-                                    -> S.SerialT m FilePath
+                                    -> S.Stream m FilePath
 getDirectoryContentsRecursiveUnsafe = getDirectoryContentsRecursiveBFSUnsafe
 
 findFilesDeep :: GHCupPath -> Regex -> IO [FilePath]

lib/GHCup/Prelude/File/Posix.hs

@@ -26,7 +26,6 @@ import           System.IO                      ( hClose, hSetBinaryMode )
 import           System.IO.Error      hiding    ( catchIOError )
 import           System.FilePath
 import           System.Directory               ( removeFile, pathIsSymbolicLink, getSymbolicLinkTarget, doesPathExist )
-import           System.Posix.Directory
 import           System.Posix.Error             ( throwErrnoPathIfMinus1Retry )
 import           System.Posix.Internals         ( withFilePath )
 import           System.Posix.Files
@@ -40,13 +39,13 @@ import qualified System.Posix as Posix
 import qualified Streamly.FileSystem.Handle    as FH
 import qualified Streamly.Internal.FileSystem.Handle
                                                as IFH
-import qualified Streamly.Prelude              as S
+import qualified Streamly.Data.Stream          as S
 import qualified GHCup.Prelude.File.Posix.Foreign as FD
-import qualified Streamly.Internal.Data.Stream.StreamD.Type
-                                               as D
-import           Streamly.Internal.Data.Unfold.Type
+import qualified Streamly.Internal.Data.Stream as D
+
+import Streamly.Internal.Data.Unfold (Unfold(..))
 import qualified Streamly.Internal.Data.Unfold as U
-import           Streamly.Internal.Control.Concurrent ( withRunInIO )
+
 import           Streamly.Internal.Data.IOFinalizer   ( newIOFinalizer, runIOFinalizer )
 import GHC.IO.Exception (IOException(ioe_type), IOErrorType (..))
 
@@ -140,7 +139,7 @@ copyFile from to fail' = do
     handle' <- SPI.fdToHandle fd
     pure (fd, handle')
   streamlyCopy (fH, tH) =
-    S.fold (FH.writeChunks tH) $ IFH.toChunksWithBufferOf (256 * 1024) fH
+    S.fold (FH.writeChunks tH) $ IFH.readChunksWith (256 * 1024) fH
 
 foreign import capi unsafe "fcntl.h open"
    c_open :: CString -> CInt -> Posix.CMode -> IO CInt
@@ -278,8 +277,8 @@ 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 . openDirStreamPortable) (liftIO . closeDirStreamPortable) (Unfold step return)
+unfoldDirContents :: (MonadIO m, MonadCatch m) => Unfold m FilePath (FD.DirType, FilePath)
+unfoldDirContents = U.bracketIO openDirStreamPortable closeDirStreamPortable (Unfold step return)
  where
   {-# INLINE [0] step #-}
   step dirstream = do
@@ -291,17 +290,17 @@ unfoldDirContents = U.bracket (liftIO . openDirStreamPortable) (liftIO . closeDi
       | otherwise -> D.Yield (typ, e) dirstream
 
 
-getDirectoryContentsRecursiveDFSUnsafe :: (MonadMask m, MonadIO m, S.MonadAsync m)
+getDirectoryContentsRecursiveDFSUnsafe :: (MonadIO m, MonadCatch m)
                                        => FilePath
-                                       -> S.SerialT m FilePath
+                                       -> S.Stream m FilePath
 getDirectoryContentsRecursiveDFSUnsafe fp = go ""
  where
   go cd = flip S.concatMap (S.unfold unfoldDirContents (fp </> cd)) $ \(t, f) ->
     if | t == FD.dtDir -> go (cd </> f)
-       | otherwise     -> pure (cd </> f)
+       | otherwise     -> S.fromPure (cd </> f)
 
 
-getDirectoryContentsRecursiveUnfold :: (MonadMask m, MonadIO m, S.MonadAsync m) => Unfold m FilePath FilePath
+getDirectoryContentsRecursiveUnfold :: (MonadIO m, MonadMask m) => Unfold m FilePath FilePath
 getDirectoryContentsRecursiveUnfold = Unfold step (\s -> return (s, Nothing, [""]))
  where
   {-# INLINE [0] step #-}
@@ -321,15 +320,12 @@ getDirectoryContentsRecursiveUnfold = Unfold step (\s -> return (s, Nothing, [""
     (s, f) <- acquire (topdir </> dir)
     return $ D.Skip (topdir, Just (dir, s, f), dirs)
 
-  acquire dir =
-    withRunInIO $ \run -> mask_ $ run $ do
+  acquire dir = do
         dirstream <- liftIO $ openDirStreamPortable dir
         ref <- newIOFinalizer (liftIO $ closeDirStreamPortable dirstream)
         return (dirstream, ref)
 
-getDirectoryContentsRecursiveBFSUnsafe :: (MonadMask m, MonadIO m, S.MonadAsync m)
+getDirectoryContentsRecursiveBFSUnsafe :: (MonadIO m, MonadMask m)
                                        => FilePath
-                                       -> S.SerialT m FilePath
+                                       -> S.Stream m FilePath
 getDirectoryContentsRecursiveBFSUnsafe = S.unfold getDirectoryContentsRecursiveUnfold
-
-

lib/GHCup/Utils.hs

@@ -87,7 +87,8 @@ import qualified Data.Text                     as T
 import qualified Data.Text.Encoding            as E
 import qualified Text.Megaparsec               as MP
 import qualified Data.List.NonEmpty            as NE
-import qualified Streamly.Prelude              as S
+import qualified Streamly.Data.Stream          as S
+import qualified Streamly.Data.Fold            as F
 
 import Control.DeepSeq (force)
 import GHC.IO (evaluate)
@@ -1174,7 +1175,7 @@ installDestSanityCheck :: ( MonadIO m
                           Excepts '[DirNotEmpty] m ()
 installDestSanityCheck (IsolateDirResolved isoDir) = do
   hideErrorDef [doesNotExistErrorType] () $ do
-    empty' <- liftIO $ S.null $ getDirectoryContentsRecursiveUnsafe isoDir
+    empty' <- liftIO $ S.fold F.null $ getDirectoryContentsRecursiveUnsafe isoDir
     when (not empty') (throwE $ DirNotEmpty isoDir)
 installDestSanityCheck _ = pure ()
 
@@ -1284,4 +1285,3 @@ expandVersionPattern cabalVer gitHashS gitHashL gitDescribe gitBranch
   go (GitDescribe:xs) = gitDescribe <> go xs
   go (GitBranchName:xs) = gitBranch <> go xs
   go (S str:xs) = str <> go xs
-

test/ghcup-test/GHCup/Utils/FileSpec.hs

@@ -6,8 +6,8 @@ import           Data.List
 import           System.Directory
 import           System.FilePath
 import           System.IO.Unsafe
-import qualified Streamly.Prelude              as S
-
+import qualified Streamly.Data.Stream          as S
+import qualified Streamly.Data.Fold            as F
 import           Test.Hspec
 
 
@@ -16,13 +16,13 @@ spec :: Spec
 spec = do
   describe "GHCup.Utils.File" $ do
     it "getDirectoryContentsRecursiveBFS" $ do
-      l1 <- sort <$> S.toList (getDirectoryContentsRecursiveBFSUnsafe "lib")
+      l1 <- sort <$> S.fold F.toList (getDirectoryContentsRecursiveBFSUnsafe "lib")
       l2 <- sort <$> getDirectoryContentsRecursiveLazy "lib"
       not (null l1) `shouldBe` True
       not (null l2) `shouldBe` True
       l1 `shouldBe` l2
     it "getDirectoryContentsRecursiveDFS" $ do
-      l1 <- sort <$> S.toList (getDirectoryContentsRecursiveDFSUnsafe "lib")
+      l1 <- sort <$> S.fold F.toList (getDirectoryContentsRecursiveDFSUnsafe "lib")
       l2 <- sort <$> getDirectoryContentsRecursiveLazy "lib"
       not (null l1) `shouldBe` True
       not (null l2) `shouldBe` True
@@ -54,5 +54,3 @@ getDirectoryContentsRecursiveLazy topdir = recurseDirectories [""]
         ignore ['.']      = True
         ignore ['.', '.'] = True
         ignore _          = False
-
-