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