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