Fix compilation for wasm32-wasi

.github/workflows/ci-wasm32-wasi.yml

@@ -0,0 +1,29 @@
+name: ci-wasm32-wasi
+
+on:
+  - push
+  - pull_request
+
+jobs:
+  build:
+    runs-on: ubuntu-20.04
+    steps:
+
+      - name: setup-ghc-wasm32-wasi
+        run: |
+          pushd $(mktemp -d)
+          curl -L https://github.com/tweag/ghc-wasm32-wasi/archive/refs/heads/master.tar.gz | tar xz --strip-components=1
+          ./setup.sh
+          ~/.ghc-wasm32-wasi/add_to_github_path.sh
+          popd
+
+      - uses: actions/checkout@v3
+
+      - name: test
+        run: |
+          cp ~/.ghc-wasm32-wasi/wasi-sdk/share/misc/config.* .
+          autoreconf -i
+
+          wasm32-wasi-cabal --project-file=cabal.project.wasm32-wasi build
+
+          ./test-wasm32-wasi.mjs

System/Posix/DynamicLinker/Prim.hsc

@@ -1,4 +1,5 @@
 {-# LANGUAGE Trustworthy #-}
+{-# OPTIONS_GHC -Wno-trustworthy-safe #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -40,6 +41,11 @@ import Foreign.Ptr      ( Ptr, FunPtr, nullPtr )
 import Foreign.C.Types
 import Foreign.C.String ( CString )
 
+#if !defined(HAVE_DLFCN_H)
+import Control.Exception ( throw )
+import System.IO.Error ( ioeSetLocation )
+import GHC.IO.Exception ( unsupportedOperation )
+#endif
 
 -- |On some hosts (e.g. SuSe and Ubuntu Linux) @RTLD_NEXT@ (and
 -- @RTLD_DEFAULT@) are not visible without setting the macro
@@ -87,11 +93,20 @@ packRTLDFlags :: [RTLDFlags] -> CInt
 packRTLDFlags flags = foldl (\ s f -> (packRTLDFlag f) .|. s) 0 flags
 
 packRTLDFlag :: RTLDFlags -> CInt
+#if defined(HAVE_DLFCN_H)
+
 packRTLDFlag RTLD_LAZY = #const RTLD_LAZY
 packRTLDFlag RTLD_NOW = #const RTLD_NOW
 packRTLDFlag RTLD_GLOBAL = #const RTLD_GLOBAL
 packRTLDFlag RTLD_LOCAL = #const RTLD_LOCAL
 
+#else
+
+{-# WARNING packRTLDFlag
+    "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_DLFCN_H@)" #-}
+packRTLDFlag _ = throw (ioeSetLocation unsupportedOperation "packRTLDFlag")
+
+#endif // HAVE_DLFCN_H
 
 -- |Flags for 'System.Posix.DynamicLinker.dlsym'. Notice that 'Next'
 -- might not be available on your particular platform! Use

System/Posix/Files.hsc

@@ -108,6 +108,11 @@ import Data.Monoid ((<>))
 
 import Data.Time.Clock.POSIX (POSIXTime)
 
+#if !defined(HAVE_MKNOD)
+import System.IO.Error ( ioeSetLocation )
+import GHC.IO.Exception ( unsupportedOperation )
+#endif
+
 -- throwErrnoTwoPathsIfMinus1_
 --
 -- | For operations that require two paths (e.g., renaming a file)
@@ -212,6 +217,13 @@ createNamedPipe name mode = do
   withFilePath name $ \s ->
     throwErrnoPathIfMinus1_ "createNamedPipe" name (c_mkfifo s mode)
 
+#if !defined(HAVE_MKNOD)
+
+{-# WARNING createDevice "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_MKNOD@)" #-}
+createDevice :: FilePath -> FileMode -> DeviceID -> IO ()
+createDevice _ _ _ = ioError (ioeSetLocation unsupportedOperation "createDevice")
+
+#else
 -- | @createDevice path mode dev@ creates either a regular or a special file
 -- depending on the value of @mode@ (and @dev@).  @mode@ will normally be either
 -- 'blockSpecialMode' or 'characterSpecialMode'.  May fail with
@@ -228,6 +240,8 @@ createDevice path mode dev =
 foreign import capi unsafe "HsUnix.h mknod"
   c_mknod :: CString -> CMode -> CDev -> IO CInt
 
+#endif // HAVE_MKNOD
+
 -- -----------------------------------------------------------------------------
 -- Hard links
 

System/Posix/Files/ByteString.hsc

@@ -109,6 +109,11 @@ import System.Posix.ByteString.FilePath
 
 import Data.Time.Clock.POSIX (POSIXTime)
 
+#if !defined(HAVE_MKNOD)
+import System.IO.Error ( ioeSetLocation )
+import GHC.IO.Exception ( unsupportedOperation )
+#endif
+
 -- -----------------------------------------------------------------------------
 -- chmod()
 
@@ -207,6 +212,14 @@ createNamedPipe name mode = do
   withFilePath name $ \s ->
     throwErrnoPathIfMinus1_ "createNamedPipe" name (c_mkfifo s mode)
 
+#if !defined(HAVE_MKNOD)
+
+{-# WARNING createDevice "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_MKNOD@)" #-}
+createDevice :: RawFilePath -> FileMode -> DeviceID -> IO ()
+createDevice _ _ _ = ioError (ioeSetLocation unsupportedOperation "createDevice")
+
+#else
+
 -- | @createDevice path mode dev@ creates either a regular or a special file
 -- depending on the value of @mode@ (and @dev@).  @mode@ will normally be either
 -- 'blockSpecialMode' or 'characterSpecialMode'.  May fail with
@@ -223,6 +236,8 @@ createDevice path mode dev =
 foreign import capi unsafe "HsUnix.h mknod"
   c_mknod :: CString -> CMode -> CDev -> IO CInt
 
+#endif // HAVE_MKNOD
+
 -- -----------------------------------------------------------------------------
 -- Hard links
 

System/Posix/IO/Common.hsc

@@ -75,8 +75,22 @@ import qualified GHC.IO.Handle.FD as FD
 import GHC.IO.Exception
 import Data.Typeable (cast)
 
+#if !defined(HAVE_PIPE)
+import System.IO.Error ( ioeSetLocation )
+import GHC.IO.Exception ( unsupportedOperation )
+#endif
+
 #include "HsUnix.h"
 
+#if !defined(HAVE_PIPE)
+
+createPipe :: IO (Fd, Fd)
+{-# WARNING createPipe
+    "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_PIPE@)" #-}
+createPipe = ioError (ioeSetLocation unsupportedOperation "createPipe")
+
+#else
+
 -- -----------------------------------------------------------------------------
 -- Pipes
 -- |The 'createPipe' function creates a pair of connected file
@@ -97,6 +111,22 @@ createPipe =
 foreign import ccall unsafe "pipe"
    c_pipe :: Ptr CInt -> IO CInt
 
+#endif // HAVE_PIPE
+
+#if !defined(HAVE_DUP)
+
+dup :: Fd -> IO Fd
+{-# WARNING dup
+    "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_DUP@)" #-}
+dup _ = ioError (ioeSetLocation unsupportedOperation "dup")
+
+dupTo :: Fd -> Fd -> IO Fd
+{-# WARNING dupTo
+    "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_DUP@)" #-}
+dupTo _ _ = ioError (ioeSetLocation unsupportedOperation "dupTo")
+
+#else
+
 -- -----------------------------------------------------------------------------
 -- Duplicating file descriptors
 
@@ -116,6 +146,8 @@ foreign import ccall unsafe "dup"
 foreign import ccall unsafe "dup2"
    c_dup2 :: CInt -> CInt -> IO CInt
 
+#endif // HAVE_DUP
+
 -- -----------------------------------------------------------------------------
 -- Opening and closing files
 
@@ -334,6 +366,25 @@ data LockRequest = ReadLock
 
 type FileLock = (LockRequest, SeekMode, FileOffset, FileOffset)
 
+#if !defined(HAVE_F_GETLK)
+
+getLock :: Fd -> FileLock -> IO (Maybe (ProcessID, FileLock))
+{-# WARNING getLock
+    "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_F_GETLK@)" #-}
+getLock _ _ = ioError (ioeSetLocation unsupportedOperation "getLock")
+
+setLock :: Fd -> FileLock -> IO ()
+{-# WARNING setLock
+    "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_F_GETLK@)" #-}
+setLock _ _ = ioError (ioeSetLocation unsupportedOperation "setLock")
+
+waitToSetLock :: Fd -> FileLock -> IO ()
+{-# WARNING waitToSetLock
+    "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_F_GETLK@)" #-}
+waitToSetLock _ _ = ioError (ioeSetLocation unsupportedOperation "waitToSetLock")
+
+#else
+
 -- | May throw an exception if this is an invalid descriptor.
 getLock :: Fd -> FileLock -> IO (Maybe (ProcessID, FileLock))
 getLock (Fd fd) lock =
@@ -393,6 +444,8 @@ waitToSetLock (Fd fd) lock = do
     throwErrnoIfMinus1_ "waitToSetLock"
         (Base.c_fcntl_lock fd (#const F_SETLKW) p_flock)
 
+#endif // HAVE_F_GETLK
+
 -- -----------------------------------------------------------------------------
 -- fd{Read,Write}
 

System/Posix/Process.hsc

@@ -72,6 +72,11 @@ import System.Posix.Process.Internals
 import System.Posix.Process.Common
 import System.Posix.Internals ( withFilePath )
 
+#if !defined(HAVE_EXECV)
+import System.IO.Error ( ioeSetLocation )
+import GHC.IO.Exception ( unsupportedOperation )
+#endif
+
 -- | @'executeFile' cmd args env@ calls one of the
 --   @execv*@ family, depending on whether or not the current
 --   PATH is to be searched for the command, and whether or not an
@@ -85,6 +90,14 @@ executeFile :: FilePath                     -- ^ Command
             -> [String]                     -- ^ Arguments
             -> Maybe [(String, String)]     -- ^ Environment
             -> IO a
+#if !defined(HAVE_EXECV)
+
+{-# WARNING executeFile
+    "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_EXECV@)" #-}
+executeFile _ _ _ _ = ioError (ioeSetLocation unsupportedOperation "executeFile")
+
+#else
+
 executeFile path search args Nothing = do
   withFilePath path $ \s ->
     withMany withFilePath (path:args) $ \cstrs ->
@@ -119,3 +132,4 @@ foreign import ccall unsafe "execv"
 foreign import ccall unsafe "execve"
   c_execve :: CString -> Ptr CString -> Ptr CString -> IO CInt
 
+#endif // HAVE_EXECV

System/Posix/Process/ByteString.hsc

@@ -84,6 +84,11 @@ import qualified Data.ByteString.Char8 as BC
 
 import System.Posix.ByteString.FilePath
 
+#if !defined(HAVE_EXECV)
+import System.IO.Error ( ioeSetLocation )
+import GHC.IO.Exception ( unsupportedOperation )
+#endif
+
 -- | @'executeFile' cmd args env@ calls one of the
 --   @execv*@ family, depending on whether or not the current
 --   PATH is to be searched for the command, and whether or not an
@@ -97,6 +102,14 @@ executeFile :: RawFilePath                          -- ^ Command
             -> [ByteString]                 -- ^ Arguments
             -> Maybe [(ByteString, ByteString)]     -- ^ Environment
             -> IO a
+#if !defined(HAVE_EXECV)
+
+{-# WARNING executeFile
+    "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_EXECV@)" #-}
+executeFile _ _ _ _ = ioError (ioeSetLocation unsupportedOperation "executeFile")
+
+#else
+
 executeFile path search args Nothing = do
   withFilePath path $ \s ->
     withMany withFilePath (path:args) $ \cstrs ->
@@ -130,3 +143,5 @@ foreign import ccall unsafe "execv"
 
 foreign import ccall unsafe "execve"
   c_execve :: CString -> Ptr CString -> Ptr CString -> IO CInt
+
+#endif // HAVE_EXECV