ListTree 0.1 → 0.2.0

raw patch · 3 files changed

+99/−63 lines, 3 filesdep +directorydep +filepathdep +transformersdep −mtldep ~ListPVP ok

version bump matches the API change (PVP)

Dependencies added: directory, filepath, transformers

Dependencies removed: mtl

Dependency ranges changed: List

API changes (from Hackage documentation)

Files

• ListTree.cabal +6/−6
• src/Data/List/Tree.hs +53/−57
• src/System/Directory/ListTree.hs +40/−0

@@ -1,11 +1,10 @@ Name:                ListTree-Version:             0.1+Version:             0.2.0 Category:            Algorithms-Synopsis:            Combinatoric search using ListT+Synopsis:            Trees and monadic trees expressed as monadic lists where the underlying monad is a list Description:-    Searching and pruning-    trees expressed as 'List's whose underlying monad-    is also a List.+    Directory tree structure expressed as a monadic tree.+    Searching, pruning, iterating, and processing trees. License:             BSD3 License-file:        LICENSE Author:              Yair Chuchem@@ -18,7 +17,8 @@ Library   hs-Source-Dirs:      src   Extensions:-  Build-Depends:       base >= 3 && < 5, List >= 0.2, mtl+  Build-Depends:       base >= 3 && < 5, directory >= 1.0 && < 2.0, filepath >= 1.1 && < 2.0, transformers >= 0.2, List >= 0.4.0 && < 0.6.0   Exposed-modules:     Data.List.Tree+                       System.Directory.ListTree   Ghc-Options:         -O2 -Wall 

@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts, FlexibleInstances, ScopedTypeVariables, UndecidableInstances #-}+{-# LANGUAGE FlexibleContexts, FlexibleInstances, UndecidableInstances #-}  -- | Functions for iterating trees. -- A 'List' whose underlying monad is also a 'List' is a tree.@@ -7,17 +7,15 @@ -- which can also be seen as a tree, except only its leafs -- are accessible and only in "dfs order". ----- > import Control.Monad.DList (toListT) -- > import Control.Monad.Generator -- > import Control.Monad.Trans -- > import Data.List.Class (genericTake, takeWhile, toList, lastL) -- >--- > bits = toListT (t "")--- > t prev =--- >   generate $ do--- >     yield prev--- >     x <- lift "01"--- >     yields $ t (prev ++ [x])+-- > bits = generate (t "")+-- > t prev = do+-- >   yield prev+-- >   x <- lift "01"+-- >   t (prev ++ [x]) -- > -- > > take 3 (bfsLayers bits) -- > [[""],["0","1"],["00","01","10","11"]]@@ -48,6 +46,7 @@   dfs, bfs, bfsLayers,   bestFirstSearchOn,   bestFirstSearchSortedChildrenOn,+  sortChildrenOn,   -- | Pruning methods   prune, pruneM,   branchAndBound@@ -55,13 +54,13 @@  import Control.Monad (   MonadPlus(..), guard, join, liftM, liftM2, when)-import Control.Monad.ListT (ListT)-import Control.Monad.State (StateT, MonadState(..))-import Control.Monad.Trans (lift)+import Control.Monad.ListT (ListT(..))+import Control.Monad.Trans.State (StateT, get, put)+import Control.Monad.Trans.Class (MonadTrans(lift)) import Data.List.Class (   List(..), ListItem(..), cons,-  foldrL, joinM, mergeOn, transpose,-  transformListMonad)+  foldrL, fromList, mergeOn, transpose,+  sortOn, toList, transformListMonad)  -- | A 'type-class synonym' for Trees. class (List t, List (ItemM t)) => Tree t@@ -94,61 +93,52 @@  mergeOnSortedHeads ::   (Ord b, List l) => (a -> b) -> l (l a) -> l a-mergeOnSortedHeads f ll =-  joinL $ do-    lli <- runList ll-    case lli of-      Nil -> return mzero-      Cons l ls -> do-        li <- runList l-        return $ case li of-          Nil -> mergeOnSortedHeads f ls-          Cons x xs ->-            cons x . mergeOnSortedHeads f $ bury xs ls+mergeOnSortedHeads f sortedHeads =+  -- naming convention for this func:+  -- fooh = head foo+  -- foot = tail foo+  -- foo_ = foo reconstructed after deconstruction+  -- (reconstructed so that monadic action isn't ran twice)+  joinL $ step sortedHeads mzero $+  \h t -> step h (mergeOnSortedHeads f t) $+  \hh ht -> return . cons hh . mergeOnSortedHeads f $ bury ht t   where-    bury xx yyy =-      joinL $ do-        xi <- runList xx-        case xi of-          Nil -> return yyy-          Cons x xs -> do-            let rxx = cons x xs-            yyi <- runList yyy-            case yyi of-              Nil -> return (cons rxx mzero)-              Cons yy yys -> do-                yi <- runList yy-                return $ case yi of-                  Nil -> bury xx yys-                  Cons y ys ->-                    let ryy = cons y ys-                    in if f x <= f y-                      then cons rxx . cons ryy $ yys-                      else cons ryy . bury rxx $ yys+    step list onNil onCons = do+      li <- runList list+      case li of+        Nil -> return onNil+        Cons x xs -> onCons x xs+    cache x xs func = func (cons x xs)+    bury a b =+      joinL $ step a b $+      \ah at -> cache ah at $+      \a_ -> step b (cons a_ mzero) $+      \bh bt -> step bh (bury a_ bt) $+      \bhh bht -> cache bhh bht $+      \bh_ -> return $ if f ah <= f bhh+        then cons a_ . cons bh_ $ bt+        else cons bh_ . bury a_ $ bt  -- | Prune a tree or list given a predicate. -- Unlike 'takeWhile' which stops a branch where the condition doesn't hold, -- prune "cuts" the whole branch (the underlying MonadPlus's mzero).-prune :: (List l, MonadPlus (ItemM l)) => (a -> Bool) -> l a -> l a+prune :: MonadPlus m => (a -> Bool) -> ListT m a -> ListT m a prune = pruneM . fmap return -pruneM :: (List l, MonadPlus (ItemM l)) => (a -> ItemM l Bool) -> l a -> l a-pruneM cond =-  joinM . liftM r-  where-    r x = do-      cond x >>= guard-      return x-+pruneM :: MonadPlus m => (a -> m Bool) -> ListT m a -> ListT m a+pruneM cond list = do+  x <- list+  lift (cond x >>= guard)+  return x+   -- | Best-First-Search given that a node's children are in sorted order (best first) and given a scoring function. -- Especially useful for trees where nodes have an infinite amount of children, where 'bestFirstSearchOn' will get stuck. -- -- Example: Find smallest Pythagorian Triplets -- -- > import Control.Monad--- > import Control.Monad.DList (toListT) -- > import Control.Monad.Generator--- > import Control.Monad.Trans+-- > import Control.Monad.Trans.Class -- > import Data.List.Tree -- > import Data.Maybe -- >@@ -156,7 +146,7 @@ -- >   catMaybes . -- >   fmap fst . -- >   bestFirstSearchSortedChildrenOn snd .--- >   toListT . generate $ do+-- >   generate $ do -- >     x <- lift [1..] -- >     yield (Nothing, x) -- >     y <- lift [1..]@@ -191,7 +181,7 @@   pruneM cond . transformListMonad (transformListMonad lift)   where     cond x = do-      upperSoFar <- get+      upperSoFar <- lift get       if Just True == liftM2 (>=) lower upperSoFar         then return False         else do@@ -201,8 +191,14 @@           when             ( Nothing == upperSoFar             || Just True == liftM2 (<) upper upperSoFar-            ) (put upper)+            ) (lift (put upper))           return True       where         (lower, upper) = boundFunc x +sortChildrenOn :: (Ord b, Tree t) => (a -> b) -> t a -> ListT (ItemM t) a+sortChildrenOn func =+  ListT . joinL . liftM (fromList . sortOn f) . toList . runList . transformListMonad id+  where+    f (Cons x _) = Just (func x)+    f _ = Nothing

