recorrido transversal ancho del árbol de directorios no es flojo

Question

Intento atravesar el árbol de directorios. Un recorrido ingenuo en profundidad no parece producir los datos de forma perezosa y se queda sin memoria. Luego probé un primer acercamiento de amplitud, que muestra el mismo problema: usa toda la memoria disponible y luego se cuelga.

el código que tengo es:

getFilePathBreadtFirst :: FilePath -> IO [FilePath] 
getFilePathBreadtFirst fp = do 
    fileinfo <- getInfo fp 
    res :: [FilePath] <- if isReadableDirectory fileinfo 
      then do 
       children <- getChildren fp 
       lower <- mapM getFilePathBreadtFirst children 
       return (children ++ concat lower) 
      else return [fp]  -- should only return the files? 
    return res 

getChildren :: FilePath -> IO [FilePath] 
getChildren path = do 
      names <- getUsefulContents path 
      let namesfull = map (path </>) names 
      return namesfull 

testBF fn = do -- crashes for /home/frank, does not go to swap 
    fps <- getFilePathBreadtFirst fn 
    putStrLn $ unlines fps 

creo que todo el código es lineal o cola recursiva, y yo esperaría que la lista de nombres de archivo se inicia de inmediato, pero en realidad no lo hace. ¿Dónde está el error en mi código y mi forma de pensar? ¿Dónde he perdido la evaluación perezosa?

Answer 1

Usaré tres trucos para resolver su pregunta.

• Trick 1: Utilice la biblioteca pipes para transmitir los nombres de archivos concurrentes con recorrer el árbol.
• Truco 2: Utilice el transformador StateT (Seq FilePath) para lograr un recorrido transversal en anchura.
• Truco 3: Utilice el transformador MaybeT para evitar la recursión manual al escribir el bucle y salir.

El siguiente código combina estos tres trucos en una sola pila de transformadores monad.

import Control.Monad 
import Control.Monad.Trans 
import Control.Monad.Trans.Maybe 
import Control.Monad.State.Lazy 
import Control.Pipe 
import Data.Sequence 
import System.FilePath.Posix 
import System.Directory 

loop :: (Monad m) => MaybeT m a -> m() 
loop = liftM (maybe() id) . runMaybeT . forever 

quit :: (Monad m) => MaybeT m a 
quit = mzero 

getUsefulContents :: FilePath -> IO [FilePath] 
getUsefulContents path 
    = fmap (filter (`notElem` [".", ".."])) $ getDirectoryContents path 

permissible :: FilePath -> IO Bool 
permissible file 
    = fmap (\p -> readable p && searchable p) $ getPermissions file 

traverseTree :: FilePath -> Producer FilePath IO() 
traverseTree path = (`evalStateT` empty) $ loop $ do 
    -- All code past this point uses the following monad transformer stack: 
    -- MaybeT (StateT (Seq FilePath) (Producer FilePath IO))() 
    let liftState = lift 
     liftPipe = lift . lift 
     liftIO = lift . lift . lift 
    liftState $ modify (|> path) 
    forever $ do 
     x <- liftState $ gets viewl 
     case x of 
      EmptyL -> quit 
      file :< s -> do 
       liftState $ put s 
       liftPipe $ yield file 
       p <- liftIO $ doesDirectoryExist file 
       when p $ do 
        names <- liftIO $ getUsefulContents file 
        -- allowedNames <- filterM permissible names 
        let namesfull = map (path </>) names 
        liftState $ forM_ namesfull $ \name -> modify (|> name) 

Esto crea un generador de nombres de archivo en amplitud que pueden ser consumidos concurrente con el recorrido de árbol. Se consumen los valores usando:

printer :: (Show a) => Consumer a IO r 
printer = forever $ do 
    a <- await 
    lift $ print a 

>>> runPipe $ printer <+< traverseTree path 
<Prints file names as it traverses the tree> 

incluso se puede optar por no exigir todos los valores:

-- Demand only 'n' elements 
take' :: (Monad m) => Int -> Pipe a a m() 
take' n = replicateM_ n $ do 
    a <- await 
    yield a 

>> runPipe $ printer <+< take' 3 <+< traverseTree path 
<Prints only three files> 

Más importante aún, ese último ejemplo sólo recorrer el árbol tanto como sea necesario para generar los tres archivos y luego se detendrá. ¡Esto evita recorrer innecesariamente todo el árbol cuando todo lo que quería eran 3 resultados!

Para obtener más información sobre el truco de la biblioteca pipes, consulte pipes tutorial en Control.Pipes.Tutorial.

Para obtener más información sobre el truco de bucle, lea este blog post.

No pude encontrar un buen enlace para el truco de la cola para el primer cruce transversal, pero sé que está por ahí en alguna parte. Si alguien más conoce un buen enlace para esto, solo edita mi respuesta para agregarlo.

Answer 2

he separado la gestión de la tubería y el recorrido del árbol. aquí en primer lugar el código de la tubería (esencialmente el código de Gonzales - gracias!):

traverseTree :: FilePath -> Producer FilePath IO() 
--^traverse a tree in breadth first fashion using an external doBF function 
traverseTree path = (`evalStateT` empty) $ loop $ do 
-- All code past this point uses the following monad transformer stack: 
-- MaybeT (StateT (Seq FilePath) (Producer FilePath IO))() 
let liftState = lift 
    liftPipe = lift . lift 
    liftIO = lift . lift . lift 
liftState $ modify (|> path) 
forever $ do 
    x <- liftState $ gets viewl 
    case x of 
     EmptyL -> quit 
     file :< s -> do 
      (yieldval, nextInputs) <- liftIO $ doBF file 
      liftState $ put s 
      liftPipe $ yield yieldval 
      liftState $ forM_ nextInputs $ \name -> modify (|> name) 

siguiente, el código para el recorrido del árbol:

doBF :: FilePath -> IO (FilePath, [FilePath]) 
doBF file = do 
    finfo <- getInfo file 
    let p = isReadableDirectoryNotLink finfo 
    namesRes <- if p then do 
     names :: [String] <- liftIO $ getUsefulContents file 
     let namesSorted = sort names 
     let namesfull = map (file </>) namesSorted 
     return namesfull 
     else return []   
    return (file, namesRes) 

espero para reemplazar doBF con una función similar para atravesar la profundidad primero.Supuse que podría hacer que el traverseTree fuera más general y no solo para FilePath ~ String, pero no veo en qué clase está la función vacía en las secuencias. podría ser generalmente útil.