aboutsummaryrefslogtreecommitdiff
path: root/src/Main.hs
diff options
context:
space:
mode:
authorsimonmar <simonmar@microsoft.com>2005-10-14 23:11:19 +0000
committersimonmar <simonmar@microsoft.com>2005-10-14 23:11:19 +0000
commit21c7ac8d714be74903755ed2d6ee3716ab77a727 (patch)
tree98fe80aceff6746cfbf8eb631a42ef1101198150 /src/Main.hs
parentb2edbedbcf19f9ec187128574f0dba29d3373d41 (diff)
First cut of Cabal build system
Diffstat (limited to 'src/Main.hs')
-rw-r--r--src/Main.hs39
1 files changed, 3 insertions, 36 deletions
diff --git a/src/Main.hs b/src/Main.hs
index 0c9cdb0a..bed74040 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -fglasgow-exts #-}
--
-- Haddock - A Haskell Documentation Tool
--
@@ -22,6 +23,7 @@ import HsSyn
import Map ( Map )
import qualified Map hiding ( Map )
import Set
+import Paths_Haddock ( getDataDir )
import Control.Exception ( bracket )
import Control.Monad ( when )
@@ -166,11 +168,7 @@ run flags files = do
verbose = Flag_Verbose `elem` flags
libdir <- case [str | Flag_Lib str <- flags] of
- [] -> do maybe_exec_dir <- getBaseDir
- -- Get directory of executable
- case maybe_exec_dir of
- Nothing -> return "."
- Just dir -> return dir
+ [] -> getDataDir -- provided by Cabal
fs -> return (last fs)
let css_file = case [str | Flag_CSS str <- flags] of
@@ -1404,34 +1402,3 @@ toModuleInfo descriptionOpt =
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 unsafe "GetModuleFileNameA"
- 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