Use GHC2024 and GHC2021 extensions

Author: harendra-kumar

benchmark/Streamly/Benchmark/Data/Array.hs

@@ -5,13 +5,15 @@
 #include "Streamly/Benchmark/Data/Array/CommonImports.hs"
 
 import Control.DeepSeq (deepseq)
+import Data.Kind (Type)
 
 import qualified Streamly.Internal.Data.Array as IA
 import qualified GHC.Exts as GHC
 
 -- import qualified Streamly.Data.Array as A
 import qualified Streamly.Internal.Data.Array as A
 
+type Stream :: Type -> Type
 type Stream = A.Array
 
 #include "Streamly/Benchmark/Data/Array/Common.hs"

benchmark/Streamly/Benchmark/Data/MutArray.hs

@@ -22,6 +22,7 @@
 import Control.DeepSeq (NFData(..))
 import Control.Monad.IO.Class (MonadIO)
 import Data.Functor ((<&>))
+import Data.Kind (Type)
 import System.Random (randomRIO)
 import Prelude
     ( IO
@@ -52,6 +53,7 @@ import qualified Streamly.Internal.Data.Stream as Stream
 import Test.Tasty.Bench
 import Streamly.Benchmark.Common hiding (benchPureSrc)
 
+type Stream :: Type -> Type
 type Stream = MutArray
 
 instance NFData (MutArray a) where

benchmark/streamly-benchmarks.cabal

@@ -69,6 +69,17 @@ flag use-prelude
 -------------------------------------------------------------------------------
 
 common default-extensions
+    -- GHC2024 may include more extensions than we are actually using, see the
+    -- full list below. We enable this to ensure that we are able to compile
+    -- with this i.e. there is no interference by other extensions.
+    if impl(ghc >= 9.10)
+      default-extensions:
+        GHC2024
+
+    if impl(ghc >= 9.2) && impl(ghc < 9.10)
+      default-extensions:
+        GHC2021
+
     default-extensions:
         BangPatterns
         CApiFFI

core/src/Streamly/Internal/Data/Parser.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE NoMonoLocalBinds #-}
 -- |
 -- Module      : Streamly.Internal.Data.Parser
 -- Copyright   : (c) 2020 Composewell Technologies

core/src/Streamly/Internal/Data/Parser/Type.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE NoMonoLocalBinds #-}
 -- |
 -- Module      : Streamly.Internal.Data.Parser.ParserD.Type
 -- Copyright   : (c) 2020 Composewell Technologies
@@ -969,7 +970,7 @@ data Fused3 a b c = Fused3 !a !b !c
 -- /Pre-release/
 --
 {-# INLINE splitMany #-}
-splitMany :: Monad m => Parser a m b -> Fold m b c -> Parser a m c
+splitMany :: forall m a b c. Monad m => Parser a m b -> Fold m b c -> Parser a m c
 splitMany (Parser step1 initial1 extract1) (Fold fstep finitial _ ffinal) =
     Parser step initial extract
 
@@ -978,6 +979,22 @@ splitMany (Parser step1 initial1 extract1) (Fold fstep finitial _ ffinal) =
     -- Caution! There is mutual recursion here, inlining the right functions is
     -- important.
 
+{-
+    iHandleCollect partial done fres =
+        case fres of
+            FL.Partial fs -> do
+                pres <- initial1
+                case pres of
+                    IPartial ps -> return $ partial $ Fused3 ps 0 fs
+                    IDone pb ->
+                        iRunCollectorWith (iHandleCollect partial done) fs pb
+                    IError _ -> done <$> ffinal fs
+            FL.Done fb -> return $ done fb
+    iRunCollectorWith cont fs pb = fstep fs pb >>= cont
+    -}
+
+    -- XXX A copy of the code above. polymorphism does not work with
+    -- MonoLocalBinds.
     handleCollect partial done fres =
         case fres of
             FL.Partial fs -> do
@@ -993,6 +1010,7 @@ splitMany (Parser step1 initial1 extract1) (Fold fstep finitial _ ffinal) =
 
     -- See notes in Fold.many for the reason why the parser must be initialized
     -- right away instead of on first input.
+    -- initial = finitial >>= iHandleCollect IPartial IDone
     initial = finitial >>= handleCollect IPartial IDone
 
     {-# INLINE step #-}

core/src/Streamly/Internal/Data/StreamK/Type.hs

@@ -164,6 +164,7 @@ import Control.Monad.IO.Class (MonadIO(..))
 import Data.Foldable (Foldable(foldl'), fold, foldr)
 import Data.Function (fix)
 import Data.Functor.Identity (Identity(..))
+import Data.Kind (Type)
 import Data.Maybe (fromMaybe)
 import Data.Semigroup (Endo(..))
 import GHC.Exts (IsList(..), IsString(..), oneShot)
@@ -233,12 +234,14 @@ mkStream
 mkStream = MkStream
 
 -- | A terminal function that has no continuation to follow.
+type StopK :: (Type -> Type) -> Type
 type StopK m = forall r. m r -> m r
 
 -- | A monadic continuation, it is a function that yields a value of type "a"
 -- and calls the argument (a -> m r) as a continuation with that value. We can
 -- also think of it as a callback with a handler (a -> m r).  Category
 -- theorists call it a codensity type, a special type of right kan extension.
+type YieldK :: (Type -> Type) -> Type -> Type
 type YieldK m a = forall r. (a -> m r) -> m r
 
 _wrapM :: Monad m => m a -> YieldK m a

core/src/Streamly/Internal/FileSystem/File.hs

@@ -95,6 +95,7 @@ where
 
 import Control.Monad.Catch (MonadCatch)
 import Control.Monad.IO.Class (MonadIO(..))
+import Data.Kind (Type)
 import Data.Word (Word8)
 import System.IO (Handle, openFile, IOMode(..), hClose)
 import Prelude hiding (read)
@@ -204,15 +205,15 @@ usingFile3 = UF.bracketIO before after
 -- /Pre-release/
 --
 {-# INLINABLE putChunk #-}
-putChunk :: FilePath -> Array a -> IO ()
+putChunk :: forall (a :: Type). FilePath -> Array a -> IO ()
 putChunk file arr = SIO.withFile file WriteMode (`FH.putChunk` arr)
 
 -- | append an array to a file.
 --
 -- /Pre-release/
 --
 {-# INLINABLE writeAppendArray #-}
-writeAppendArray :: FilePath -> Array a -> IO ()
+writeAppendArray :: forall (a :: Type). FilePath -> Array a -> IO ()
 writeAppendArray file arr = SIO.withFile file AppendMode (`FH.putChunk` arr)
 
 -------------------------------------------------------------------------------
@@ -369,7 +370,7 @@ readShared = undefined
 -------------------------------------------------------------------------------
 
 {-# INLINE fromChunksMode #-}
-fromChunksMode :: (MonadIO m, MonadCatch m)
+fromChunksMode :: forall m (a :: Type). (MonadIO m, MonadCatch m)
     => IOMode -> FilePath -> Stream m (Array a) -> m ()
 fromChunksMode mode file xs = S.fold drain $
     withFile file mode (\h -> S.mapM (FH.putChunk h) xs)
@@ -379,7 +380,7 @@ fromChunksMode mode file xs = S.fold drain $
 -- /Pre-release/
 --
 {-# INLINE fromChunks #-}
-fromChunks :: (MonadIO m, MonadCatch m)
+fromChunks :: forall m (a :: Type). (MonadIO m, MonadCatch m)
     => FilePath -> Stream m (Array a) -> m ()
 fromChunks = fromChunksMode WriteMode
 
@@ -431,7 +432,7 @@ write = toHandleWith A.defaultChunkSize
 --
 -- /Pre-release/
 {-# INLINE writeChunks #-}
-writeChunks :: (MonadIO m, MonadCatch m)
+writeChunks :: forall m (a :: Type). (MonadIO m, MonadCatch m)
     => FilePath -> Fold m (Array a) ()
 writeChunks path = Fold step initial extract final
     where
@@ -487,7 +488,7 @@ write = writeWith defaultChunkSize
 -- /Pre-release/
 --
 {-# INLINE writeAppendChunks #-}
-writeAppendChunks :: (MonadIO m, MonadCatch m)
+writeAppendChunks :: forall m (a :: Type). (MonadIO m, MonadCatch m)
     => FilePath -> Stream m (Array a) -> m ()
 writeAppendChunks = fromChunksMode AppendMode
 

core/src/Streamly/Internal/FileSystem/Handle.hs

@@ -121,6 +121,7 @@ where
 import Control.Exception (assert)
 import Control.Monad.IO.Class (MonadIO(..))
 import Data.Function ((&))
+import Data.Kind (Type)
 import Data.Maybe (isNothing, fromJust)
 import Data.Word (Word8)
 import Streamly.Internal.Data.Unbox (Unbox)
@@ -373,7 +374,7 @@ read = A.concat . readChunks
 -- | Write an 'Array' to a file handle.
 --
 {-# INLINABLE putChunk #-}
-putChunk :: MonadIO m => Handle -> Array a -> m ()
+putChunk :: forall m (a :: Type). MonadIO m => Handle -> Array a -> m ()
 putChunk _ arr | byteLength arr == 0 = return ()
 putChunk h arr = A.unsafePinnedAsPtr arr $ \ptr byteLen ->
     liftIO $ hPutBuf h ptr byteLen
@@ -392,7 +393,8 @@ putChunk h arr = A.unsafePinnedAsPtr arr $ \ptr byteLen ->
 -- >>> putChunks h = Stream.fold (Fold.drainBy (Handle.putChunk h))
 --
 {-# INLINE putChunks #-}
-putChunks :: MonadIO m => Handle -> Stream m (Array a) -> m ()
+putChunks :: forall m (a :: Type). MonadIO m =>
+    Handle -> Stream m (Array a) -> m ()
 putChunks h = S.fold (FL.drainMapM (putChunk h))
 
 -- XXX AS.compact can be written idiomatically in terms of foldMany, just like
@@ -437,14 +439,14 @@ putBytes = putBytesWith defaultChunkSize
 -- writeChunks h = Fold.drainBy (Handle.putChunk h)
 --
 {-# INLINE writeChunks #-}
-writeChunks :: MonadIO m => Handle -> Fold m (Array a) ()
+writeChunks :: forall m (a :: Type). MonadIO m => Handle -> Fold m (Array a) ()
 writeChunks h = FL.drainMapM (putChunk h)
 
 -- | Like writeChunks but uses the experimental 'Refold' API.
 --
 -- /Internal/
 {-# INLINE chunkWriter #-}
-chunkWriter :: MonadIO m => Refold m Handle (Array a) ()
+chunkWriter :: forall m (a :: Type). MonadIO m => Refold m Handle (Array a) ()
 chunkWriter = Refold.drainBy putChunk
 
 -- | @writeChunksWith bufsize handle@ writes a stream of arrays

core/streamly-core.cabal

@@ -214,6 +214,20 @@ common compile-options
       cpp-options: -DUSE_UNLIFTIO
 
 common default-extensions
+    -- GHC2024 may include more extensions than we are actually using, see the
+    -- full list below. We enable this to ensure that we are able to compile
+    -- with this i.e. there is no interference by other extensions.
+    if impl(ghc >= 9.10)
+      default-extensions:
+        GHC2024
+        -- XXX Check performance with MonoLocalBinds
+        -- NoMonoLocalBinds
+
+    if impl(ghc >= 9.2) && impl(ghc < 9.10)
+      default-extensions:
+        GHC2021
+
+    -- In GHC 2024
     default-extensions:
         BangPatterns
         ConstraintKinds
@@ -226,6 +240,7 @@ common default-extensions
         GeneralizedNewtypeDeriving
         InstanceSigs
         KindSignatures
+        LambdaCase
         MultiParamTypeClasses
         RankNTypes
         ScopedTypeVariables
@@ -234,11 +249,10 @@ common default-extensions
         TypeApplications
         TypeOperators
 
-        -- Not GHC2021
+        -- Not in GHC2024
         CApiFFI
         CPP
         DefaultSignatures
-        LambdaCase
         MagicHash
         RecordWildCards
 

src/Streamly/Internal/Data/Stream/Channel/Operations.hs

@@ -33,6 +33,7 @@ import Control.Exception (fromException)
 import Control.Monad (when)
 import Control.Monad.Catch (throwM, MonadThrow)
 import Control.Monad.IO.Class (MonadIO(liftIO))
+import Data.Kind (Type)
 import Data.IORef (newIORef, readIORef, mkWeakIORef, writeIORef)
 import Data.Maybe (isNothing)
 import Streamly.Internal.Control.Concurrent
@@ -262,6 +263,7 @@ fromChannelK chan =
 fromChannel :: MonadAsync m => Channel m a -> Stream m a
 fromChannel = Stream.fromStreamK . fromChannelK
 
+type FromSVarState :: Type -> (Type -> Type) -> Type -> Type
 data FromSVarState t m a =
       FromSVarInit
     | FromSVarRead (Channel m a)