# TRY_COMPILE_GHC(PROGRAM, [ACTION-IF-TRUE], [ACTION-IF-FALSE])
# -----------
# Compile and link using ghc.
AC_DEFUN([TRY_COMPILE_GHC],[
cat << \EOF > conftest.hs
-- [#]line __oline__ "configure"
[$1]
EOF
rm -f Main.hi Main.o
if AC_TRY_COMMAND($GHC $GHCFLAGS -o conftest conftest.hs) && 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:" >&AC_FD_CC
  cat conftest.hs >&AC_FD_CC
  echo "end of failed program." >&AC_FD_CC
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 = putStr "Hello world.\n"
                ],[$2],[$3])

])

# GHC_CHECK_MODULE(MODULE, PACKAGE, [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], [AC_MSG_RESULT([yes])
$3], [
  check_module_save_GHCFLAGS=$GHCFLAGS
  GHCFLAGS="$GHCFLAGS -package $2"
  GHC_CHECK_ONE_MODULE([$1],[AC_MSG_RESULT([in package $2])
$3],[
    GHCFLAGS=$check_module_save_GHCFLAGS
    AC_MSG_RESULT(not in $2)
    $4])
  ])
])

# INIT_WORKAROUND
# ---------------
# Initialize Workaround.hs module.
AC_DEFUN([INIT_WORKAROUND],[
rm -f Workaround.hs.beginning Workaround.hs.ending
touch Workaround.hs.ending
cat << \EOF > Workaround.hs.prefix
{- Workaround.hs

This file was created automatically by configure.

-}

module Workaround(
EOF
cat << \EOF > Workaround.hs.beginning
 ) where

EOF
])

# OUTPUT_WORKAROUND
# -----------------
# Create the Workaround.hs module.
AC_DEFUN([OUTPUT_WORKAROUND],[
cat Workaround.hs.prefix Workaround.hs.beginning Workaround.hs.ending > Workaround.hs
rm -f Workaround.hs.beginning Workaround.hs.ending Workaround.hs.prefix
])

# IMPORT_WORKAROUND(CODE)
# -----------------------
# Import a module into Workaround.hs
AC_DEFUN([IMPORT_WORKAROUND],[
cat << \EOF >> Workaround.hs.beginning
$1
EOF
])

# EXPORT_WORKAROUND(CODE)
# -----------------------
# Export from Workaround.hs
AC_DEFUN([EXPORT_WORKAROUND],[
cat << \EOF >> Workaround.hs.prefix
$1
EOF
])

# CODE_WORKAROUND(CODE)
# ---------------------
# Import a module into Workaround.hs
AC_DEFUN([CODE_WORKAROUND],[
cat << \EOF >> 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,
    [IMPORT_WORKAROUND([import System.Posix.Signals($1)])],
    GHC_CHECK_MODULE(Posix($1), util,
      [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 ()

sigINT, sigKILL, sigHUP, sigQUIT, sigABRT, sigALRM, sigTERM, sigPIPE :: Signal
sigINT = 0
sigKILL = 0
sigHUP = 0
sigQUIT = 0
sigABRT = 0
sigTERM = 0
sigPIPE = 0
sigALRM = 0

raiseSignal :: Signal -> IO ()
raiseSignal s = return ()

]])]
    )
  )
])

# WORKAROUND_createLink
# -----------------------
# Work around missing POSIX createLink code.
AC_DEFUN([WORKAROUND_createLink],[
  EXPORT_WORKAROUND([           createLink, ])
  GHC_CHECK_MODULE(System.Posix.Files( createLink ), unix,
    [IMPORT_WORKAROUND([import System.Posix.Files( createLink )])],
    GHC_CHECK_MODULE(Posix( createLink ), util,
      [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_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 "manual"
          d <- getCurrentDirectory
          case reverse $ take 7 $ reverse d of
              "/manual" -> return ()
    ],
    [AC_MSG_RESULT([uses /])
     IMPORT_WORKAROUND([import System.Directory(getCurrentDirectory)])],
    [AC_MSG_RESULT([uses \\])
      IMPORT_WORKAROUND([import qualified System.Directory(getCurrentDirectory)])
      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 = do d <- System.Directory.getCurrentDirectory
                         return $ map rb d
    where rb '\\' = '/'
          rb c = c
      ]])
    ]
  )
])

