Tuesday, May 19, 2009

Solutions to Chapter 8 (p. 210), questions 1-2

First, if you're having trouble loading Glob.hs, that's probably because you're using a too-new version of GHC. Try replacing the line

import Control.Exception (handle)


import Control.OldException (handle)

to use a backwards-compatible version of handle, which solves this problem.

#1. The trick to detecting the current OS is examining the path-separator character. It's '/' on Unix and Unix-like systems, and '\\' (a backslash) on Windows.

I'll be using the GlobRegex module which was updated in the previous post, which includes the matchesGlobIgnoreCase function. Here's the updated Glog.hs; changed or new lines are in bold.

import System.Directory (doesDirectoryExist, doesFileExist,
    getCurrentDirectory, getDirectoryContents)
import System.FilePath (dropTrailingPathSeparator, splitFileName, ())

import Control.OldException (handle)
import Control.Monad (forM)
import GlobRegex (matchesGlob, matchesGlobIgnoreCase)

import System.FilePath (pathSeparator)

isPattern :: String -> Bool
isPattern = any (`elem` "[*?")

namesMatching :: String -> IO [FilePath]
namesMatching pat
  | not (isPattern pat) = do
      exists <- doesNameExist pat
      return (if exists then [pat] else [])
  | otherwise = do
      case splitFileName pat of
        ("", baseName) -> do
          curDir <- getCurrentDirectory
          listMatches curDir baseName
        (dirName, baseName) -> do
          dirs <- if isPattern dirName
                  then namesMatching (dropTrailingPathSeparator dirName)
                  else return [dirName]
          let listDir = if isPattern baseName
                        then listMatches
                        else listPlain
          pathNames <- forM dirs $ \dir -> do
                         baseNames <- listDir dir baseName
                         return (map (dir ) baseNames)
          return (concat pathNames)

doesNameExist :: FilePath -> IO Bool
doesNameExist name = do
  fileExists <- doesFileExist name
  if fileExists then return True else doesDirectoryExist name

listMatches :: FilePath -> String -> IO [FilePath]
listMatches dirName pat = do
  dirName' <- if null dirName
              then getCurrentDirectory
              else return dirName
  let matcher = if isOsCaseInsensitive
                then matchesGlobIgnoreCase
                else matchesGlob
  handle (const (return [])) $ do
    names <- getDirectoryContents dirName'
    let names' = if isHidden pat
                 then filter isHidden names
                 else filter (not . isHidden) names
    return (filter (`matcher` pat) names')

isHidden ('.':_) = True
isHidden _ = False

listPlain :: FilePath -> String -> IO [FilePath]
listPlain dirName baseName = do
  exists <- if null baseName
            then doesDirectoryExist dirName
            else doesNameExist (dirName  baseName)
  return (if exists then [baseName] else [])

-- Only the case-insensitive Windows uses backlash as a path separator
isOsCaseInsensitive :: Bool
isOsCaseInsensitive = pathSeparator == '\\'

#2. The System.Posix.Files module includes the function getFileStatus, with the signature FilePath -> IO FileStatus. There's also the function isDirectory :: FileStatus -> Bool, so getFileStatus obviously works for directories, too.

Of course, using an OS-specific function where OS-agnostic code can do is a poor idea.

No comments:

Post a Comment