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 {% defblock function_defs %}
  62 minusFileName :: FilePath -> String -> FilePath
  63 minusFileName dir ""     = dir
  64 minusFileName dir "."    = dir
  65 minusFileName dir suffix =
  66   minusFileName (fst (splitFileName dir)) (fst (splitFileName suffix))
  67
  68 splitFileName :: FilePath -> (String, String)
  69 splitFileName p = (reverse (path2++drive), reverse fname)
  70   where
  71     (path,drive) = case p of
  72       (c:':':p') -> (reverse p',[':',c])
  73       _          -> (reverse p ,"")
  74     (fname,path1) = break isPathSeparator path
  75     path2 = case path1 of
  76       []                           -> "."
  77       [_]                          -> path1   -- don't remove the trailing slash if
  78                                               -- there is only one character
  79       (c:path') | isPathSeparator c -> path'
  80       _                             -> path1
  81 {% endblock %}
  82
  83 {# body #}
  84 {# ######################################################################### #}
  85
  86 {% if relocatable %}
  87
  88 getPrefixDirReloc :: FilePath -> IO FilePath
  89 getPrefixDirReloc dirRel = do
  90   exePath <- getExecutablePath
  91   let (dir,_) = splitFileName exePath
  92   return ((dir `minusFileName` {{ bindir }}) `joinFileName` dirRel)
  93
  94 getBinDir     = catchIO (getEnv "{{ manglePkgName packageName }}_bindir")     (\_ -> getPrefixDirReloc $ {{ bindir }})
  95 getLibDir     = catchIO (getEnv "{{ manglePkgName packageName }}_libdir")     (\_ -> getPrefixDirReloc $ {{ libdir }})
  96 getDynLibDir  = catchIO (getEnv "{{ manglePkgName packageName }}_dynlibdir")  (\_ -> getPrefixDirReloc $ {{ dynlibdir }})
  97 getDataDir    = catchIO (getEnv "{{ manglePkgName packageName }}_datadir")    (\_ -> getPrefixDirReloc $ {{ datadir }})
  98 getLibexecDir = catchIO (getEnv "{{ manglePkgName packageName }}_libexecdir") (\_ -> getPrefixDirReloc $ {{ libexecdir }})
  99 getSysconfDir = catchIO (getEnv "{{ manglePkgName packageName }}_sysconfdir") (\_ -> getPrefixDirReloc $ {{ sysconfdir }})
 100
 101 {% useblock function_defs %}
 102
 103 {% elif absolute %}
 104
 105 bindir, libdir, dynlibdir, datadir, libexecdir, sysconfdir :: FilePath
 106 bindir     = {{ bindir }}
 107 libdir     = {{ libdir }}
 108 dynlibdir  = {{ dynlibdir }}
 109 datadir    = {{ datadir }}
 110 libexecdir = {{ libexecdir }}
 111 sysconfdir = {{ sysconfdir }}
 112
 113 getBinDir     = catchIO (getEnv "{{ manglePkgName packageName }}_bindir")     (\_ -> return bindir)
 114 getLibDir     = catchIO (getEnv "{{ manglePkgName packageName }}_libdir")     (\_ -> return libdir)
 115 getDynLibDir  = catchIO (getEnv "{{ manglePkgName packageName }}_dynlibdir")  (\_ -> return dynlibdir)
 116 getDataDir    = catchIO (getEnv "{{ manglePkgName packageName }}_datadir")    (\_ -> return datadir)
 117 getLibexecDir = catchIO (getEnv "{{ manglePkgName packageName }}_libexecdir") (\_ -> return libexecdir)
 118 getSysconfDir = catchIO (getEnv "{{ manglePkgName packageName }}_sysconfdir") (\_ -> return sysconfdir)
 119
 120 {% elif isWindows %}
 121
 122 prefix :: FilePath
 123 prefix = {{ prefix }}
 124
 125 getBinDir     = getPrefixDirRel $ {{ bindir }}
 126 getLibDir     = {{ libdir }}
 127 getDynLibDir  = {{ dynlibdir }}
 128 getDataDir    = catchIO (getEnv "{{ manglePkgName packageName }}_datadir")    (\_ -> {{ datadir }})
 129 getLibexecDir = {{ libexecdir }}
 130 getSysconfDir = {{ sysconfdir }}
 131
 132 getPrefixDirRel :: FilePath -> IO FilePath
 133 getPrefixDirRel dirRel = try_size 2048 -- plenty, PATH_MAX is 512 under Win32.
 134   where
 135     try_size size = allocaArray (fromIntegral size) $ \buf -> do
 136         ret <- c_GetModuleFileName nullPtr buf size
 137         case ret of
 138           0 -> return (prefix `joinFileName` dirRel)
 139           _ | ret < size -> do
 140               exePath <- peekCWString buf
 141               let (bindir,_) = splitFileName exePath
 142               return ((bindir `minusFileName` {{ bindir}}) `joinFileName` dirRel)
 143             | otherwise  -> try_size (size * 2)
 144
 145 {% useblock function_defs %}
 146
 147 {% if isI386 %}
 148 foreign import stdcall unsafe "windows.h GetModuleFileNameW"
 149   c_GetModuleFileName :: Ptr () -> CWString -> Int32 -> IO Int32
 150 {% elif isX8664 %}
 151 foreign import ccall unsafe "windows.h GetModuleFileNameW"
 152   c_GetModuleFileName :: Ptr () -> CWString -> Int32 -> IO Int32
 153 {% else %}
 154 -- win32 supported only with I386, X86_64
 155 c_GetModuleFileName :: Ptr () -> CWString -> Int32 -> IO Int32
 156 c_GetModuleFileName  = _
 157 {% endif %}
 158
 159 {% else %}
 160
 161 notRelocAbsoluteOrWindows :: ()
 162 notRelocAbsoluteOrWindows = _
 163
 164 {% endif %}
 165
 166 {# filename stuff                                                            #}
 167 {# ######################################################################### #}
 168
 169 joinFileName :: String -> String -> FilePath
 170 joinFileName ""  fname = fname
 171 joinFileName "." fname = fname
 172 joinFileName dir ""    = dir
 173 joinFileName dir fname
 174   | isPathSeparator (List.last dir) = dir ++ fname
 175   | otherwise                       = dir ++ pathSeparator : fname
 176
 177 pathSeparator :: Char
 178 {% if isWindows %}
 179 pathSeparator = '\\'
 180 {% else %}
 181 pathSeparator = '/'
 182 {% endif %}
 183
 184 isPathSeparator :: Char -> Bool
 185 {% if isWindows %}
 186 isPathSeparator c = c == '/' || c == '\\'
 187 {% else %}
 188 isPathSeparator c = c == '/'
 189 {% endif %}