diff options
| author | Jan Sucan <jan@jansucan.com> | 2023-09-20 15:08:54 +0200 |
|---|---|---|
| committer | Jan Sucan <jan@jansucan.com> | 2023-09-20 15:08:54 +0200 |
| commit | 2e609996237d503ab65c7908e9c5c61fc62553dc (patch) | |
| tree | 75618a7692ffcb0a156ac4b7c3852f0f89d4dab0 /ch09 | |
| parent | e66d66508aec54f8044c9a6eba517eb49f74516e (diff) | |
ch09: Copy a needed file from the examples
Diffstat (limited to 'ch09')
| -rw-r--r-- | ch09/ControlledVisit.hs | 77 |
1 files changed, 77 insertions, 0 deletions
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 --}
|