diff options
| -rw-r--r-- | src/GF.hs | 6 | ||||
| -rw-r--r-- | src/GF/Devel/UseIO.hs | 21 | ||||
| -rw-r--r-- | src/GF/Infra/UseIO.hs | 23 |
3 files changed, 44 insertions, 6 deletions
@@ -119,15 +119,13 @@ helpMsg = unlines [ ] welcomeMsgLib = do - lib <- catch - (getEnv "GF_LIB_PATH" >>= return . ("GF_LIB_PATH is set to" +++)) - (const (return $ "GF_LIB_PATH is set to the default, " ++ libdir)) + lib <- getLibraryPath return $ welcomeMsg lib welcomeMsg lib = "Welcome to " ++ authorMsg ++++ "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" authorMsg = unlines [ diff --git a/src/GF/Devel/UseIO.hs b/src/GF/Devel/UseIO.hs index 134f2f3d0..db276ae75 100644 --- a/src/GF/Devel/UseIO.hs +++ b/src/GF/Devel/UseIO.hs @@ -1,3 +1,4 @@ +{-# OPTIONS -cpp #-} ---------------------------------------------------------------------- -- | -- Module : UseIO @@ -26,6 +27,12 @@ import System.Environment import System.CPUTime 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' f = putStrLn . show . length . show . f @@ -123,11 +130,23 @@ doesFileExistPath paths file = do mpfile <- ioeIO $ getFilePathMsg "" paths file 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 -- | path in environment variable has lower priority extendPathEnv :: String -> String -> [FilePath] -> IO [FilePath] 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 let fs = pFilePaths s let ss = ps ++ fs diff --git a/src/GF/Infra/UseIO.hs b/src/GF/Infra/UseIO.hs index 6c15ee6e5..2680c0327 100644 --- a/src/GF/Infra/UseIO.hs +++ b/src/GF/Infra/UseIO.hs @@ -1,3 +1,4 @@ +{-# OPTIONS -cpp #-} ---------------------------------------------------------------------- -- | -- Module : UseIO @@ -25,6 +26,14 @@ import System.IO.Error import System.Environment 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' f = putStrLn . show . length . show . f @@ -122,11 +131,23 @@ doesFileExistPath paths file = do mpfile <- ioeIO $ getFilePathMsg "" paths file 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 -- | path in environment variable has lower priority extendPathEnv :: String -> String -> [FilePath] -> IO [FilePath] 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 let fs = pFilePaths s let ss = ps ++ fs |