aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Main.hs41
-rw-r--r--src/Makefile4
2 files changed, 44 insertions, 1 deletions
diff --git a/src/Main.hs b/src/Main.hs
index fa128388..96b76f2e 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -51,6 +51,12 @@ import Regex
import PackedString
#endif
+#if defined(mingw32_HOST_OS)
+import Foreign.Marshal.Array
+import Foreign
+import Foreign.C
+#endif
+
-----------------------------------------------------------------------------
-- Top-level stuff
main :: IO ()
@@ -161,7 +167,10 @@ run flags files = do
(t:_) -> Just t
libdir <- case [str | Flag_Lib str <- flags] of
- [] -> dieMsg "no --lib option"
+ [] -> do maybe_exec_dir <- getBaseDir -- Get directory of executable
+ case maybe_exec_dir of
+ Nothing -> return "."
+ Just dir -> return (dir ++ "\\imports")
fs -> return (last fs)
let css_file = case [str | Flag_CSS str <- flags] of
@@ -1125,3 +1134,33 @@ collectInstances mod_ifaces
type ErrMsg = String
type ErrMsgM a = Writer [ErrMsg] a
+getBaseDir :: IO (Maybe String)
+#if defined(mingw32_HOST_OS)
+getBaseDir = do let len = (2048::Int) -- plenty, PATH_MAX is 512 under Win32.
+ buf <- mallocArray len
+ ret <- getModuleFileName nullPtr buf len
+ if ret == 0 then free buf >> return Nothing
+ else do s <- peekCString buf
+ free buf
+ return (Just (rootDir s))
+ where
+ rootDir s = reverse (dropList "/haddock.exe" (reverse (normalisePath s)))
+
+foreign import stdcall "GetModuleFileNameA" unsafe
+ getModuleFileName :: Ptr () -> CString -> Int -> IO Int32
+#else
+getBaseDir :: IO (Maybe String) = do return Nothing
+#endif
+normalisePath :: String -> String
+-- Just changes '\' to '/'
+
+#if defined(mingw32_HOST_OS)
+normalisePath xs = subst '\\' '/' xs
+subst a b ls = map (\ x -> if x == a then b else x) ls
+#else
+normalisePath xs = xs
+#endif
+dropList :: [b] -> [a] -> [a]
+dropList [] xs = xs
+dropList _ xs@[] = xs
+dropList (_:xs) (_:ys) = dropList xs ys
diff --git a/src/Makefile b/src/Makefile
index f6a7c51d..03192ee4 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -27,6 +27,10 @@ endif
HS_PROG = haddock$(HS_PROG_EXT)
+ifeq "$(HOSTPLATFORM)" "i386-unknown-mingw32"
+Main_HC_OPTS += -Dmingw32_HOST_OS=1
+endif
+
HsParser_HC_OPTS += -Onot
HaddockParse_HC_OPTS += -Onot
HaddockVersion_HC_OPTS = -DHADDOCK_VERSION=$(ProjectVersion)