@@ -0,0 +1,40 @@+-- | Monadic directory tree.+--+-- > -- List of files under "." or subfolders with ".markdown" extension,+-- > -- except for those with a name starting with "_" somewhere in their path. (like "_cache/index.markdown")+-- > markdownFiles :: ListT IO FilePath+-- > markdownFiles+-- >     = filter ((== ".markdown") . takeExtension) -- only take files with a ".markdown" extension+-- >     . lastL                                     -- get the leaves of the tree (files, not directories)+-- >     . scanl1 appendPath                         -- transform tree nodes to filenames including path+-- >     . prune (not . isPrefixOf "_")              -- ignore directories or files whose name starts with "_"+-- >     $ directoryTree "."                         -- directory tree starting at "."+--+-- Module name System.Directory.Tree is a better fit but it is taken by "directory-tree", a read-directory-tree-in-bulk module.++module System.Directory.ListTree +    ( directoryTree, appendPath+    ) where++import Control.Monad (guard)+import Control.Monad.IO.Class (MonadIO (liftIO))+import Control.Monad.ListT (ListT)+import Control.Monad.Trans.Class (MonadTrans (lift))+import Data.List.Class (cons, fromList)+import Data.List.Tree (prune)+import System.Directory (doesDirectoryExist, getDirectoryContents)+import System.FilePath (joinPath)++directoryTree :: MonadIO m => FilePath -> ListT (ListT m) FilePath+directoryTree rootDir =+    prune (`notElem` [".", ".."]) $ do+        dirContentsList <- liftIO $ getDirectoryContents rootDir+        pathName <- lift $ fromList dirContentsList+        cons pathName $ do+            isDir <- liftIO . doesDirectoryExist $ joinPath [rootDir, pathName]+            guard isDir+            directoryTree $ joinPath [rootDir, pathName]++-- | When used with @scanl@ or @scanl1@, transforms tree of filenames to tree of filenames with the paths+appendPath :: FilePath -> FilePath -> FilePath+appendPath x y = joinPath [x, y]