From 2e609996237d503ab65c7908e9c5c61fc62553dc Mon Sep 17 00:00:00 2001
From: Jan Sucan <jan@jansucan.com>
Date: Wed, 20 Sep 2023 15:08:54 +0200
Subject: ch09: Copy a needed file from the examples

---
 ch09/ControlledVisit.hs | 77 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 77 insertions(+)
 create mode 100644 ch09/ControlledVisit.hs

(limited to 'ch09/ControlledVisit.hs')

diff --git a/ch09/ControlledVisit.hs b/ch09/ControlledVisit.hs
new file mode 100644
index 0000000..afbff94
--- /dev/null
+++ b/ch09/ControlledVisit.hs
@@ -0,0 +1,77 @@
+module ControlledVisit
+    (
+      Info(..)
+    , getInfo
+    , getUsefulContents
+    , isDirectory
+    ) where
+
+import Control.Monad (filterM, forM, liftM)
+import Data.List (partition)
+import Data.Maybe (isJust)
+import System.Directory (Permissions(..), getDirectoryContents,
+                         getModificationTime, getPermissions)
+import System.Time (ClockTime(..))
+import System.FilePath (takeExtension, (</>))
+import Control.Exception (bracket, handle)
+import System.IO (IOMode(..), hClose, hFileSize, openFile)
+
+{-- snippet Info --}
+data Info = Info {
+      infoPath :: FilePath
+    , infoPerms :: Maybe Permissions
+    , infoSize :: Maybe Integer
+    , infoModTime :: Maybe ClockTime
+    } deriving (Eq, Ord, Show)
+
+getInfo :: FilePath -> IO Info
+{-- /snippet Info --}
+
+{-- snippet getInfo --}
+maybeIO :: IO a -> IO (Maybe a)
+maybeIO act = handle (\_ -> return Nothing) (Just `liftM` act)
+
+getInfo path = do
+  perms <- maybeIO (getPermissions path)
+  size <- maybeIO (bracket (openFile path ReadMode) hClose hFileSize)
+  modified <- maybeIO (getModificationTime path)
+  return (Info path perms size modified)
+{-- /snippet getInfo --}
+
+{-- snippet traverse.type --}
+traverse :: ([Info] -> [Info]) -> FilePath -> IO [Info]
+{-- /snippet traverse.type --}
+{-- snippet traverse --}
+traverse order path = do
+    names <- getUsefulContents path
+    contents <- mapM getInfo (path : map (path </>) names)
+    liftM concat $ forM (order contents) $ \info -> do
+      if isDirectory info && infoPath info /= path
+        then traverse order (infoPath info)
+        else return [info]
+
+getUsefulContents :: FilePath -> IO [String]
+getUsefulContents path = do
+    names <- getDirectoryContents path
+    return (filter (`notElem` [".", ".."]) names)
+
+isDirectory :: Info -> Bool
+isDirectory = maybe False searchable . infoPerms
+{-- /snippet traverse --}
+
+{-- snippet traverseVerbose --}
+traverseVerbose order path = do
+    names <- getDirectoryContents path
+    let usefulNames = filter (`notElem` [".", ".."]) names
+    contents <- mapM getEntryName ("" : usefulNames)
+    recursiveContents <- mapM recurse (order contents)
+    return (concat recursiveContents)
+  where getEntryName name = getInfo (path </> name)
+        isDirectory info = case infoPerms info of
+                             Nothing -> False
+                             Just perms -> searchable perms
+        recurse info = do
+            if isDirectory info && infoPath info /= path
+                then traverseVerbose order (infoPath info)
+                else return [info]
+{-- /snippet traverseVerbose --}
-- 
cgit v1.2.3