# WORKAROUND_Regex
# -----------------------
# Work around missing Text.Regex code.
AC_DEFUN([WORKAROUND_Regex],[
  EXPORT_WORKAROUND([           Regex, mkRegex, matchRegex, ])
  AC_MSG_CHECKING([Text.Regex])
  TRY_RUN_GHC([
import Text.Regex ( mkRegex, matchRegex )
import System.Mem ( performGC )

main = sequence_ $ map trymatch regexen

regexen = map r [1..100]
          where r n = mkRegex $ concat $ map show [0..n]

trymatch r = if matchRegex r "Hello world" /= Nothing
             then putStr $ "It matches!\n"
             else performGC
    ],
    AC_MSG_RESULT([okay])
    IMPORT_WORKAROUND([import Text.Regex( Regex, mkRegex, matchRegex )]),
    AC_MSG_RESULT([buggy!])
    GHC_CHECK_MODULE(RegexString( Regex, mkRegex, matchRegex ), text)
    AC_MSG_CHECKING([RegexString])
    TRY_RUN_GHC([
import RegexString ( mkRegex, matchRegex )

main = case matchRegex (mkRegex "world") "hello world" of
       Nothing -> fail "bad RegexString"
       _ -> return ()
      ],
      AC_MSG_RESULT([okay])
      IMPORT_WORKAROUND([import RegexString ( Regex, mkRegex, matchRegex )]),
      AC_MSG_RESULT([also buggy... working around.])
      IMPORT_WORKAROUND([import RegexString ( Regex, matchRegex )])
      IMPORT_WORKAROUND([import qualified RegexString ( mkRegex )])
      CODE_WORKAROUND([
{-
Work around bug in RegexString that treats all regexes as if they began
with a ^.
-}

mkRegex ('^':r) = RegexString.mkRegex ('^':r)
mkRegex r = RegexString.mkRegex $ ".*"++r
       ]),
      AC_MSG_ERROR([Couldn't find working Regex module!])
    )
  )
])

# 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 IO ( catch )])
    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 old new = Control.Exception.block $
   do System.Directory.removeFile new `IO.catch` (\_ -> return ())
      System.Directory.renameFile old new
     ])
  )
])

# WORKAROUND_handleToFd
# -----------------------
# Figure out how to extract a file descriptor from a handle.

AC_DEFUN([WORKAROUND_handleToFd],[
  EXPORT_WORKAROUND([           handleToFd, fdToInt,])
  GHC_CHECK_MODULE(System.Posix.IO( handleToFd ), unix,
    IMPORT_WORKAROUND([import System.Posix.IO( handleToFd )])
    IMPORT_WORKAROUND([import qualified System.Posix.Types( Fd )])
    CODE_WORKAROUND([
fdToInt :: System.Posix.Types.Fd -> Int
fdToInt = fromIntegral]),
    GHC_CHECK_MODULE(Posix( handleToFd, fdToInt ), util,
      [IMPORT_WORKAROUND([import Posix( handleToFd, fdToInt )])],
      [IMPORT_WORKAROUND([import GHC.Handle(withHandle,flushWriteBufferOnly,unlockFile)])
       IMPORT_WORKAROUND([import GHC.IOBase(Handle,HandleType(ClosedHandle),haFD,haType)])
       CODE_WORKAROUND([[
{-
Since we don't have either Posix or System.Posix, we have to assume with
have ghc6 in which case the following code should work for getting a file
descriptor out of a Handle.  This code was taken from System.Posix.IO
itself.
-}
fdToInt fd = fd
handleToFd :: Handle -> IO Int
handleToFd h = withHandle "handleToFd" h $ \ h_ -> do
  -- converting a Handle into an Fd effectively means
  -- letting go of the Handle; it is put into a closed
  -- state as a result.
  let fd = haFD h_
  flushWriteBufferOnly h_
  unlockFile (fromIntegral fd)
    -- setting the Handle's fd to (-1) as well as its 'type'
    -- to closed, is enough to disable the finalizer that
    -- eventually is run on the Handle.
  return (h_{haFD= (-1),haType=ClosedHandle}, (fromIntegral fd))
       ]])
      ]
    )
  )
])

# 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,
    IMPORT_WORKAROUND([import System.Posix.Files(fileMode,getFileStatus,setFileMode)]),
    CODE_WORKAROUND([
fileMode :: () -> ()
fileMode _ = ()
getFileStatus :: FilePath -> IO ()
getFileStatus _ = return ()
setFileMode :: FilePath -> () -> IO ()
setFileMode _ _ = return ()
])
  )
])