templates/Paths_pkg.template.hs

   1 {% if supportsCpp %}
   2 {-# LANGUAGE CPP #-}
   3 {% endif %}
   4 {% if supportsNoRebindableSyntax %}
   5 {-# LANGUAGE NoRebindableSyntax #-}
   6 {% endif %}
   7 {% if not absolute %}
   8 {-# LANGUAGE ForeignFunctionInterface #-}
   9 {% endif %}
  10 {-# OPTIONS_GHC -fno-warn-missing-import-lists #-}
  11 {-# OPTIONS_GHC -w #-}
  12 module Paths_{{ manglePkgName packageName }} (
  13     version,
  14     getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir,
  15     getDataFileName, getSysconfDir
  16   ) where
  17
  18 {% if not absolute %}
  19 import Foreign
  20 import Foreign.C
  21 {% endif %}
  22
  23 import qualified Control.Exception as Exception
  24 import qualified Data.List as List
  25 import Data.Version (Version(..))
  26 import System.Environment (getEnv)
  27 import Prelude
  28
  29 {% if relocatable %}
  30 import System.Environment (getExecutablePath)
  31 {% endif %}
  32
  33 {% if supportsCpp %}
  34 #if defined(VERSION_base)
  35
  36 #if MIN_VERSION_base(4,0,0)
  37 catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a
  38 #else
  39 catchIO :: IO a -> (Exception.Exception -> IO a) -> IO a
  40 #endif
  41
  42 #else
  43 catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a
  44 #endif
  45 catchIO = Exception.catch
  46 {% else %}
  47 catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a
  48 catchIO = Exception.catch
  49 {% endif %}
  50
  51 version :: Version
  52 version = Version {{ versionDigits }} []
  53
  54 getDataFileName :: FilePath -> IO FilePath
  55 getDataFileName name = do
  56   dir <- getDataDir
  57   return (dir `joinFileName` name)
  58
  59 getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, getSysconfDir :: IO FilePath
  60
  61 {# body #}
  62 {# ######################################################################### #}
  63
  64 {% if relocatable %}
  65
  66 getPrefixDirReloc :: FilePath -> IO FilePath
  67 getPrefixDirReloc dirRel = do
  68   exePath <- getExecutablePath
  69   let (dir,_) = splitFileName exePath
  70   return ((dir `minusFileName` {{ bindir }}) `joinFileName` dirRel)
  71
  72 getBinDir     = catchIO (getEnv "{{ manglePkgName packageName }}_bindir")     (\_ -> getPrefixDirReloc $ {{ bindir }})
  73 getLibDir     = catchIO (getEnv "{{ manglePkgName packageName }}_libdir")     (\_ -> getPrefixDirReloc $ {{ libdir }})
  74 getDynLibDir  = catchIO (getEnv "{{ manglePkgName packageName }}_dynlibdir")  (\_ -> getPrefixDirReloc $ {{ dynlibdir }})
  75 getDataDir    = catchIO (getEnv "{{ manglePkgName packageName }}_datadir")    (\_ -> getPrefixDirReloc $ {{ datadir }})
  76 getLibexecDir = catchIO (getEnv "{{ manglePkgName packageName }}_libexecdir") (\_ -> getPrefixDirReloc $ {{ libexecdir }})
  77 getSysconfDir = catchIO (getEnv "{{ manglePkgName packageName }}_sysconfdir") (\_ -> getPrefixDirReloc $ {{ sysconfdir }})
  78
  79 {% elif absolute %}
  80
  81 bindir, libdir, dynlibdir, datadir, libexecdir, sysconfdir :: FilePath
  82 bindir     = {{ bindir }}
  83 libdir     = {{ libdir }}
  84 dynlibdir  = {{ dynlibdir }}
  85 datadir    = {{ datadir }}
  86 libexecdir = {{ libexecdir }}
  87 sysconfdir = {{ sysconfdir }}
  88
  89 getBinDir     = catchIO (getEnv "{{ manglePkgName packageName }}_bindir")     (\_ -> return bindir)
  90 getLibDir     = catchIO (getEnv "{{ manglePkgName packageName }}_libdir")     (\_ -> return libdir)
  91 getDynLibDir  = catchIO (getEnv "{{ manglePkgName packageName }}_dynlibdir")  (\_ -> return dynlibdir)
  92 getDataDir    = catchIO (getEnv "{{ manglePkgName packageName }}_datadir")    (\_ -> return datadir)
  93 getLibexecDir = catchIO (getEnv "{{ manglePkgName packageName }}_libexecdir") (\_ -> return libexecdir)
  94 getSysconfDir = catchIO (getEnv "{{ manglePkgName packageName }}_sysconfdir") (\_ -> return sysconfdir)
  95
  96 {% elif isWindows %}
  97
  98 prefix :: FilePath
  99 prefix = {{ prefix }}
 100
 101 getBinDir     = getPrefixDirRel $ {{ bindir }}
 102 getLibDir     = {{ libdir }}
 103 getDynLibDir  = {{ dynlibdir }}
 104 getDataDir    = catchIO (getEnv "{{ manglePkgName packageName }}_datadir")    (\_ -> {{ datadir }})
 105 getLibexecDir = {{ libexecdir }}
 106 getSysconfDir = {{ sysconfdir }}
 107
 108 getPrefixDirRel :: FilePath -> IO FilePath
 109 getPrefixDirRel dirRel = try_size 2048 -- plenty, PATH_MAX is 512 under Win32.
 110   where
 111     try_size size = allocaArray (fromIntegral size) $ \buf -> do
 112         ret <- c_GetModuleFileName nullPtr buf size
 113         case ret of
 114           0 -> return (prefix `joinFileName` dirRel)
 115           _ | ret < size -> do
 116               exePath <- peekCWString buf
 117               let (bindir,_) = splitFileName exePath
 118               return ((bindir `minusFileName` {{ bindir}}) `joinFileName` dirRel)
 119             | otherwise  -> try_size (size * 2)
 120
 121 {% if isI386 %}
 122 foreign import stdcall unsafe "windows.h GetModuleFileNameW"
 123   c_GetModuleFileName :: Ptr () -> CWString -> Int32 -> IO Int32
 124 {% elif isX8664 %}
 125 foreign import ccall unsafe "windows.h GetModuleFileNameW"
 126   c_GetModuleFileName :: Ptr () -> CWString -> Int32 -> IO Int32
 127 {% else %}
 128 -- win32 supported only with I386, X86_64
 129 c_GetModuleFileName :: Ptr () -> CWString -> Int32 -> IO Int32
 130 c_GetModuleFileName  = _
 131 {% endif %}
 132
 133 {% else %}
 134
 135 notRelocAbsoluteOrWindows :: ()
 136 notRelocAbsoluteOrWindows = _
 137
 138 {% endif %}
 139
 140 {# filename stuff                                                            #}
 141 {# ######################################################################### #}
 142
 143 {% if not absolute %}
 144 minusFileName :: FilePath -> String -> FilePath
 145 minusFileName dir ""     = dir
 146 minusFileName dir "."    = dir
 147 minusFileName dir suffix =
 148   minusFileName (fst (splitFileName dir)) (fst (splitFileName suffix))
 149
 150 splitFileName :: FilePath -> (String, String)
 151 splitFileName p = (reverse (path2++drive), reverse fname)
 152   where
 153     (path,drive) = case p of
 154        (c:':':p') -> (reverse p',[':',c])
 155        _          -> (reverse p ,"")
 156     (fname,path1) = break isPathSeparator path
 157     path2 = case path1 of
 158       []                           -> "."
 159       [_]                          -> path1   -- don't remove the trailing slash if
 160                                               -- there is only one character
 161       (c:path') | isPathSeparator c -> path'
 162       _                             -> path1
 163 {% endif %}
 164
 165 joinFileName :: String -> String -> FilePath
 166 joinFileName ""  fname = fname
 167 joinFileName "." fname = fname
 168 joinFileName dir ""    = dir
 169 joinFileName dir fname
 170   | isPathSeparator (List.last dir) = dir ++ fname
 171   | otherwise                       = dir ++ pathSeparator : fname
 172
 173 pathSeparator :: Char
 174 {% if isWindows %}
 175 pathSeparator = '\\'
 176 {% else %}
 177 pathSeparator = '/'
 178 {% endif %}
 179
 180 isPathSeparator :: Char -> Bool
 181 {% if isWindows %}
 182 isPathSeparator c = c == '/' || c == '\\'
 183 {% else %}
 184 isPathSeparator c = c == '/'
 185 {% endif %}