# Copyright 2005,2008 David Roundy
# Redistribution and use in source and binary forms of this file, with or
# without modification, are permitted provided that redistributions of
# source code must retain the above copyright notice.
# TRY_COMPILE_GHC(PROGRAM, [ACTION-IF-TRUE], [ACTION-IF-FALSE])
# -----------
# Compile and link using ghc.
AC_DEFUN([TRY_COMPILE_GHC],[
cat << \EOF > conftest.hs
[$1]
-- this file generated by TRY-COMPILE-GHC
EOF
rm -f Main.hi Main.o
# Convert LDFLAGS and LIBS to the format GHC wants them in
GHCLDFLAGS=""
for f in $LDFLAGS ; do
GHCLDFLAGS="$GHCLDFLAGS -optl$f"
done
GHCLIBS=""
for l in $LIBS ; do
GHCLIBS="$GHCLIBS -optl$l"
done
if AC_TRY_COMMAND($GHC $GHCFLAGS $GHCLDFLAGS -o conftest conftest.hs $GHCLIBS) && test -s conftest
then
dnl Don't remove the temporary files here, so they can be examined.
ifelse([$2], , :, [$2])
else
echo "configure: failed program was:" >&AS_MESSAGE_LOG_FD
cat conftest.hs >&AS_MESSAGE_LOG_FD
echo "end of failed program." >&AS_MESSAGE_LOG_FD
ifelse([$3], , , [ rm -f Main.hi Main.o
$3
])dnl
fi])
# TRY_RUN_GHC(PROGRAM, [ACTION-IF-TRUE], [ACTION-IF-FALSE])
# -----------
# Compile, link and run using ghc.
AC_DEFUN([TRY_RUN_GHC],[
TRY_COMPILE_GHC([$1],
AS_IF([AC_TRY_COMMAND(./conftest)],[$2],[$3]),
[$3])
])
# GHC_CHECK_ONE_MODULE(MODULE, [ACTION-IF-FOUND], [ACTION-IF-NOT-FOUND])
# -----------
# Compile and link using ghc.
AC_DEFUN([GHC_CHECK_ONE_MODULE],[
TRY_COMPILE_GHC([import $1
main = seq ($2) (putStr "Hello world.\n")
],[$3],[$4])
])
# GHC_CHECK_MODULE(MODULE, PACKAGE, CODE, [ACTION-IF-FOUND], [ACTION-IF-NOT-FOUND])
# -----------
# Compile and link using ghc.
AC_DEFUN([GHC_CHECK_MODULE],[
AC_MSG_CHECKING([for module $1])
GHC_CHECK_ONE_MODULE([$1], [$3], [AC_MSG_RESULT([yes])
$4], [
check_module_save_GHCFLAGS=$GHCFLAGS
GHCFLAGS="$GHCFLAGS -package $2"
GHC_CHECK_ONE_MODULE([$1], [$3], [AC_MSG_RESULT([in package $2])
$4],[
GHCFLAGS=$check_module_save_GHCFLAGS
AC_MSG_RESULT(no; and neither in package $2)
$5])
])
])
# GHC_COMPILE_FFI(IMPORT, TYPE, [ACTION-IF-FOUND], [ACTION-IF-NOT-FOUND])
# -----------
# Compile and link ffi code using ghc.
AC_DEFUN([GHC_COMPILE_FFI],[
TRY_COMPILE_GHC([{-# OPTIONS -fffi -Werror #-}
module Main where
foreign import ccall unsafe "$1" fun :: $2
main = fun `seq` putStrLn "hello world"
],[$3],[$4])])
# GHC_CHECK_LIBRARY(LIBRARY, IMPORT, TYPE, [ACTION-IF-FOUND], [ACTION-IF-NOT-FOUND])
# -----------
# Compile and link with C library using ghc.
AC_DEFUN([GHC_CHECK_LIBRARY],[
AC_MSG_CHECKING([for library $1])
GHC_COMPILE_FFI([$2], [$3], [AC_MSG_RESULT([yes])
$4], [
check_library_save_LIBS=$LIBS
LIBS="$LIBS -l$1"
GHC_COMPILE_FFI([$2], [$3], [AC_MSG_RESULT([in -l$1])
$4],[
LIBS=$check_library_save_LIBS
AC_MSG_RESULT(no; and not with -l$1 either)
$5])
])
])
# INIT_WORKAROUND
# ---------------
# Initialize src/Workaround.hs module.
AC_DEFUN([INIT_WORKAROUND],[
rm -f src/Workaround.hs.beginning src/Workaround.hs.ending
touch src/Workaround.hs.ending
cat << \EOF > src/Workaround.hs.prefix
{-# OPTIONS -w #-}
{- Workaround.hs
This file was created automatically by configure. We disable warnings to
avoid issues with duplicate imports.
-}
module Workaround(
EOF
cat << \EOF > src/Workaround.hs.beginning
) where
EOF
])
# OUTPUT_WORKAROUND
# -----------------
# Create the src/Workaround.hs module.
AC_DEFUN([OUTPUT_WORKAROUND],[
cat src/Workaround.hs.prefix src/Workaround.hs.beginning src/Workaround.hs.ending > src/Workaround.hs
rm -f src/Workaround.hs.beginning src/Workaround.hs.ending src/Workaround.hs.prefix
])
# IMPORT_WORKAROUND(CODE)
# -----------------------
# Import a module into src/Workaround.hs
AC_DEFUN([IMPORT_WORKAROUND],[
cat << \EOF >> src/Workaround.hs.beginning
$1
EOF
])
# EXPORT_WORKAROUND(CODE)
# -----------------------
# Export from src/Workaround.hs
AC_DEFUN([EXPORT_WORKAROUND],[
cat << \EOF >> src/Workaround.hs.prefix
$1
EOF
])
# CODE_WORKAROUND(CODE)
# ---------------------
# Import a module into src/Workaround.hs
AC_DEFUN([CODE_WORKAROUND],[
cat << \EOF >> src/Workaround.hs.ending
$1
EOF
])
# WORKAROUND_POSIXSIGNALS(IMPORTS)
# -----------------------
# Work around missing POSIX signals code.
AC_DEFUN([WORKAROUND_POSIXSIGNALS],[
EXPORT_WORKAROUND([$1])
GHC_CHECK_MODULE(System.Posix.Signals($1), unix, undefined,
[IMPORT_WORKAROUND([import System.Posix.Signals($1)])],
GHC_CHECK_MODULE(Posix($1), util, undefined,
[IMPORT_WORKAROUND([import Posix($1)])],
[CODE_WORKAROUND([[
-- Dummy implementation of POSIX signals
data Handler = Default | Ignore | Catch (IO ())
type Signal = Int
installHandler :: Signal -> Handler -> Maybe () -> IO ()
installHandler _ _ _ = return ()
raiseSignal :: Signal -> IO ()
raiseSignal _ = return ()
sigINT, {- sigKILL, -} sigHUP, {- sigQUIT, -} sigABRT, sigALRM, sigTERM, sigPIPE :: Signal
sigINT = 0
-- not used: sigKILL = 0
sigHUP = 0
-- not used: sigQUIT = 0
sigABRT = 0
sigTERM = 0
sigPIPE = 0
sigALRM = 0
-- not used: raiseSignal :: Signal -> IO ()
-- not used: raiseSignal _ = return ()
]])]
)
)
])
# WORKAROUND_bracketOnError
# -----------------------
# Work around missing bracketOnError
AC_DEFUN([WORKAROUND_bracketOnError],[
EXPORT_WORKAROUND([ bracketOnError, ])
GHC_CHECK_MODULE(Control.Exception( bracketOnError ), base ,
bracketOnError (return ()) (const $ return ()) (const $ return ()),
[IMPORT_WORKAROUND([import Control.Exception( bracketOnError )])],
[IMPORT_WORKAROUND([import qualified Control.Exception( catch, throw, block, unblock )])
CODE_WORKAROUND([[
-- | Like bracket, but only performs the final action if there was an
-- exception raised by the in-between computation.
-- From GHC 6.6 (with twiddling for qualified block, catch, etc)
bracketOnError
:: IO a -- ^ computation to run first (\"acquire resource\")
-> (a -> IO b) -- ^ computation to run last (\"release resource\")
-> (a -> IO c) -- ^ computation to run in-between
-> IO c -- returns the value from the in-between computation
bracketOnError before after thing =
Control.Exception.block (do
a <- before
Control.Exception.catch
(Control.Exception.unblock (thing a))
(\e -> do { after a; Control.Exception.throw e })
)
]])
])
])
# WORKAROUND_createLink
# -----------------------
# Work around missing POSIX createLink code.
AC_DEFUN([WORKAROUND_createLink],[
EXPORT_WORKAROUND([ createLink, ])
GHC_CHECK_MODULE(System.Posix.Files( createLink ), unix, createLink "a" "b",
[IMPORT_WORKAROUND([import System.Posix.Files( createLink )])],
GHC_CHECK_MODULE(Posix( createLink ), util, createLink "a" "b",
[IMPORT_WORKAROUND([import Posix( createLink )])],
[CODE_WORKAROUND([[
-- Dummy implementation of createLink.
createLink :: FilePath -> FilePath -> IO ()
createLink _ _ = fail "Dummy create link error should be caught."
]])]
)
)
])
# WORKAROUND_createDirectoryIfMissing
# ------------------------------
# Work around missing createDirectoryIfMissing.
AC_DEFUN([WORKAROUND_createDirectoryIfMissing],[
EXPORT_WORKAROUND([ createDirectoryIfMissing, ])
AC_MSG_CHECKING([createDirectoryIfMissing])
TRY_COMPILE_GHC([
import System.Directory(createDirectoryIfMissing)
main = createDirectoryIfMissing True ""
],
[AC_MSG_RESULT([has createDirectoryIfMissing])
IMPORT_WORKAROUND([import System.Directory(createDirectoryIfMissing)])],
[AC_MSG_RESULT([doesn't have createDirectoryIfMissing])
IMPORT_WORKAROUND([import System.Directory ( doesDirectoryExist, createDirectory )])
CODE_WORKAROUND([[
createDirectoryIfMissing
:: Bool -- ^ Create its parents too?
-> FilePath -- ^ The path to the directory you want to make
-> IO ()
createDirectoryIfMissing parents file = do
b <- doesDirectoryExist file
case (b,parents, file) of
(_, _, "") -> return ()
(True, _, _) -> return ()
(_, True, _) -> mapM_ (createDirectoryIfMissing False) (tail (pathParents file))
(_, False, _) -> createDirectory file
where pathParents :: FilePath -> [FilePath]
pathParents p =
root'' : map ((++) root') (dropEmptyPath $ inits path')
where
#ifdef WIN32
(root,path) = case break (== ':') p of
(rel, "") -> ("",rel)
(drv,_:rel) -> (drv++":",rel)
#else
(root,path) = ("",p)
#endif
(root',root'',path') = case path of
(c:path'') | isPathSeparator c -> (root++[pathSeparator],root++[pathSeparator],path'')
_ -> (root ,root++"." ,path)
dropEmptyPath ("":paths) = paths
dropEmptyPath paths = paths
inits :: String -> [String]
inits [] = [""]
inits cs =
case pre of
"." -> inits suf
".." -> map (joinFileName pre) (dropEmptyPath $ inits suf)
_ -> "" : map (joinFileName pre) (inits suf)
where
(pre,suf) = case break isPathSeparator cs of
(pre',"") -> (pre', "")
(pre',_:suf') -> (pre',suf')
isPathSeparator :: Char -> Bool
isPathSeparator ch = ch == pathSeparator || ch == '/'
pathSeparator :: Char
#ifdef WIN32
pathSeparator = '\\'
#else
pathSeparator = '/'
#endif
joinFileName :: String -> String -> FilePath
joinFileName "" fname = fname
joinFileName "." fname = fname
joinFileName dir "" = dir
joinFileName dir fname
| isPathSeparator (last dir) = dir++fname
| otherwise = dir++pathSeparator:fname
]])
]
)
])
# WORKAROUND_getCurrentDirectory
# ------------------------------
# Work around getCurrentDirectory that uses '\\' rather than '/'.
AC_DEFUN([WORKAROUND_getCurrentDirectory],[
EXPORT_WORKAROUND([ getCurrentDirectory, ])
AC_MSG_CHECKING([getCurrentDirectory])
TRY_RUN_GHC([
import System.Directory(getCurrentDirectory, setCurrentDirectory)
main = do setCurrentDirectory "src"
d <- getCurrentDirectory
case reverse $ take 4 $ reverse d of
"/src" -> return ()
],
[AC_MSG_RESULT([uses /])
IMPORT_WORKAROUND([import System.Directory(getCurrentDirectory)])]
GHC_SEPARATOR='/',
[AC_MSG_RESULT([uses \\])
IMPORT_WORKAROUND([import qualified System.Directory(getCurrentDirectory)])
GHC_SEPARATOR='\\'
CODE_WORKAROUND([[
{-
System.Directory.getCurrentDirectory returns a path with backslashes in it
under windows, and some of the code gets confused by that, so we override
getCurrentDirectory and translates '\\' to '/'
-}
getCurrentDirectory :: IO FilePath
getCurrentDirectory = do d <- System.Directory.getCurrentDirectory
return $ map rb d
where rb '\\' = '/'
rb c = c
]])
]
)
])
# WORKAROUND_renameFile
# -----------------------
# Work around buggy renameFile.
AC_DEFUN([WORKAROUND_renameFile],[
EXPORT_WORKAROUND([ renameFile, ])
AC_MSG_CHECKING([renameFile])
TRY_RUN_GHC([
import System.Directory ( renameFile )
main = do writeFile "conftest.data" "orig_data"
writeFile "conftest.newdata" "new_data"
renameFile "conftest.newdata" "conftest.data"
],
[AC_MSG_RESULT([okay])
IMPORT_WORKAROUND([import System.Directory ( renameFile )])],
AC_MSG_RESULT([buggy!])
IMPORT_WORKAROUND([import qualified System.Directory( renameFile, removeFile )])
IMPORT_WORKAROUND([import qualified System.IO.Error])
IMPORT_WORKAROUND([import qualified Control.Exception ( block )])
CODE_WORKAROUND([
{-
System.Directory.renameFile incorrectly fails when the new file already
exists. This code works around that bug at the cost of losing atomic
writes.
-}
renameFile :: FilePath -> FilePath -> IO ()
renameFile old new = Control.Exception.block $
do System.Directory.removeFile new
`System.IO.Error.catch`
(\e -> if System.IO.Error.isDoesNotExistError e
then return ()
else System.IO.Error.ioError e)
System.Directory.renameFile old new
])
)
])
# WORKAROUND_fileModes
# --------------------
# Figure out how to set unix permissions on a file (or creates a dummy
# function for this).
AC_DEFUN([WORKAROUND_fileModes],[
EXPORT_WORKAROUND([ fileMode, getFileStatus, setFileMode, ])
GHC_CHECK_MODULE(System.Posix.Files( fileMode, getFileStatus, setFileMode ), unix, getFileStatus "",
IMPORT_WORKAROUND([import System.Posix.Files(fileMode,getFileStatus,setFileMode)]),
CODE_WORKAROUND([
fileMode :: () -> ()
fileMode _ = ()
getFileStatus :: FilePath -> IO ()
getFileStatus _ = return ()
setFileMode :: FilePath -> () -> IO ()
setFileMode _ _ = return ()
])
)
])
# WORKAROUND_executable
# --------------------
# Figure out how to make a file executable (or test if it is).
AC_DEFUN([WORKAROUND_executable],[
EXPORT_WORKAROUND([ setExecutable, ])
GHC_CHECK_MODULE(System.Posix.Files( fileMode, getFileStatus, setFileMode, setFileCreationMask ),
unix, getFileStatus "",
IMPORT_WORKAROUND([
import System.Posix.Files (fileMode,getFileStatus, setFileMode, nullFileMode,
setFileCreationMask,
ownerReadMode, ownerWriteMode, ownerExecuteMode,
groupReadMode, groupWriteMode, groupExecuteMode,
otherReadMode, otherWriteMode, otherExecuteMode)
import Data.Bits ( (.&.), (.|.), complement )
setExecutable :: FilePath -> Bool -> IO ()
setExecutable f ex =
do st <- getFileStatus f
umask <- setFileCreationMask 0
setFileCreationMask umask
let rw = fileMode st .&.
(ownerReadMode .|. ownerWriteMode .|.
groupReadMode .|. groupWriteMode .|.
otherReadMode .|. otherWriteMode)
total = if ex then rw .|.
((ownerExecuteMode .|. groupExecuteMode .|. otherExecuteMode)
.&. complement umask)
else rw
setFileMode f total
]),
CODE_WORKAROUND([
setExecutable :: FilePath -> Bool -> IO ()
setExecutable _ _ = return ()
])
)
])
# WORKAROUND_openFd
# -----------------------
# Work around changing openFd function
AC_DEFUN([WORKAROUND_openFd],[
EXPORT_WORKAROUND([ openFd, ])
AC_MSG_CHECKING([GHC.Handle.openFd])
TRY_RUN_GHC([
import GHC.Handle ( openFd )
import IO ( IOMode(..))
main = openFd 1 Nothing "stdout" WriteMode True False
],
AC_MSG_RESULT([okay])
IMPORT_WORKAROUND([import GHC.Handle( openFd )]),
AC_MSG_RESULT([NOT old API])
AC_MSG_CHECKING([GHC.Handle.openFd new API])
TRY_RUN_GHC([
import GHC.Handle ( openFd )
import IO ( IOMode(..))
main = openFd 1 Nothing False "stdout" WriteMode True
],
AC_MSG_RESULT([okay])
IMPORT_WORKAROUND([import qualified GHC.Handle ( openFd )
import System.IO ( Handle, IOMode )
import System.Posix.Internals ( FDType )
])
CODE_WORKAROUND([[
{-
Work around change in the GHC.Handle.openFd API.
-}
openFd :: Int -> Maybe FDType -> FilePath -> IOMode -> Bool -> Bool -> IO Handle
openFd fd x y z a b = GHC.Handle.openFd fd x b y z a
]]),
AC_MSG_RESULT([NOT 'new' API])
AC_MSG_CHECKING([GHC.Handle.fdToHandle' API])
TRY_RUN_GHC([
import GHC.Handle ( fdToHandle' )
import IO ( IOMode(..) )
main = fdToHandle' 1 Nothing False "stdout" WriteMode True
],
AC_MSG_RESULT([okay])
IMPORT_WORKAROUND([import qualified GHC.Handle ( fdToHandle' )
import System.IO ( Handle, IOMode )
import System.Posix.Internals ( FDType )
])
CODE_WORKAROUND([[
{-
Work around renaming of GHC.Handle.openFd and change in its API.
-}
openFd :: Int -> Maybe FDType -> FilePath -> IOMode -> Bool -> Bool -> IO Handle
openFd fd x y z a b = GHC.Handle.fdToHandle' (fromIntegral fd) x b y z a
]]),
AC_MSG_RESULT([failed])
AC_MSG_ERROR([Couldnt figure out how to call GHC.Handle.openFd!])
)
)
)])