# Copyright 2005 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
-- [#]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:" >&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])
  ])
])

# 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
{-# 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 > 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, 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 ()

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_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 "manual"
          d <- getCurrentDirectory
          case reverse $ take 7 $ reverse d of
              "/manual" -> 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 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 :: FilePath -> FilePath -> IO ()
renameFile old new = Control.Exception.block $
   do System.Directory.removeFile new `IO.catch` (\_ -> return ())
      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([           isExecutable, setExecutable, ])
  GHC_CHECK_MODULE(System.Posix.Files( fileMode, getFileStatus, setFileMode ),
                   unix, getFileStatus "",
    IMPORT_WORKAROUND([
import System.Posix.Files (fileMode,getFileStatus, setFileMode, unionFileModes,
                           intersectFileModes, nullFileMode,
                           ownerReadMode, ownerWriteMode, ownerExecuteMode,
                           groupReadMode, groupWriteMode, groupExecuteMode,
                           otherReadMode, otherWriteMode, otherExecuteMode)
isExecutable :: FilePath -> IO Bool
isExecutable f = do st <- getFileStatus f
                    let x = fileMode st
                            `intersectFileModes` ownerExecuteMode
                    return $ x /= nullFileMode
setExecutable :: FilePath -> Bool -> IO ()
setExecutable f ex =
  do st <- getFileStatus f
     let rw = fileMode st `intersectFileModes`
              (ownerReadMode `unionFileModes` ownerWriteMode `unionFileModes`
               groupReadMode `unionFileModes` groupWriteMode `unionFileModes`
               otherReadMode `unionFileModes` otherWriteMode)
         total = if ex then rw `unionFileModes` ownerExecuteMode
                               `unionFileModes` groupExecuteMode
                               `unionFileModes` otherExecuteMode
                       else rw
     setFileMode f total
]),
    CODE_WORKAROUND([
isExecutable :: FilePath -> IO Bool
isExecutable _ = return False
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([failed])
       AC_MSG_ERROR([Couldnt figure out how to call GHC.Handle.openFd!])
    )
  )
])
