System/Directory.hs

   1 -----------------------------------------------------------------------------
   2 -- |
   3 -- Module      :  System.Directory
   4 -- Copyright   :  (c) The University of Glasgow 2001
   5 -- License     :  BSD-style (see the file libraries/base/LICENSE)
   6 --
   7 -- Maintainer  :  libraries@haskell.org
   8 -- Stability   :  stable
   9 -- Portability :  portable
  10 --
  11 -- System-independent interface to directory manipulation.
  12 --
  13 -----------------------------------------------------------------------------
  14
  15 module System.Directory
  16    (
  17     -- $intro
  18
  19     -- * Actions on directories
  20       createDirectory           -- :: FilePath -> IO ()
  21     , removeDirectory           -- :: FilePath -> IO ()
  22     , renameDirectory           -- :: FilePath -> FilePath -> IO ()
  23
  24     , getDirectoryContents      -- :: FilePath -> IO [FilePath]
  25     , getCurrentDirectory       -- :: IO FilePath
  26     , setCurrentDirectory       -- :: FilePath -> IO ()
  27     , getHomeDirectory
  28     , getAppUserDataDirectory
  29     , getUserDocumentsDirectory
  30
  31     -- * Actions on files
  32     , removeFile                -- :: FilePath -> IO ()
  33     , renameFile                -- :: FilePath -> FilePath -> IO ()
  34 #ifdef __GLASGOW_HASKELL__
  35     , copyFile                  -- :: FilePath -> FilePath -> IO ()
  36 #endif
  37
  38     -- * Existence tests
  39     , doesFileExist             -- :: FilePath -> IO Bool
  40     , doesDirectoryExist        -- :: FilePath -> IO Bool
  41
  42     -- * Permissions
  43
  44     -- $permissions
  45
  46     , Permissions(
  47         Permissions,
  48         readable,               -- :: Permissions -> Bool
  49         writable,               -- :: Permissions -> Bool
  50         executable,             -- :: Permissions -> Bool
  51         searchable              -- :: Permissions -> Bool
  52       )
  53
  54     , getPermissions            -- :: FilePath -> IO Permissions
  55     , setPermissions            -- :: FilePath -> Permissions -> IO ()
  56
  57     -- * Timestamps
  58
  59     , getModificationTime       -- :: FilePath -> IO ClockTime
  60    ) where
  61
  62 #ifdef __NHC__
  63 import Directory
  64 getHomeDirectory :: IO FilePath
  65 getHomeDirectory = getEnv "HOME"
  66 getAppUserDataDirectory :: String -> IO FilePath
  67 getAppUserDataDirectory appName = do path <- getEnv "HOME"
  68                                      return (path++'/':'.':appName)
  69 getUserDocumentsDirectory :: IO FilePath
  70 getUserDocumentsDirectory= getEnv "HOME"
  71 #elif defined(__HUGS__)
  72 import Hugs.Directory
  73 #else
  74
  75 import Prelude
  76
  77 import Control.Exception       ( bracket )
  78 import Control.Monad           ( when )
  79 import System.Posix.Types
  80 import System.Posix.Internals
  81 import System.Time             ( ClockTime(..) )
  82 import System.IO
  83 import System.IO.Error
  84 import Foreign
  85 import Foreign.C
  86
  87 #ifdef __GLASGOW_HASKELL__
  88 import GHC.IOBase       ( IOException(..), IOErrorType(..), ioException )
  89 #endif
  90
  91 #ifndef mingw32_TARGET_OS
  92 import System.Environment
  93 #endif
  94
  95 {- $intro
  96 A directory contains a series of entries, each of which is a named
  97 reference to a file system object (file, directory etc.).  Some
  98 entries may be hidden, inaccessible, or have some administrative
  99 function (e.g. `.' or `..' under POSIX
 100 <http://www.opengroup.org/onlinepubs/007904975/toc.htm>), but in
 101 this standard all such entries are considered to form part of the
 102 directory contents. Entries in sub-directories are not, however,
 103 considered to form part of the directory contents.
 104
 105 Each file system object is referenced by a /path/.  There is
 106 normally at least one absolute path to each file system object.  In
 107 some operating systems, it may also be possible to have paths which
 108 are relative to the current directory.
 109 -}
 110
 111 -----------------------------------------------------------------------------
 112 -- Permissions
 113
 114 {- $permissions
 115
 116  The 'Permissions' type is used to record whether certain operations are
 117  permissible on a file\/directory. 'getPermissions' and 'setPermissions'
 118  get and set these permissions, respectively. Permissions apply both to
 119  files and directories. For directories, the executable field will be
 120  'False', and for files the searchable field will be 'False'. Note that
 121  directories may be searchable without being readable, if permission has
 122  been given to use them as part of a path, but not to examine the
 123  directory contents.
 124
 125 Note that to change some, but not all permissions, a construct on the following lines must be used.
 126
 127 >  makeReadable f = do
 128 >     p <- getPermissions f
 129 >     setPermissions f (p {readable = True})
 130
 131 -}
 132
 133 data Permissions
 134  = Permissions {
 135     readable,   writable,
 136     executable, searchable :: Bool
 137    } deriving (Eq, Ord, Read, Show)
 138
 139 {- |The 'getPermissions' operation returns the
 140 permissions for the file or directory.
 141
 142 The operation may fail with:
 143
 144 * 'isPermissionError' if the user is not permitted to access
 145   the permissions; or
 146
 147 * 'isDoesNotExistError' if the file or directory does not exist.
 148
 149 -}
 150
 151 getPermissions :: FilePath -> IO Permissions
 152 getPermissions name = do
 153   withCString name $ \s -> do
 154   read  <- c_access s r_OK
 155   write <- c_access s w_OK
 156   exec  <- c_access s x_OK
 157   withFileStatus "getPermissions" name $ \st -> do
 158   is_dir <- isDirectory st
 159   return (
 160     Permissions {
 161       readable   = read  == 0,
 162       writable   = write == 0,
 163       executable = not is_dir && exec == 0,
 164       searchable = is_dir && exec == 0
 165     }
 166    )
 167
 168 {- |The 'setPermissions' operation sets the
 169 permissions for the file or directory.
 170
 171 The operation may fail with:
 172
 173 * 'isPermissionError' if the user is not permitted to set
 174   the permissions; or
 175
 176 * 'isDoesNotExistError' if the file or directory does not exist.
 177
 178 -}
 179
 180 setPermissions :: FilePath -> Permissions -> IO ()
 181 setPermissions name (Permissions r w e s) = do
 182   allocaBytes sizeof_stat $ \ p_stat -> do
 183   withCString name $ \p_name -> do
 184     throwErrnoIfMinus1_ "setPermissions" $ do
 185       c_stat p_name p_stat
 186       mode <- st_mode p_stat
 187       let mode1 = modifyBit r mode s_IRUSR
 188       let mode2 = modifyBit w mode1 s_IWUSR
 189       let mode3 = modifyBit (e || s) mode2 s_IXUSR
 190       c_chmod p_name mode3
 191
 192  where
 193    modifyBit :: Bool -> CMode -> CMode -> CMode
 194    modifyBit False m b = m .&. (complement b)
 195    modifyBit True  m b = m .|. b
 196
 197 -----------------------------------------------------------------------------
 198 -- Implementation
 199
 200 {- |@'createDirectory' dir@ creates a new directory @dir@ which is
 201 initially empty, or as near to empty as the operating system
 202 allows.
 203
 204 The operation may fail with:
 205
 206 * 'isPermissionError' \/ 'PermissionDenied'
 207 The process has insufficient privileges to perform the operation.
 208 @[EROFS, EACCES]@
 209
 210 * 'isAlreadyExistsError' \/ 'AlreadyExists'
 211 The operand refers to a directory that already exists.
 212 @ [EEXIST]@
 213
 214 * 'HardwareFault'
 215 A physical I\/O error has occurred.
 216 @[EIO]@
 217
 218 * 'InvalidArgument'
 219 The operand is not a valid directory name.
 220 @[ENAMETOOLONG, ELOOP]@
 221
 222 * 'NoSuchThing'
 223 There is no path to the directory.
 224 @[ENOENT, ENOTDIR]@
 225
 226 * 'ResourceExhausted'
 227 Insufficient resources (virtual memory, process file descriptors,
 228 physical disk space, etc.) are available to perform the operation.
 229 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
 230
 231 * 'InappropriateType'
 232 The path refers to an existing non-directory object.
 233 @[EEXIST]@
 234
 235 -}
 236
 237 createDirectory :: FilePath -> IO ()
 238 createDirectory path = do
 239     withCString path $ \s -> do
 240       throwErrnoIfMinus1Retry_ "createDirectory" $
 241         mkdir s 0o777
 242
 243 {- | @'removeDirectory' dir@ removes an existing directory /dir/.  The
 244 implementation may specify additional constraints which must be
 245 satisfied before a directory can be removed (e.g. the directory has to
 246 be empty, or may not be in use by other processes).  It is not legal
 247 for an implementation to partially remove a directory unless the
 248 entire directory is removed. A conformant implementation need not
 249 support directory removal in all situations (e.g. removal of the root
 250 directory).
 251
 252 The operation may fail with:
 253
 254 * 'HardwareFault'
 255 A physical I\/O error has occurred.
 256 EIO
 257
 258 * 'InvalidArgument'
 259 The operand is not a valid directory name.
 260 [ENAMETOOLONG, ELOOP]
 261
 262 * 'isDoesNotExistError' \/ 'NoSuchThing'
 263 The directory does not exist.
 264 @[ENOENT, ENOTDIR]@
 265
 266 * 'isPermissionError' \/ 'PermissionDenied'
 267 The process has insufficient privileges to perform the operation.
 268 @[EROFS, EACCES, EPERM]@
 269
 270 * 'UnsatisfiedConstraints'
 271 Implementation-dependent constraints are not satisfied.
 272 @[EBUSY, ENOTEMPTY, EEXIST]@
 273
 274 * 'UnsupportedOperation'
 275 The implementation does not support removal in this situation.
 276 @[EINVAL]@
 277
 278 * 'InappropriateType'
 279 The operand refers to an existing non-directory object.
 280 @[ENOTDIR]@
 281
 282 -}
 283
 284 removeDirectory :: FilePath -> IO ()
 285 removeDirectory path = do
 286   modifyIOError (`ioeSetFileName` path) $
 287     withCString path $ \s ->
 288        throwErrnoIfMinus1Retry_ "removeDirectory" (c_rmdir s)
 289
 290 {- |'removeFile' /file/ removes the directory entry for an existing file
 291 /file/, where /file/ is not itself a directory. The
 292 implementation may specify additional constraints which must be
 293 satisfied before a file can be removed (e.g. the file may not be in
 294 use by other processes).
 295
 296 The operation may fail with:
 297
 298 * 'HardwareFault'
 299 A physical I\/O error has occurred.
 300 @[EIO]@
 301
 302 * 'InvalidArgument'
 303 The operand is not a valid file name.
 304 @[ENAMETOOLONG, ELOOP]@
 305
 306 * 'isDoesNotExistError' \/ 'NoSuchThing'
 307 The file does not exist.
 308 @[ENOENT, ENOTDIR]@
 309
 310 * 'isPermissionError' \/ 'PermissionDenied'
 311 The process has insufficient privileges to perform the operation.
 312 @[EROFS, EACCES, EPERM]@
 313
 314 * 'UnsatisfiedConstraints'
 315 Implementation-dependent constraints are not satisfied.
 316 @[EBUSY]@
 317
 318 * 'InappropriateType'
 319 The operand refers to an existing directory.
 320 @[EPERM, EINVAL]@
 321
 322 -}
 323
 324 removeFile :: FilePath -> IO ()
 325 removeFile path = do
 326   modifyIOError (`ioeSetFileName` path) $
 327     withCString path $ \s ->
 328       throwErrnoIfMinus1Retry_ "removeFile" (c_unlink s)
 329
 330 {- |@'renameDirectory' old new@ changes the name of an existing
 331 directory from /old/ to /new/.  If the /new/ directory
 332 already exists, it is atomically replaced by the /old/ directory.
 333 If the /new/ directory is neither the /old/ directory nor an
 334 alias of the /old/ directory, it is removed as if by
 335 'removeDirectory'.  A conformant implementation need not support
 336 renaming directories in all situations (e.g. renaming to an existing
 337 directory, or across different physical devices), but the constraints
 338 must be documented.
 339
 340 On Win32 platforms, @renameDirectory@ fails if the /new/ directory already
 341 exists.
 342
 343 The operation may fail with:
 344
 345 * 'HardwareFault'
 346 A physical I\/O error has occurred.
 347 @[EIO]@
 348
 349 * 'InvalidArgument'
 350 Either operand is not a valid directory name.
 351 @[ENAMETOOLONG, ELOOP]@
 352
 353 * 'isDoesNotExistError' \/ 'NoSuchThing'
 354 The original directory does not exist, or there is no path to the target.
 355 @[ENOENT, ENOTDIR]@
 356
 357 * 'isPermissionError' \/ 'PermissionDenied'
 358 The process has insufficient privileges to perform the operation.
 359 @[EROFS, EACCES, EPERM]@
 360
 361 * 'ResourceExhausted'
 362 Insufficient resources are available to perform the operation.
 363 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
 364
 365 * 'UnsatisfiedConstraints'
 366 Implementation-dependent constraints are not satisfied.
 367 @[EBUSY, ENOTEMPTY, EEXIST]@
 368
 369 * 'UnsupportedOperation'
 370 The implementation does not support renaming in this situation.
 371 @[EINVAL, EXDEV]@
 372
 373 * 'InappropriateType'
 374 Either path refers to an existing non-directory object.
 375 @[ENOTDIR, EISDIR]@
 376
 377 -}
 378
 379 renameDirectory :: FilePath -> FilePath -> IO ()
 380 renameDirectory opath npath =
 381    withFileStatus "renameDirectory" opath $ \st -> do
 382    is_dir <- isDirectory st
 383    if (not is_dir)
 384         then ioException (IOError Nothing InappropriateType "renameDirectory"
 385                             ("not a directory") (Just opath))
 386         else do
 387
 388    withCString opath $ \s1 ->
 389      withCString npath $ \s2 ->
 390         throwErrnoIfMinus1Retry_ "renameDirectory" (c_rename s1 s2)
 391
 392 {- |@'renameFile' old new@ changes the name of an existing file system
 393 object from /old/ to /new/.  If the /new/ object already
 394 exists, it is atomically replaced by the /old/ object.  Neither
 395 path may refer to an existing directory.  A conformant implementation
 396 need not support renaming files in all situations (e.g. renaming
 397 across different physical devices), but the constraints must be
 398 documented.
 399
 400 The operation may fail with:
 401
 402 * 'HardwareFault'
 403 A physical I\/O error has occurred.
 404 @[EIO]@
 405
 406 * 'InvalidArgument'
 407 Either operand is not a valid file name.
 408 @[ENAMETOOLONG, ELOOP]@
 409
 410 * 'isDoesNotExistError' \/ 'NoSuchThing'
 411 The original file does not exist, or there is no path to the target.
 412 @[ENOENT, ENOTDIR]@
 413
 414 * 'isPermissionError' \/ 'PermissionDenied'
 415 The process has insufficient privileges to perform the operation.
 416 @[EROFS, EACCES, EPERM]@
 417
 418 * 'ResourceExhausted'
 419 Insufficient resources are available to perform the operation.
 420 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
 421
 422 * 'UnsatisfiedConstraints'
 423 Implementation-dependent constraints are not satisfied.
 424 @[EBUSY]@
 425
 426 * 'UnsupportedOperation'
 427 The implementation does not support renaming in this situation.
 428 @[EXDEV]@
 429
 430 * 'InappropriateType'
 431 Either path refers to an existing directory.
 432 @[ENOTDIR, EISDIR, EINVAL, EEXIST, ENOTEMPTY]@
 433
 434 -}
 435
 436 renameFile :: FilePath -> FilePath -> IO ()
 437 renameFile opath npath =
 438    withFileOrSymlinkStatus "renameFile" opath $ \st -> do
 439    is_dir <- isDirectory st
 440    if is_dir
 441         then ioException (IOError Nothing InappropriateType "renameFile"
 442                            "is a directory" (Just opath))
 443         else do
 444
 445     withCString opath $ \s1 ->
 446       withCString npath $ \s2 ->
 447          throwErrnoIfMinus1Retry_ "renameFile" (c_rename s1 s2)
 448
 449 {- |@'copyFile' old new@ copies the existing file from /old/ to /new/.
 450 If the /new/ file already exists, it is atomically replaced by the /old/ file.
 451 Neither path may refer to an existing directory.
 452 -}
 453 copyFile :: FilePath -> FilePath -> IO ()
 454 copyFile fromFPath toFPath =
 455         (bracket (openBinaryFile fromFPath ReadMode) hClose $ \hFrom ->
 456          bracket (openBinaryFile toFPath WriteMode) hClose $ \hTo ->
 457          allocaBytes bufferSize $ \buffer ->
 458                 copyContents hFrom hTo buffer) `catch` (ioError . changeFunName)
 459         where
 460                 bufferSize = 1024
 461
 462                 changeFunName (IOError h iot fun str mb_fp) = IOError h iot "copyFile" str mb_fp
 463
 464                 copyContents hFrom hTo buffer = do
 465                         count <- hGetBuf hFrom buffer bufferSize
 466                         when (count > 0) $ do
 467                                 hPutBuf hTo buffer count
 468                                 copyContents hFrom hTo buffer
 469
 470
 471 {- |@'getDirectoryContents' dir@ returns a list of /all/ entries
 472 in /dir/.
 473
 474 The operation may fail with:
 475
 476 * 'HardwareFault'
 477 A physical I\/O error has occurred.
 478 @[EIO]@
 479
 480 * 'InvalidArgument'
 481 The operand is not a valid directory name.
 482 @[ENAMETOOLONG, ELOOP]@
 483
 484 * 'isDoesNotExistError' \/ 'NoSuchThing'
 485 The directory does not exist.
 486 @[ENOENT, ENOTDIR]@
 487
 488 * 'isPermissionError' \/ 'PermissionDenied'
 489 The process has insufficient privileges to perform the operation.
 490 @[EACCES]@
 491
 492 * 'ResourceExhausted'
 493 Insufficient resources are available to perform the operation.
 494 @[EMFILE, ENFILE]@
 495
 496 * 'InappropriateType'
 497 The path refers to an existing non-directory object.
 498 @[ENOTDIR]@
 499
 500 -}
 501
 502 getDirectoryContents :: FilePath -> IO [FilePath]
 503 getDirectoryContents path = do
 504   modifyIOError (`ioeSetFileName` path) $
 505    alloca $ \ ptr_dEnt ->
 506      bracket
 507         (withCString path $ \s ->
 508            throwErrnoIfNullRetry desc (c_opendir s))
 509         (\p -> throwErrnoIfMinus1_ desc (c_closedir p))
 510         (\p -> loop ptr_dEnt p)
 511   where
 512     desc = "getDirectoryContents"
 513
 514     loop :: Ptr (Ptr CDirent) -> Ptr CDir -> IO [String]
 515     loop ptr_dEnt dir = do
 516       resetErrno
 517       r <- readdir dir ptr_dEnt
 518       if (r == 0)
 519          then do
 520                  dEnt    <- peek ptr_dEnt
 521                  if (dEnt == nullPtr)
 522                    then return []
 523                    else do
 524                     entry   <- (d_name dEnt >>= peekCString)
 525                     freeDirEnt dEnt
 526                     entries <- loop ptr_dEnt dir
 527                     return (entry:entries)
 528          else do errno <- getErrno
 529                  if (errno == eINTR) then loop ptr_dEnt dir else do
 530                  let (Errno eo) = errno
 531                  if (eo == end_of_dir)
 532                     then return []
 533                     else throwErrno desc
 534
 535
 536
 537 {- |If the operating system has a notion of current directories,
 538 'getCurrentDirectory' returns an absolute path to the
 539 current directory of the calling process.
 540
 541 The operation may fail with:
 542
 543 * 'HardwareFault'
 544 A physical I\/O error has occurred.
 545 @[EIO]@
 546
 547 * 'isDoesNotExistError' \/ 'NoSuchThing'
 548 There is no path referring to the current directory.
 549 @[EPERM, ENOENT, ESTALE...]@
 550
 551 * 'isPermissionError' \/ 'PermissionDenied'
 552 The process has insufficient privileges to perform the operation.
 553 @[EACCES]@
 554
 555 * 'ResourceExhausted'
 556 Insufficient resources are available to perform the operation.
 557
 558 * 'UnsupportedOperation'
 559 The operating system has no notion of current directory.
 560
 561 -}
 562
 563 getCurrentDirectory :: IO FilePath
 564 getCurrentDirectory = do
 565   p <- mallocBytes long_path_size
 566   go p long_path_size
 567   where go p bytes = do
 568           p' <- c_getcwd p (fromIntegral bytes)
 569           if p' /= nullPtr
 570              then do s <- peekCString p'
 571                      free p'
 572                      return s
 573              else do errno <- getErrno
 574                      if errno == eRANGE
 575                         then do let bytes' = bytes * 2
 576                                 p' <- reallocBytes p bytes'
 577                                 go p' bytes'
 578                         else throwErrno "getCurrentDirectory"
 579
 580 {- |If the operating system has a notion of current directories,
 581 @'setCurrentDirectory' dir@ changes the current
 582 directory of the calling process to /dir/.
 583
 584 The operation may fail with:
 585
 586 * 'HardwareFault'
 587 A physical I\/O error has occurred.
 588 @[EIO]@
 589
 590 * 'InvalidArgument'
 591 The operand is not a valid directory name.
 592 @[ENAMETOOLONG, ELOOP]@
 593
 594 * 'isDoesNotExistError' \/ 'NoSuchThing'
 595 The directory does not exist.
 596 @[ENOENT, ENOTDIR]@
 597
 598 * 'isPermissionError' \/ 'PermissionDenied'
 599 The process has insufficient privileges to perform the operation.
 600 @[EACCES]@
 601
 602 * 'UnsupportedOperation'
 603 The operating system has no notion of current directory, or the
 604 current directory cannot be dynamically changed.
 605
 606 * 'InappropriateType'
 607 The path refers to an existing non-directory object.
 608 @[ENOTDIR]@
 609
 610 -}
 611
 612 setCurrentDirectory :: FilePath -> IO ()
 613 setCurrentDirectory path = do
 614   modifyIOError (`ioeSetFileName` path) $
 615     withCString path $ \s ->
 616        throwErrnoIfMinus1Retry_ "setCurrentDirectory" (c_chdir s)
 617         -- ToDo: add path to error
 618
 619 {- | Returns the current user's home directory.
 620
 621 The directory returned is expected to be writable by the current user,
 622 but note that it isn't generally considered good practice to store
 623 application-specific data here; use 'getAppUserDataDirectory'
 624 instead.
 625
 626 On Unix, 'getHomeDirectory' returns the value of the @HOME@
 627 environment variable.  On Windows, the system is queried for a
 628 suitable path; a typical path might be
 629 @C:/Documents And Settings/user@.
 630
 631 The operation may fail with:
 632
 633 * 'UnsupportedOperation'
 634 The operating system has no notion of home directory.
 635
 636 * 'isDoesNotExistError'
 637 The home directory for the current user does not exist, or
 638 cannot be found.
 639 -}
 640 getHomeDirectory :: IO FilePath
 641 getHomeDirectory =
 642 #ifdef mingw32_TARGET_OS
 643   allocaBytes long_path_size $ \pPath -> do
 644      r <- c_SHGetFolderPath nullPtr csidl_PROFILE nullPtr 0 pPath
 645      if (r < 0)
 646        then c_SHGetFolderPath nullPtr csidl_WINDOWS nullPtr 0 pPath
 647        else return 0
 648      peekCString pPath
 649 #else
 650   getEnv "HOME"
 651 #endif
 652
 653 {- | Returns the pathname of a directory in which application-specific
 654 data for the current user can be stored.  The result of
 655 'getAppUserDataDirectory' for a given application is specific to
 656 the current user.
 657
 658 The argument should be the name of the application, which will be used
 659 to construct the pathname (so avoid using unusual characters that
 660 might result in an invalid pathname).
 661
 662 Note: the directory may not actually exist, and may need to be created
 663 first.  It is expected that the parent directory exists and is
 664 writable.
 665
 666 On Unix, this function returns @$HOME\/.appName@.  On Windows, a
 667 typical path might be
 668
 669 > C:/Documents And Settings/user/Application Data/appName
 670
 671 The operation may fail with:
 672
 673 * 'UnsupportedOperation'
 674 The operating system has no notion of application-specific data directory.
 675
 676 * 'isDoesNotExistError'
 677 The home directory for the current user does not exist, or
 678 cannot be found.
 679 -}
 680 getAppUserDataDirectory :: String -> IO FilePath
 681 getAppUserDataDirectory appName = do
 682 #ifdef mingw32_TARGET_OS
 683   allocaBytes long_path_size $ \pPath -> do
 684      r <- c_SHGetFolderPath nullPtr csidl_APPDATA nullPtr 0 pPath
 685      s <- peekCString pPath
 686      return (s++'\\':appName)
 687 #else
 688   path <- getEnv "HOME"
 689   return (path++'/':'.':appName)
 690 #endif
 691
 692 {- | Returns the current user's document directory.
 693
 694 The directory returned is expected to be writable by the current user,
 695 but note that it isn't generally considered good practice to store
 696 application-specific data here; use 'getAppUserDataDirectory'
 697 instead.
 698
 699 On Unix, 'getUserDocumentsDirectory' returns the value of the @HOME@
 700 environment variable.  On Windows, the system is queried for a
 701 suitable path; a typical path might be
 702 @C:/Documents and Settings/user/My Documents@.
 703
 704 The operation may fail with:
 705
 706 * 'UnsupportedOperation'
 707 The operating system has no notion of document directory.
 708
 709 * 'isDoesNotExistError'
 710 The document directory for the current user does not exist, or
 711 cannot be found.
 712 -}
 713 getUserDocumentsDirectory :: IO FilePath
 714 getUserDocumentsDirectory = do
 715 #ifdef mingw32_TARGET_OS
 716   allocaBytes long_path_size $ \pPath -> do
 717      r <- c_SHGetFolderPath nullPtr csidl_PERSONAL nullPtr 0 pPath
 718      peekCString pPath
 719 #else
 720   getEnv "HOME"
 721 #endif
 722
 723 #ifdef mingw32_TARGET_OS
 724 foreign import stdcall unsafe "SHGetFolderPath"
 725             c_SHGetFolderPath :: Ptr ()
 726                               -> CInt
 727                               -> Ptr ()
 728                               -> CInt
 729                               -> CString
 730                               -> IO CInt
 731 foreign import ccall unsafe "__hscore_CSIDL_PROFILE"  csidl_PROFILE  :: CInt
 732 foreign import ccall unsafe "__hscore_CSIDL_APPDATA"  csidl_APPDATA  :: CInt
 733 foreign import ccall unsafe "__hscore_CSIDL_WINDOWS"  csidl_WINDOWS  :: CInt
 734 foreign import ccall unsafe "__hscore_CSIDL_PERSONAL" csidl_PERSONAL :: CInt
 735 #endif
 736
 737 {- |The operation 'doesDirectoryExist' returns 'True' if the argument file
 738 exists and is a directory, and 'False' otherwise.
 739 -}
 740
 741 doesDirectoryExist :: FilePath -> IO Bool
 742 doesDirectoryExist name =
 743  catch
 744    (withFileStatus "doesDirectoryExist" name $ \st -> isDirectory st)
 745    (\ _ -> return False)
 746
 747 {- |The operation 'doesFileExist' returns 'True'
 748 if the argument file exists and is not a directory, and 'False' otherwise.
 749 -}
 750
 751 doesFileExist :: FilePath -> IO Bool
 752 doesFileExist name = do
 753  catch
 754    (withFileStatus "doesFileExist" name $ \st -> do b <- isDirectory st; return (not b))
 755    (\ _ -> return False)
 756
 757 {- |The 'getModificationTime' operation returns the
 758 clock time at which the file or directory was last modified.
 759
 760 The operation may fail with:
 761
 762 * 'isPermissionError' if the user is not permitted to access
 763   the modification time; or
 764
 765 * 'isDoesNotExistError' if the file or directory does not exist.
 766
 767 -}
 768
 769 getModificationTime :: FilePath -> IO ClockTime
 770 getModificationTime name =
 771  withFileStatus "getModificationTime" name $ \ st ->
 772  modificationTime st
 773
 774 withFileStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
 775 withFileStatus loc name f = do
 776   modifyIOError (`ioeSetFileName` name) $
 777     allocaBytes sizeof_stat $ \p ->
 778       withCString (fileNameEndClean name) $ \s -> do
 779         throwErrnoIfMinus1Retry_ loc (c_stat s p)
 780         f p
 781
 782 withFileOrSymlinkStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
 783 withFileOrSymlinkStatus loc name f = do
 784   modifyIOError (`ioeSetFileName` name) $
 785     allocaBytes sizeof_stat $ \p ->
 786       withCString name $ \s -> do
 787         throwErrnoIfMinus1Retry_ loc (lstat s p)
 788         f p
 789
 790 modificationTime :: Ptr CStat -> IO ClockTime
 791 modificationTime stat = do
 792     mtime <- st_mtime stat
 793     let realToInteger = round . realToFrac :: Real a => a -> Integer
 794     return (TOD (realToInteger (mtime :: CTime)) 0)
 795
 796 isDirectory :: Ptr CStat -> IO Bool
 797 isDirectory stat = do
 798   mode <- st_mode stat
 799   return (s_isdir mode)
 800
 801 fileNameEndClean :: String -> String
 802 fileNameEndClean name =
 803   if i > 0 && (ec == '\\' || ec == '/') then
 804      fileNameEndClean (take i name)
 805    else
 806      name
 807   where
 808       i  = (length name) - 1
 809       ec = name !! i
 810
 811 foreign import ccall unsafe "__hscore_long_path_size"
 812   long_path_size :: Int
 813
 814 foreign import ccall unsafe "__hscore_R_OK" r_OK :: CMode
 815 foreign import ccall unsafe "__hscore_W_OK" w_OK :: CMode
 816 foreign import ccall unsafe "__hscore_X_OK" x_OK :: CMode
 817
 818 foreign import ccall unsafe "__hscore_S_IRUSR" s_IRUSR :: CMode
 819 foreign import ccall unsafe "__hscore_S_IWUSR" s_IWUSR :: CMode
 820 foreign import ccall unsafe "__hscore_S_IXUSR" s_IXUSR :: CMode
 821
 822 #endif