ghc/lib/compat/Compat/Directory.hs

   1 {-# OPTIONS -cpp #-}
   2 -----------------------------------------------------------------------------
   3 -- |
   4 -- Module      :  Compat.Directory
   5 -- Copyright   :  (c) The University of Glasgow 2001-2004
   6 -- License     :  BSD-style (see the file libraries/base/LICENSE)
   7 --
   8 -- Maintainer  :  libraries@haskell.org
   9 -- Stability   :  provisional
  10 -- Portability :  portable
  11 --
  12 -- Functions from System.Directory that aren't present in older versions
  13 -- of that library.
  14 --
  15 -----------------------------------------------------------------------------
  16
  17 module Compat.Directory (
  18         getAppUserDataDirectory,
  19   ) where
  20
  21 #if __GLASGOW_HASKELL__ < 603
  22 #include "config.h"
  23 #endif
  24
  25 #if !defined(mingw32_TARGET_OS)
  26 import System.Environment (getEnv)
  27 #else
  28 import Foreign
  29 import Foreign.C
  30 #endif
  31
  32 getAppUserDataDirectory :: String -> IO FilePath
  33 getAppUserDataDirectory appName = do
  34 #if __GLASGOW_HASKELL__ && defined(mingw32_TARGET_OS)
  35   allocaBytes long_path_size $ \pPath -> do
  36      r <- c_SHGetFolderPath nullPtr csidl_APPDATA nullPtr 0 pPath
  37      s <- peekCString pPath
  38      return (s++'\\':appName)
  39 #else
  40   path <- getEnv "HOME"
  41   return (path++'/':'.':appName)
  42 #endif
  43
  44 #if __GLASGOW_HASKELL__ && defined(mingw32_TARGET_OS)
  45 foreign import stdcall unsafe "SHGetFolderPathA"
  46             c_SHGetFolderPath :: Ptr ()
  47                               -> CInt
  48                               -> Ptr ()
  49                               -> CInt
  50                               -> CString
  51                               -> IO CInt
  52
  53 foreign import ccall unsafe "__hscore_long_path_size"
  54   long_path_size :: Int
  55
  56 foreign import ccall unsafe "__hscore_CSIDL_APPDATA"  csidl_APPDATA  :: CInt
  57 #endif