Attempts at doing DFS with Reader and hylo

dfs.hs

{-# LANGUAGE FlexibleContexts #-}
import Data.Maybe (fromMaybe)
import Control.Monad.Reader

gl =
  [ (0, [0, 1, 4])
  , (1, [0, 2])
  , (2, [3, 4])
  , (3, [2, 1])
  , (4, [])
  ]

g x = fromMaybe [] $ lookup x gl

echo x y = liftIO $ putStrLn $ x ++ show y

dfs graph start =
  asks (elem start) >>= \b ->
    if b 
      then echo "Cycle detected involving: " start
      else do
        echo "Visiting: " start
--      Use of `local` below
--      vvvvv
        local (start:) $ do
--        Explicit recursion below
--               vvv
          mapM_ (dfs graph) $ graph start
        echo "Done with: " start

main = runReaderT (dfs g 0) []

dfs2.hs

{-# LANGUAGE FlexibleContexts #-}
import Data.Maybe (fromMaybe)
import Control.Monad.Reader

gl =
  [ (0, [0, 1, 4])
  , (1, [0, 2])
  , (2, [3, 4])
  , (3, [2, 1])
  , (4, [])
  ]

g x = fromMaybe [] $ lookup x gl

echo x y = liftIO $ putStrLn $ x ++ show y

-- I guess explicitly passing the parameter that changes might be easier to work with
dfs stack start =
  if elem start stack
    then echo "Cycle detected involving: " start
    else do
      echo "Visiting: " start
--    Explicit recursion below
--           vvv
      mapM_ (dfs $ start:stack) =<< asks ($ start)
      echo "Done with: " start

main = runReaderT (dfs [] 0) g

dfs3.hs

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -fdefer-typed-holes #-}
import Data.Maybe (fromMaybe)
import Control.Monad.Reader
import Data.Functor.Compose

gl :: [(Int,[Int])]
gl =
  [ (0, [4, 0, 1])
  , (1, [0, 2])
  , (2, [4, 3])
  , (3, [2, 1])
  , (4, [])
  ]

g x = fromMaybe [] $ lookup x gl

echo x y = liftIO $ putStrLn $ x ++ show y

dfs graph stack start =
  if elem start stack
    then echo "Cycle detected involving: " start >> return []
    else do
      echo "Visiting: " start
      results <- mapM (dfs graph $ start:stack) $ graph start
      echo "Done with: " start
      return $ start : concat results

hyloM :: (Traversable t, Monad m) =>
         (t b -> m b) -> (a -> m (t a)) -> a -> m b
hyloM b a = b <=< sequence . fmap (hyloM b a) <=< a

g' (x, xs) = Compose $ (x,) $ if elem x xs then [] else map (, x:xs) $ g x

data Walk a b
  = Cycle a
  | Next a [b]
  deriving (Show, Functor, Foldable, Traversable)

dfsHelper graph stack start =
  if elem start stack
    then Nothing
    else Just $ graph start

dfsHelper' graph (start, stack) = do
  case dfsHelper graph stack start of
    Nothing   -> do
      echo "Cycle detected involving: " start
      return $ Cycle start
    Just xs   -> do
      echo "Visiting: " start
      return $ Next start $ map (, start:stack) xs
--  maybe (return ()) (\x -> echo "Visiting: " x) ms
--  return $ Compose (ms, map (, start:stack) res)

dfsOutHelper = \case
  Cycle x   -> return []
  Next x xs -> do
    echo "Done with: " x
    return $ x : concat xs

pr x = do
  -- print x 
  return x

main = do
  print =<< (dfs g [] 0)
  putStrLn ""
  print =<< hyloM (dfsOutHelper <=< pr) ((dfsHelper' g) <=< pr) (0 :: Int, [])

dfs4.hs

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TupleSections #-}
import Data.Maybe (fromMaybe)
import Control.Monad.Reader
import Data.Functor.Compose
import Data.Functor.Foldable

-- Credit goes to sccrstud92: https://www.reddit.com/r/haskell/comments/3dngke/help_constructing_a_monadic_hylomorphism_from_a/ct6ze0n

gl =
  [ (0, [0, 1, 4])
  , (1, [0, 2])
  , (2, [3, 4])
  , (3, [2, 1])
  , (4, [])
  ]

g x = fromMaybe [] $ lookup x gl

echo x y = liftIO $ putStrLn $ x ++ show y

dfs graph start =
  asks (elem start) >>= \b ->
    if b
      then echo "Cycle detected involving: " start
      else do
        echo "Visiting: " start
--      Use of `local` below
--      vvvvv
        local (start:) $ do
--        Explicit recursion below
--               vvv
          mapM_ (dfs graph) $ graph start
        echo "Done with: " start

main = runReaderT (dfs g 0) []


g2 :: ([Int], Int) -> (Int, Maybe [([Int], Int)])
g2 (path, s) = if elem s path
    then (s, Nothing)
    else (s, Just $ map (s:path,) $ g s)

f2 :: (Int, Maybe [IO ()]) -> IO ()
f2 (start, foo) = case foo of
    Nothing -> echo "Cycle detected involving: " start
    Just actions -> do
        echo "Visiting: " start
        sequence_ actions
        echo "Done with: " start

main2 = hylo (f2 . getCompose . getCompose) (Compose . Compose . g2) ([], 0)


g3 :: Int -> (Int, [Int])
g3 s = (s, g s)

f3 :: (Int, [ReaderT [Int] IO ()]) -> ReaderT [Int] IO ()
f3 (start, actions) = asks (elem start) >>= \b -> if b
    then echo "Cycle detected involving: " start
    else do
        echo "Visiting: " start
        local (start:) $ sequence_ actions
        echo "Done with: " start

main3 = runReaderT (hylo (f3 . getCompose) (Compose . g3) 0) []