ディレクトリツリーの横断検索が遅延していない

Question

ディレクトリツリーを横断しようとしました。素朴な深さ優先のトラバースは、データを怠惰な方法で生成せず、メモリが不足しているようです。私は次に、同じ問題を示している幅広い最初のアプローチを試しました。利用可能なすべてのメモリを使用してクラッシュします。

私が持っているコードは次のとおりです。

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 

私はすべてのコードは、直鎖状または末尾再帰のどちらかだと思う、と私は、ファイル名のリストがすぐに開始しますが、実際にはそうでないことを期待します。私のコードと私の考えのどこにエラーがありますか？私はどこで怠惰な評価を失ったのですか？

Answer 1

あなたの質問を解決するために3つの別々のトリックを使用します。

• トリック1：ツリーをトラバースすると同時に、ファイル名をストリーミングするpipesライブラリを使用してください。
• トリック2：幅優先トラバーサルを実現するには、StateT (Seq FilePath)トランスフォーマーを使用します。
• トリック3：MaybeTトランスフォーマを使用して、ループを書き込んで終了するときに手動再帰を回避します。

次のコードは、これらの3つのトリックを1つのモナドトランススタックで組み合わせています。

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) 

これは、ツリートラバーサルと同時に消費することができ幅優先ファイル名のジェネレータを作成します。

さらに重要な

-- 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> 

、最後の例では、3つだけを生成することと同じくらい必要に応じてツリーを走査すること：あなたもすべての値を要求しないことを選択することができ

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> 

を：あなたが使用して値を消費しますファイルを削除してから停止します。これは、あなたが望むすべてが3つの結果であったときに木全体を無駄に横切ることを防ぎます！

pipesライブラリーのトリックについて詳しくは、pipes tutorial（Control.Pipes.Tutorial）を参照してください。

ループトリックについて詳しくは、blog postをお読みください。

広さの最初のトラバーサルでキュートリックの良いリンクを見つけることができませんでしたが、どこかにあることはわかっています。他の誰かがこれに対する良いリンクを知っている場合は、自分の答えを編集して追加してください。

Answer 2

私はパイプとツリーの通過の管理を分けました。ここでは、パイプのための最初のコード（ゴンザレスの本質的コード - ありがとうございます！）：

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) 

ツリートラバーサルのためのコードを次：

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) 

私は同様の機能をdoBFを交換したいと考えていますまず深さをトラバースする。私は、TraverseTreeをFilePath〜Stringだけでなく、より一般的にすることができると仮定しましたが、シーケンス上の空の関数がどのクラスにあるのかわかりません。一般に有用である可能性がある。