ghc/compiler/utils/DirUtils.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1998
   3 %
   4 \section[DirUtils]{Directory functions}
   5
   6 \begin{code}
   7 {-# OPTIONS -#include <dirent.h> #-}
   8 module DirUtils
   9        (
  10         getDirectoryContents
  11        ) where
  12
  13 #if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ >= 302
  14 import Directory
  15 #else
  16
  17 #if __GLASGOW_HASKELL__ >= 300
  18 import PrelPack   ( unpackNBytesST )
  19 #else
  20 import PackBase   ( unpackNBytesST )
  21 #endif
  22 import PrimPacked ( strLength )
  23 import GlaExts    ( stToIO )
  24 import Addr       ( Addr )
  25
  26 \end{code}
  27
  28 The implementation of Directory.getDirectoryContents that ships
  29 with ghc-X ( X<=301) is wrong (the C stub fails to allocate
  30 space for the terminating NUL for each directory entry name.)
  31
  32 To counter for this, we supply a working version here, which will
  33 be nuked once we can assume that ghc-3.02 or later is used to
  34 compile the compiler sources.
  35
  36 \begin{code}
  37 getDirectoryContents :: String -> IO [String]
  38 getDirectoryContents path = do
  39     dir <- _ccall_ opendir path
  40     if dir == ``NULL''
  41         then fail (userError ("DirUtils.getDirectoryContents: couldn't open "++ path))
  42         else loop dir
  43   where
  44     loop :: Addr -> IO [String]
  45     loop dir  = do
  46       dirent_ptr <- _ccall_ readdir dir
  47       if (dirent_ptr::Addr) == ``NULL''
  48        then do
  49           _ccall_ closedir dir
  50           return []
  51        else do
  52           str     <- _casm_ `` %r=(char*)((struct dirent*)%0)->d_name; '' dirent_ptr
  53           entry   <- stToIO (unpackNBytesST str (strLength str))
  54           entries <- loop dir
  55           return (entry:entries)
  56 #endif
  57 \end{code}