DFS uses general monad m but buildAdjList works with IO only, general stream type

Remove common module import

Remove unnecessary imports, fix indentation

Author: wildcat26

src/Streamly/Coreutils.hs

@@ -1,9 +1,7 @@
 module Streamly.Coreutils
     ( module Streamly.Coreutils.Tsort
     , module Streamly.Coreutils.Uniq
-    --, module Streamly.Coreutils.Common
     ) where
 
 import Streamly.Coreutils.Tsort
 import Streamly.Coreutils.Uniq
---import Streamly.Coreutils.Common

src/Streamly/Coreutils/Tsort.hs

@@ -5,18 +5,17 @@ module Streamly.Coreutils.Tsort
     ) where
 
 import qualified Streamly.Prelude as S
---import qualified Streamly.Internal.Data.Fold as FL
 
---import Data.Char (isSpace, toLower)
+import Streamly
 import System.IO.Unsafe (unsafePerformIO)
+import Streamly.Internal.Data.Stream.StreamK (adapt)
 
-import Streamly
 
 vertices
-    :: Eq a
-    => SerialT IO (a, a)
+    :: (IsStream t, Eq a)
+    => t IO (a, a)
     -- ^ Edges
-    -> SerialT IO (Int, a)
+    -> t IO (Int, a)
     -- ^ Map each vertex to a unique integer
 vertices strm =
     S.indexed
@@ -25,86 +24,95 @@ vertices strm =
 
 
 buildAdjList
-    :: Eq a
-    => SerialT IO (a, a)
+    :: (IsStream t, Eq a)
+    => t IO (a, a)
     -- ^ stream of edges
-    -> SerialT IO (Int, a)
-    -- ^ Map from @a@ to @Int@
-    -> SerialT IO (SerialT IO Int)
+    -> t IO (Int, a)
+    -- ^ map from @a@ to @Int@
+    -> t IO (t IO Int)
     -- ^ initial adj list
-    -> SerialT IO (SerialT IO Int)
+    -> t IO (t IO Int)
     -- ^ adj list now
 buildAdjList edges vtx adj = do
-    let maybeStrm = unsafePerformIO $ S.last $ S.scanl' (insertPair vtx) adj edges
+    let maybeStrm =
+           ( unsafePerformIO
+           $ S.last
+           $ adapt
+           $ S.scanl' (insertPair vtx) adj edges
+           )
     case maybeStrm of
-         Just strm -> strm
-         Nothing -> S.nil
+        Just strm -> strm
+        Nothing -> S.nil
 
     where
 
     insertPair
-        :: Eq a
-        => SerialT IO (Int, a)
-        -> SerialT IO (SerialT IO Int)
+        :: (IsStream t, Eq a)
+        => t IO (Int, a)
+        -> t IO (t IO Int)
         -> (a, a)
-        -> SerialT IO (SerialT IO Int)
+        -> t IO (t IO Int)
     insertPair vtxMap adjl (xa, xb) = do
         let indexA = unsafePerformIO $ getInt vtxMap xa
         let indexB = unsafePerformIO $ getInt vtxMap xb
-        let maybeStrm = unsafePerformIO $ (S.!!) adjl indexA
+        let maybeStrm = unsafePerformIO $ (S.!!) (adapt adjl) indexA
         case maybeStrm of
-            Just strm -> modifyNeighbours indexA (S.cons indexB $ strm) adjl
+            Just strm -> modifyNeighbours indexA (S.cons indexB strm) adjl
             Nothing -> modifyNeighbours indexA (S.yield indexB) adjl
 
 
+
     getInt
-        :: Eq a
-        => SerialT IO (Int, a)
+        :: (IsStream t, Eq a)
+        => t IO (Int, a)
         -> a
         -> IO Int
     getInt vtxMap ele = do
-        maybeIndex <- S.findIndex (\(_, v) -> v == ele) vtxMap
+        maybeIndex <- S.findIndex (\(_, v) -> v == ele) $ adapt vtxMap
         case maybeIndex of
             Just idx -> return idx
             Nothing -> return (-1) -- won't ever equal any other index in a stream
 
     modifyNeighbours
-       :: Int
-       -> SerialT IO Int
-       -> SerialT IO (SerialT IO Int)
-       -> SerialT IO (SerialT IO Int)
+       :: IsStream t
+       => Int
+       -> t IO Int
+       -> t IO (t IO Int)
+       -> t IO (t IO Int)
     modifyNeighbours idx newNbd adjStrm =
         S.map (\(_, v) -> v)
         $ S.map (\(i, v) -> do
-                   if i == idx
-                   then (i, newNbd)
-                   else (i, v))
+            if i == idx
+            then (i, newNbd)
+            else (i, v))
         $ S.indexed adjStrm
 
 
 -- | dfs
 dfs
-    :: IsStream t
+    :: (IsStream t, Monad m)
     => Int
     -- ^ root node to start dfs
-    -> SerialT IO (SerialT IO Int)
+    -> t m (t m Int)
     -- ^ adj list
-    -> SerialT IO Bool
+    -> t m Bool
     -- ^ visited
-    -> t IO Int
+    -> t m Int
     -- ^ parent
-    -> t IO Int
+    -> t m Int
     -- ^ the stack
-    -> IO (SerialT IO Bool, t IO Int, t IO Int)
+    -> m (t m Bool, t m Int, t m Int)
     -- ^ (visited, parent, stack)
 dfs root adj vis par stck = do
-    strm <- (S.!!) adj root
+    strm <- (S.!!) (adapt adj) root
     case strm of
         Just nbd -> do
             maybeTuple <- S.last
+               $ adapt
                $ S.scanlM'
-               (\(visi, parent, stack) v -> dfs v adj
-                  (markVisited visi v) (setParent parent v root) (S.cons v stack))
+               (\(visi, parent, stack) v ->
+                   dfs v adj (markVisited visi v)
+                   (setParent parent v root) (S.cons v stack))
                (vis, par, stck)
                $ S.filterM (unVisited vis) nbd
             case maybeTuple of
@@ -115,12 +123,12 @@ dfs root adj vis par stck = do
     where
 
     unVisited
-        :: Monad m
-        => SerialT m Bool
+        :: (IsStream t, Monad m)
+        => t m Bool
         -> Int
         -> m Bool
     unVisited visStream n = do
-        ele <- (S.!!) visStream n
+        ele <- (S.!!) (adapt visStream) n
         case ele of
             Just v -> return $ not v
             Nothing -> return False