mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-22 19:22:50 -06:00
For Windows get the default GF_LIB_PATH from the executable path
This commit is contained in:
@@ -119,15 +119,13 @@ helpMsg = unlines [
|
|||||||
]
|
]
|
||||||
|
|
||||||
welcomeMsgLib = do
|
welcomeMsgLib = do
|
||||||
lib <- catch
|
lib <- getLibraryPath
|
||||||
(getEnv "GF_LIB_PATH" >>= return . ("GF_LIB_PATH is set to" +++))
|
|
||||||
(const (return $ "GF_LIB_PATH is set to the default, " ++ libdir))
|
|
||||||
return $ welcomeMsg lib
|
return $ welcomeMsg lib
|
||||||
|
|
||||||
welcomeMsg lib =
|
welcomeMsg lib =
|
||||||
"Welcome to " ++ authorMsg ++++
|
"Welcome to " ++ authorMsg ++++
|
||||||
"If \228 and \246 (umlaut letters) look strange, see 'h -coding'." ++
|
"If \228 and \246 (umlaut letters) look strange, see 'h -coding'." ++
|
||||||
"\n" ++ lib ++
|
"\nGF_LIB_PATH is set to " ++ lib ++
|
||||||
"\n\nType 'h' for help, and 'h [Command] for more detailed help.\n"
|
"\n\nType 'h' for help, and 'h [Command] for more detailed help.\n"
|
||||||
|
|
||||||
authorMsg = unlines [
|
authorMsg = unlines [
|
||||||
|
|||||||
@@ -1,3 +1,4 @@
|
|||||||
|
{-# OPTIONS -cpp #-}
|
||||||
----------------------------------------------------------------------
|
----------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : UseIO
|
-- Module : UseIO
|
||||||
@@ -26,6 +27,12 @@ import System.Environment
|
|||||||
import System.CPUTime
|
import System.CPUTime
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
|
|
||||||
|
#ifdef mingw32_HOST_OS
|
||||||
|
import System.Win32.DLL
|
||||||
|
import System.FilePath.Windows
|
||||||
|
import Foreign.Ptr
|
||||||
|
#endif
|
||||||
|
|
||||||
putShow' :: Show a => (c -> a) -> c -> IO ()
|
putShow' :: Show a => (c -> a) -> c -> IO ()
|
||||||
putShow' f = putStrLn . show . length . show . f
|
putShow' f = putStrLn . show . length . show . f
|
||||||
|
|
||||||
@@ -123,11 +130,23 @@ doesFileExistPath paths file = do
|
|||||||
mpfile <- ioeIO $ getFilePathMsg "" paths file
|
mpfile <- ioeIO $ getFilePathMsg "" paths file
|
||||||
return $ maybe False (const True) mpfile
|
return $ maybe False (const True) mpfile
|
||||||
|
|
||||||
|
getLibraryPath :: IO FilePath
|
||||||
|
getLibraryPath =
|
||||||
|
catch
|
||||||
|
(getEnv "GF_LIB_PATH")
|
||||||
|
#ifdef mingw32_HOST_OS
|
||||||
|
(\_ -> do exepath <- getModuleFileName nullPtr
|
||||||
|
let (path,_) = splitFileName exepath
|
||||||
|
canonicalizePath (combine path "../lib"))
|
||||||
|
#else
|
||||||
|
(const (return libdir))
|
||||||
|
#endif
|
||||||
|
|
||||||
-- | first var is lib prefix, second is like class path
|
-- | first var is lib prefix, second is like class path
|
||||||
-- | path in environment variable has lower priority
|
-- | path in environment variable has lower priority
|
||||||
extendPathEnv :: String -> String -> [FilePath] -> IO [FilePath]
|
extendPathEnv :: String -> String -> [FilePath] -> IO [FilePath]
|
||||||
extendPathEnv lib var ps = do
|
extendPathEnv lib var ps = do
|
||||||
b <- catch (getEnv lib) (const (return libdir)) -- e.g. GF_LIB_PATH
|
b <- getLibraryPath -- e.g. GF_LIB_PATH
|
||||||
s <- catch (getEnv var) (const (return "")) -- e.g. GF_GRAMMAR_PATH
|
s <- catch (getEnv var) (const (return "")) -- e.g. GF_GRAMMAR_PATH
|
||||||
let fs = pFilePaths s
|
let fs = pFilePaths s
|
||||||
let ss = ps ++ fs
|
let ss = ps ++ fs
|
||||||
|
|||||||
@@ -1,3 +1,4 @@
|
|||||||
|
{-# OPTIONS -cpp #-}
|
||||||
----------------------------------------------------------------------
|
----------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : UseIO
|
-- Module : UseIO
|
||||||
@@ -25,6 +26,14 @@ import System.IO.Error
|
|||||||
import System.Environment
|
import System.Environment
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
|
|
||||||
|
#ifdef mingw32_HOST_OS
|
||||||
|
import System.Win32.DLL
|
||||||
|
import System.FilePath.Windows
|
||||||
|
import System.Directory
|
||||||
|
import Foreign.Ptr
|
||||||
|
#endif
|
||||||
|
|
||||||
|
|
||||||
putShow' :: Show a => (c -> a) -> c -> IO ()
|
putShow' :: Show a => (c -> a) -> c -> IO ()
|
||||||
putShow' f = putStrLn . show . length . show . f
|
putShow' f = putStrLn . show . length . show . f
|
||||||
|
|
||||||
@@ -122,11 +131,23 @@ doesFileExistPath paths file = do
|
|||||||
mpfile <- ioeIO $ getFilePathMsg "" paths file
|
mpfile <- ioeIO $ getFilePathMsg "" paths file
|
||||||
return $ maybe False (const True) mpfile
|
return $ maybe False (const True) mpfile
|
||||||
|
|
||||||
|
getLibraryPath :: IO FilePath
|
||||||
|
getLibraryPath =
|
||||||
|
catch
|
||||||
|
(getEnv "GF_LIB_PATH")
|
||||||
|
#ifdef mingw32_HOST_OS
|
||||||
|
(\_ -> do exepath <- getModuleFileName nullPtr
|
||||||
|
let (path,_) = splitFileName exepath
|
||||||
|
canonicalizePath (combine path "../lib"))
|
||||||
|
#else
|
||||||
|
(const (return libdir))
|
||||||
|
#endif
|
||||||
|
|
||||||
-- | first var is lib prefix, second is like class path
|
-- | first var is lib prefix, second is like class path
|
||||||
-- | path in environment variable has lower priority
|
-- | path in environment variable has lower priority
|
||||||
extendPathEnv :: String -> String -> [FilePath] -> IO [FilePath]
|
extendPathEnv :: String -> String -> [FilePath] -> IO [FilePath]
|
||||||
extendPathEnv lib var ps = do
|
extendPathEnv lib var ps = do
|
||||||
b <- catch (getEnv lib) (const (return libdir)) -- e.g. GF_LIB_PATH
|
b <- getLibraryPath -- e.g. GF_LIB_PATH
|
||||||
s <- catch (getEnv var) (const (return "")) -- e.g. GF_GRAMMAR_PATH
|
s <- catch (getEnv var) (const (return "")) -- e.g. GF_GRAMMAR_PATH
|
||||||
let fs = pFilePaths s
|
let fs = pFilePaths s
|
||||||
let ss = ps ++ fs
|
let ss = ps ++ fs
|
||||||
|
|||||||
Reference in New Issue
Block a user