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