{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE UndecidableInstances #-}

module Unison.Runtime.Foreign.Function (foreignCall) where

import Control.Concurrent (ThreadId)
import Control.Concurrent as SYS
  ( killThread,
    threadDelay,
  )
import Control.Concurrent.MVar as SYS
import Control.Concurrent.STM (TVar)
import Control.Concurrent.STM qualified as STM
import Control.DeepSeq (NFData)
import Control.Exception
import Control.Exception.Safe qualified as Exception
import Control.Monad.Catch (MonadCatch)
import Control.Monad.Primitive qualified as PA
import Crypto.Error (CryptoError (..), CryptoFailable (..))
import Crypto.Hash qualified as Hash
import Crypto.MAC.HMAC qualified as HMAC
import Crypto.PubKey.Ed25519 qualified as Ed25519
import Crypto.PubKey.RSA.PKCS15 qualified as RSA
import Crypto.Random (getRandomBytes)
import Data.Atomics (Ticket)
import Data.Bits (shiftL, shiftR, (.|.))
import Data.ByteArray qualified as BA
import Data.ByteString (hGet, hGetSome, hPut)
import Data.ByteString.Lazy qualified as L
import Data.Default (def)
import Data.Digest.Murmur64 (asWord64, hash64)
import Data.IORef (IORef)
import Data.IP (IP)
import Data.PEM (PEM, pemContent, pemParseLBS)
import Data.Sequence qualified as Sq
import Data.Text qualified
import Data.Text.IO qualified as Text.IO
import Data.Time.Clock.POSIX (POSIXTime)
import Data.Time.Clock.POSIX as SYS
  ( getPOSIXTime,
    posixSecondsToUTCTime,
    utcTimeToPOSIXSeconds,
  )
import Data.Time.LocalTime (TimeZone (..), getTimeZone)
import Data.X509 qualified as X
import Data.X509.CertificateStore qualified as X
import Data.X509.Memory qualified as X
import GHC.Conc qualified as STM
import GHC.IO (IO (IO))
import GHC.IO.Exception (IOErrorType (..), IOException (..))
import Network.Simple.TCP as SYS
  ( HostPreference (..),
    bindSock,
    closeSock,
    connectSock,
    listenSock,
    recv,
    send,
  )
import Network.Socket (Socket)
import Network.Socket as SYS
  ( PortNumber,
    Socket,
    accept,
    socketPort,
  )
import Network.TLS as TLS
import Network.TLS.Extra.Cipher as Cipher
import Network.UDP (UDPSocket)
import Network.UDP as UDP
  ( ClientSockAddr,
    ListenSocket,
    clientSocket,
    close,
    recv,
    recvFrom,
    send,
    sendTo,
    serverSocket,
    stop,
  )
import System.Clock (Clock (..), getTime, nsec, sec)
import System.Directory as SYS
  ( createDirectoryIfMissing,
    doesDirectoryExist,
    doesPathExist,
    getCurrentDirectory,
    getDirectoryContents,
    getFileSize,
    getModificationTime,
    getTemporaryDirectory,
    removeDirectoryRecursive,
    removeFile,
    renameDirectory,
    renameFile,
    setCurrentDirectory,
  )
import System.Environment as SYS
  ( getArgs,
    getEnv,
  )
import System.Exit as SYS (ExitCode (..))
import System.FilePath (isPathSeparator)
import System.IO (BufferMode (..), Handle, IOMode, SeekMode)
import System.IO as SYS
  ( IOMode (..),
    hClose,
    hGetBuffering,
    hGetChar,
    hGetEcho,
    hIsEOF,
    hIsOpen,
    hIsSeekable,
    hReady,
    hSeek,
    hSetBuffering,
    hSetEcho,
    hTell,
    openFile,
    stderr,
    stdin,
    stdout,
  )
import System.IO.Temp (createTempDirectory)
import System.Process as SYS
  ( getProcessExitCode,
    proc,
    runInteractiveProcess,
    terminateProcess,
    waitForProcess,
    withCreateProcess,
  )
import System.X509 qualified as X
import Unison.Builtin.Decls qualified as Ty
import Unison.Prelude hiding (Text, some)
import Unison.Reference
import Unison.Referent (Referent, pattern Ref)
import Unison.Runtime.ANF (Code, PackedTag (..), Value, internalBug)
import Unison.Runtime.ANF qualified as ANF
import Unison.Runtime.ANF.Rehash (checkGroupHashes)
import Unison.Runtime.ANF.Serialize qualified as ANF
import Unison.Runtime.Array qualified as PA
import Unison.Runtime.Builtin
import Unison.Runtime.Crypto.Rsa qualified as Rsa
import Unison.Runtime.Exception
import Unison.Runtime.Foreign hiding (Failure)
import Unison.Runtime.Foreign qualified as F
import Unison.Runtime.Foreign.Function.Type (ForeignFunc (..))
import Unison.Runtime.MCode
import Unison.Runtime.Stack
import Unison.Symbol
import Unison.Type
  ( iarrayRef,
    ibytearrayRef,
    marrayRef,
    mbytearrayRef,
    mvarRef,
    promiseRef,
    refRef,
    ticketRef,
    tvarRef,
    typeLinkRef,
  )
import Unison.Type qualified as Ty
import Unison.Util.Bytes (Bytes)
import Unison.Util.Bytes qualified as Bytes
import Unison.Util.RefPromise
  ( Promise,
    newPromise,
    readPromise,
    tryReadPromise,
    writePromise,
  )
import Unison.Util.Text (Text, pack, unpack)
import Unison.Util.Text qualified as Util.Text
import Unison.Util.Text.Pattern qualified as TPat
import UnliftIO qualified

-- foreignCall is explicitly NOINLINE'd because it's a _huge_ chunk of code and negatively affects code caching.
-- Because we're not inlining it, we need a wrapper using an explicitly unboxed Stack so we don't block the
-- worker-wrapper optimizations in the main eval loop.
-- It looks dump to accept an unboxed stack and then immediately box it up, but GHC is sufficiently smart to
-- unbox all of 'foreignCallHelper' when we write it this way, but it's way less work to use the regular lifted stack
-- in its implementation.
{-# NOINLINE foreignCall #-}
foreignCall :: ForeignFunc -> Args -> XStack -> IOXStack
foreignCall :: ForeignFunc -> Args -> XStack -> IOXStack
foreignCall !ForeignFunc
ff !Args
args !XStack
xstk =
  IO Stack -> IOXStack
stackIOToIOX (IO Stack -> IOXStack) -> IO Stack -> IOXStack
forall a b. (a -> b) -> a -> b
$ ForeignFunc -> Args -> Stack -> IO Stack
foreignCallHelper ForeignFunc
ff Args
args (XStack -> Stack
packXStack XStack
xstk)

{-# INLINE foreignCallHelper #-}
foreignCallHelper :: ForeignFunc -> Args -> Stack -> IO Stack
foreignCallHelper :: ForeignFunc -> Args -> Stack -> IO Stack
foreignCallHelper = \case
  ForeignFunc
IO_UDP_clientSocket_impl_v1 -> ((Text, Text) -> IO UDPSocket) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF (((Text, Text) -> IO UDPSocket) -> Args -> Stack -> IO Stack)
-> ((Text, Text) -> IO UDPSocket) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ \(Text
host :: Util.Text.Text, Text
port :: Util.Text.Text) ->
    let hostStr :: String
hostStr = Text -> String
Util.Text.toString Text
host
        portStr :: String
portStr = Text -> String
Util.Text.toString Text
port
     in String -> String -> Bool -> IO UDPSocket
UDP.clientSocket String
hostStr String
portStr Bool
True
  ForeignFunc
IO_UDP_UDPSocket_recv_impl_v1 -> (UDPSocket -> IO Bytes) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF ((UDPSocket -> IO Bytes) -> Args -> Stack -> IO Stack)
-> (UDPSocket -> IO Bytes) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ \(UDPSocket
sock :: UDPSocket) -> ByteString -> Bytes
forall b. ByteArrayAccess b => b -> Bytes
Bytes.fromArray (ByteString -> Bytes) -> IO ByteString -> IO Bytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UDPSocket -> IO ByteString
UDP.recv UDPSocket
sock
  ForeignFunc
IO_UDP_UDPSocket_send_impl_v1 -> ((UDPSocket, Bytes) -> IO ()) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF (((UDPSocket, Bytes) -> IO ()) -> Args -> Stack -> IO Stack)
-> ((UDPSocket, Bytes) -> IO ()) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(UDPSocket
sock :: UDPSocket, Bytes
bytes :: Bytes.Bytes) ->
      UDPSocket -> ByteString -> IO ()
UDP.send UDPSocket
sock (Bytes -> ByteString
forall b. ByteArray b => Bytes -> b
Bytes.toArray Bytes
bytes)
  ForeignFunc
IO_UDP_UDPSocket_close_impl_v1 -> (UDPSocket -> IO ()) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF ((UDPSocket -> IO ()) -> Args -> Stack -> IO Stack)
-> (UDPSocket -> IO ()) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(UDPSocket
sock :: UDPSocket) -> UDPSocket -> IO ()
UDP.close UDPSocket
sock
  ForeignFunc
IO_UDP_ListenSocket_close_impl_v1 -> (ListenSocket -> IO ()) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF ((ListenSocket -> IO ()) -> Args -> Stack -> IO Stack)
-> (ListenSocket -> IO ()) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(ListenSocket
sock :: ListenSocket) -> ListenSocket -> IO ()
UDP.stop ListenSocket
sock
  ForeignFunc
IO_UDP_UDPSocket_toText_impl_v1 -> (UDPSocket -> IO String) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((UDPSocket -> IO String) -> Args -> Stack -> IO Stack)
-> (UDPSocket -> IO String) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(UDPSocket
sock :: UDPSocket) -> String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ UDPSocket -> String
forall a. Show a => a -> String
show UDPSocket
sock
  ForeignFunc
IO_UDP_serverSocket_impl_v1 -> ((Text, Text) -> IO ListenSocket) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF (((Text, Text) -> IO ListenSocket) -> Args -> Stack -> IO Stack)
-> ((Text, Text) -> IO ListenSocket) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(Text
ip :: Util.Text.Text, Text
port :: Util.Text.Text) ->
      let maybeIp :: Maybe IP
maybeIp = String -> Maybe IP
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe IP) -> String -> Maybe IP
forall a b. (a -> b) -> a -> b
$ Text -> String
Util.Text.toString Text
ip :: Maybe IP
          maybePort :: Maybe PortNumber
maybePort = String -> Maybe PortNumber
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe PortNumber) -> String -> Maybe PortNumber
forall a b. (a -> b) -> a -> b
$ Text -> String
Util.Text.toString Text
port :: Maybe PortNumber
       in case (Maybe IP
maybeIp, Maybe PortNumber
maybePort) of
            (Maybe IP
Nothing, Maybe PortNumber
_) -> String -> IO ListenSocket
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid IP Address"
            (Maybe IP
_, Maybe PortNumber
Nothing) -> String -> IO ListenSocket
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid Port Number"
            (Just IP
ip, Just PortNumber
pt) -> (IP, PortNumber) -> IO ListenSocket
UDP.serverSocket (IP
ip, PortNumber
pt)
  ForeignFunc
IO_UDP_ListenSocket_toText_impl_v1 -> (ListenSocket -> IO String) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((ListenSocket -> IO String) -> Args -> Stack -> IO Stack)
-> (ListenSocket -> IO String) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(ListenSocket
sock :: ListenSocket) -> String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ ListenSocket -> String
forall a. Show a => a -> String
show ListenSocket
sock
  ForeignFunc
IO_UDP_ListenSocket_recvFrom_impl_v1 ->
    (ListenSocket -> IO (Bytes, ClientSockAddr))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF ((ListenSocket -> IO (Bytes, ClientSockAddr))
 -> Args -> Stack -> IO Stack)
-> (ListenSocket -> IO (Bytes, ClientSockAddr))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
      ((ByteString, ClientSockAddr) -> (Bytes, ClientSockAddr))
-> IO (ByteString, ClientSockAddr) -> IO (Bytes, ClientSockAddr)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ByteString -> Bytes)
-> (ByteString, ClientSockAddr) -> (Bytes, ClientSockAddr)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ByteString -> Bytes
forall b. ByteArrayAccess b => b -> Bytes
Bytes.fromArray) (IO (ByteString, ClientSockAddr) -> IO (Bytes, ClientSockAddr))
-> (ListenSocket -> IO (ByteString, ClientSockAddr))
-> ListenSocket
-> IO (Bytes, ClientSockAddr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ListenSocket -> IO (ByteString, ClientSockAddr)
UDP.recvFrom
  ForeignFunc
IO_UDP_ClientSockAddr_toText_v1 -> (ClientSockAddr -> IO String) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((ClientSockAddr -> IO String) -> Args -> Stack -> IO Stack)
-> (ClientSockAddr -> IO String) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(ClientSockAddr
sock :: ClientSockAddr) -> String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ ClientSockAddr -> String
forall a. Show a => a -> String
show ClientSockAddr
sock
  ForeignFunc
IO_UDP_ListenSocket_sendTo_impl_v1 -> ((ListenSocket, Bytes, ClientSockAddr) -> IO ())
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF (((ListenSocket, Bytes, ClientSockAddr) -> IO ())
 -> Args -> Stack -> IO Stack)
-> ((ListenSocket, Bytes, ClientSockAddr) -> IO ())
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(ListenSocket
socket :: ListenSocket, Bytes
bytes :: Bytes.Bytes, ClientSockAddr
addr :: ClientSockAddr) ->
      ListenSocket -> ByteString -> ClientSockAddr -> IO ()
UDP.sendTo ListenSocket
socket (Bytes -> ByteString
forall b. ByteArray b => Bytes -> b
Bytes.toArray Bytes
bytes) ClientSockAddr
addr
  ForeignFunc
IO_openFile_impl_v3 -> ((Text, Int) -> IO Handle) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF (((Text, Int) -> IO Handle) -> Args -> Stack -> IO Stack)
-> ((Text, Int) -> IO Handle) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ \(Text
fnameText :: Util.Text.Text, Int
n :: Int) ->
    let fname :: String
fname = Text -> String
Util.Text.toString Text
fnameText
        mode :: IOMode
mode = case Int
n of
          Int
0 -> IOMode
ReadMode
          Int
1 -> IOMode
WriteMode
          Int
2 -> IOMode
AppendMode
          Int
_ -> IOMode
ReadWriteMode
     in String -> IOMode -> IO Handle
openFile String
fname IOMode
mode
  ForeignFunc
IO_closeFile_impl_v3 -> (Handle -> IO ()) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF Handle -> IO ()
hClose
  ForeignFunc
IO_isFileEOF_impl_v3 -> (Handle -> IO Bool) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF Handle -> IO Bool
hIsEOF
  ForeignFunc
IO_isFileOpen_impl_v3 -> (Handle -> IO Bool) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF Handle -> IO Bool
hIsOpen
  ForeignFunc
IO_getEcho_impl_v1 -> (Handle -> IO Bool) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF Handle -> IO Bool
hGetEcho
  ForeignFunc
IO_ready_impl_v1 -> (Handle -> IO Bool) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF Handle -> IO Bool
hReady
  ForeignFunc
IO_getChar_impl_v1 -> (Handle -> IO Char) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF Handle -> IO Char
hGetChar
  ForeignFunc
IO_isSeekable_impl_v3 -> (Handle -> IO Bool) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF Handle -> IO Bool
hIsSeekable
  ForeignFunc
IO_seekHandle_impl_v3 -> ((Handle, SeekMode, Int) -> IO ()) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF (((Handle, SeekMode, Int) -> IO ()) -> Args -> Stack -> IO Stack)
-> ((Handle, SeekMode, Int) -> IO ()) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(Handle
h, SeekMode
sm, Int
n) -> Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
h SeekMode
sm (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
n :: Int))
  ForeignFunc
IO_handlePosition_impl_v3 ->
    -- TODO: truncating integer
    (Handle -> IO ConstructorId) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF ((Handle -> IO ConstructorId) -> Args -> Stack -> IO Stack)
-> (Handle -> IO ConstructorId) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
      \Handle
h -> forall a. Num a => Integer -> a
fromInteger @Word64 (Integer -> ConstructorId) -> IO Integer -> IO ConstructorId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO Integer
hTell Handle
h
  ForeignFunc
IO_getBuffering_impl_v3 -> (Handle -> IO BufferMode) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF Handle -> IO BufferMode
hGetBuffering
  ForeignFunc
IO_setBuffering_impl_v3 ->
    ((Handle, BufferMode) -> IO ()) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF (((Handle, BufferMode) -> IO ()) -> Args -> Stack -> IO Stack)
-> ((Handle, BufferMode) -> IO ()) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
      (Handle -> BufferMode -> IO ()) -> (Handle, BufferMode) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Handle -> BufferMode -> IO ()
hSetBuffering
  ForeignFunc
IO_setEcho_impl_v1 -> ((Handle, Bool) -> IO ()) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF (((Handle, Bool) -> IO ()) -> Args -> Stack -> IO Stack)
-> ((Handle, Bool) -> IO ()) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ (Handle -> Bool -> IO ()) -> (Handle, Bool) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Handle -> Bool -> IO ()
hSetEcho
  ForeignFunc
IO_getLine_impl_v1 ->
    (Handle -> IO Text) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF ((Handle -> IO Text) -> Args -> Stack -> IO Stack)
-> (Handle -> IO Text) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
      (Text -> Text) -> IO Text -> IO Text
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
Util.Text.fromText (IO Text -> IO Text) -> (Handle -> IO Text) -> Handle -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO Text
Text.IO.hGetLine
  ForeignFunc
IO_getBytes_impl_v3 -> ((Handle, Int) -> IO Bytes) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF (((Handle, Int) -> IO Bytes) -> Args -> Stack -> IO Stack)
-> ((Handle, Int) -> IO Bytes) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(Handle
h, Int
n) -> ByteString -> Bytes
forall b. ByteArrayAccess b => b -> Bytes
Bytes.fromArray (ByteString -> Bytes) -> IO ByteString -> IO Bytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> Int -> IO ByteString
hGet Handle
h Int
n
  ForeignFunc
IO_getSomeBytes_impl_v1 -> ((Handle, Int) -> IO Bytes) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF (((Handle, Int) -> IO Bytes) -> Args -> Stack -> IO Stack)
-> ((Handle, Int) -> IO Bytes) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(Handle
h, Int
n) -> ByteString -> Bytes
forall b. ByteArrayAccess b => b -> Bytes
Bytes.fromArray (ByteString -> Bytes) -> IO ByteString -> IO Bytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> Int -> IO ByteString
hGetSome Handle
h Int
n
  ForeignFunc
IO_putBytes_impl_v3 -> ((Handle, Bytes) -> IO ()) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF (((Handle, Bytes) -> IO ()) -> Args -> Stack -> IO Stack)
-> ((Handle, Bytes) -> IO ()) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ \(Handle
h, Bytes
bs) -> Handle -> ByteString -> IO ()
hPut Handle
h (Bytes -> ByteString
forall b. ByteArray b => Bytes -> b
Bytes.toArray Bytes
bs)
  ForeignFunc
IO_systemTime_impl_v3 -> (() -> IO POSIXTime) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF ((() -> IO POSIXTime) -> Args -> Stack -> IO Stack)
-> (() -> IO POSIXTime) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \() -> IO POSIXTime
getPOSIXTime
  ForeignFunc
IO_systemTimeMicroseconds_v1 -> (() -> IO POSIXTime) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((() -> IO POSIXTime) -> Args -> Stack -> IO Stack)
-> (() -> IO POSIXTime) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \() -> (POSIXTime -> POSIXTime) -> IO POSIXTime -> IO POSIXTime
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (POSIXTime
1e6 POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
*) IO POSIXTime
getPOSIXTime
  ForeignFunc
Clock_internals_monotonic_v1 -> (() -> IO TimeSpec) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF ((() -> IO TimeSpec) -> Args -> Stack -> IO Stack)
-> (() -> IO TimeSpec) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \() -> Clock -> IO TimeSpec
getTime Clock
Monotonic
  ForeignFunc
Clock_internals_realtime_v1 -> (() -> IO TimeSpec) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF ((() -> IO TimeSpec) -> Args -> Stack -> IO Stack)
-> (() -> IO TimeSpec) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \() -> Clock -> IO TimeSpec
getTime Clock
Realtime
  ForeignFunc
Clock_internals_processCPUTime_v1 -> (() -> IO TimeSpec) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF ((() -> IO TimeSpec) -> Args -> Stack -> IO Stack)
-> (() -> IO TimeSpec) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \() -> Clock -> IO TimeSpec
getTime Clock
ProcessCPUTime
  ForeignFunc
Clock_internals_threadCPUTime_v1 -> (() -> IO TimeSpec) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF ((() -> IO TimeSpec) -> Args -> Stack -> IO Stack)
-> (() -> IO TimeSpec) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \() -> Clock -> IO TimeSpec
getTime Clock
ThreadCPUTime
  ForeignFunc
Clock_internals_sec_v1 -> (TimeSpec -> IO ConstructorId) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (\TimeSpec
n -> ConstructorId -> IO ConstructorId
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64 -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> ConstructorId) -> Int64 -> ConstructorId
forall a b. (a -> b) -> a -> b
$ TimeSpec -> Int64
sec TimeSpec
n :: Word64))
  ForeignFunc
Clock_internals_nsec_v1 -> (TimeSpec -> IO ConstructorId) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (\TimeSpec
n -> ConstructorId -> IO ConstructorId
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64 -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> ConstructorId) -> Int64 -> ConstructorId
forall a b. (a -> b) -> a -> b
$ TimeSpec -> Int64
nsec TimeSpec
n :: Word64))
  ForeignFunc
Clock_internals_systemTimeZone_v1 ->
    (Int -> IO (Int, Bool, String)) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign
      ( \Int
secs -> do
          TimeZone Int
offset Bool
summer String
name <- UTCTime -> IO TimeZone
getTimeZone (POSIXTime -> UTCTime
posixSecondsToUTCTime (Int -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
secs :: Int)))
          (Int, Bool, String) -> IO (Int, Bool, String)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
offset :: Int, Bool
summer, String
name)
      )
  ForeignFunc
IO_getTempDirectory_impl_v3 ->
    (() -> IO String) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF ((() -> IO String) -> Args -> Stack -> IO Stack)
-> (() -> IO String) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
      \() -> String -> String
chop (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
getTemporaryDirectory
  ForeignFunc
IO_createTempDirectory_impl_v3 -> (String -> IO String) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF ((String -> IO String) -> Args -> Stack -> IO Stack)
-> (String -> IO String) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ \String
prefix -> do
    String
temp <- IO String
getTemporaryDirectory
    String -> String
chop (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> IO String
createTempDirectory String
temp String
prefix
  ForeignFunc
IO_getCurrentDirectory_impl_v3 -> (() -> IO String) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF ((() -> IO String) -> Args -> Stack -> IO Stack)
-> (() -> IO String) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \() -> IO String
getCurrentDirectory
  ForeignFunc
IO_setCurrentDirectory_impl_v3 -> (String -> IO ()) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF String -> IO ()
setCurrentDirectory
  ForeignFunc
IO_fileExists_impl_v3 -> (String -> IO Bool) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF String -> IO Bool
doesPathExist
  ForeignFunc
IO_getEnv_impl_v1 -> (String -> IO String) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF String -> IO String
getEnv
  ForeignFunc
IO_getArgs_impl_v1 -> (() -> IO [Text]) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF ((() -> IO [Text]) -> Args -> Stack -> IO Stack)
-> (() -> IO [Text]) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \() -> (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
Util.Text.pack ([String] -> [Text]) -> IO [String] -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [String]
SYS.getArgs
  ForeignFunc
IO_isDirectory_impl_v3 -> (String -> IO Bool) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF String -> IO Bool
doesDirectoryExist
  ForeignFunc
IO_createDirectory_impl_v3 ->
    (String -> IO ()) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF ((String -> IO ()) -> Args -> Stack -> IO Stack)
-> (String -> IO ()) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
      Bool -> String -> IO ()
createDirectoryIfMissing Bool
True
  ForeignFunc
IO_removeDirectory_impl_v3 -> (String -> IO ()) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF String -> IO ()
removeDirectoryRecursive
  ForeignFunc
IO_renameDirectory_impl_v3 ->
    ((String, String) -> IO ()) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF (((String, String) -> IO ()) -> Args -> Stack -> IO Stack)
-> ((String, String) -> IO ()) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
      (String -> String -> IO ()) -> (String, String) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> String -> IO ()
renameDirectory
  ForeignFunc
IO_directoryContents_impl_v3 ->
    (String -> IO [Text]) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF ((String -> IO [Text]) -> Args -> Stack -> IO Stack)
-> (String -> IO [Text]) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
      ((String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
Util.Text.pack ([String] -> [Text]) -> IO [String] -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (IO [String] -> IO [Text])
-> (String -> IO [String]) -> String -> IO [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO [String]
getDirectoryContents
  ForeignFunc
IO_removeFile_impl_v3 -> (String -> IO ()) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF String -> IO ()
removeFile
  ForeignFunc
IO_renameFile_impl_v3 ->
    ((String, String) -> IO ()) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF (((String, String) -> IO ()) -> Args -> Stack -> IO Stack)
-> ((String, String) -> IO ()) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
      (String -> String -> IO ()) -> (String, String) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> String -> IO ()
renameFile
  ForeignFunc
IO_getFileTimestamp_impl_v3 ->
    (String -> IO POSIXTime) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF ((String -> IO POSIXTime) -> Args -> Stack -> IO Stack)
-> (String -> IO POSIXTime) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
      (UTCTime -> POSIXTime) -> IO UTCTime -> IO POSIXTime
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UTCTime -> POSIXTime
utcTimeToPOSIXSeconds (IO UTCTime -> IO POSIXTime)
-> (String -> IO UTCTime) -> String -> IO POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO UTCTime
getModificationTime
  ForeignFunc
IO_getFileSize_impl_v3 ->
    -- TODO: truncating integer
    (String -> IO ConstructorId) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF ((String -> IO ConstructorId) -> Args -> Stack -> IO Stack)
-> (String -> IO ConstructorId) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
      \String
fp -> forall a. Num a => Integer -> a
fromInteger @Word64 (Integer -> ConstructorId) -> IO Integer -> IO ConstructorId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Integer
getFileSize String
fp
  ForeignFunc
IO_serverSocket_impl_v3 ->
    ((Maybe Text, String) -> IO Socket) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF (((Maybe Text, String) -> IO Socket) -> Args -> Stack -> IO Stack)
-> ((Maybe Text, String) -> IO Socket) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
      \( Maybe Text
mhst :: Maybe Util.Text.Text,
         String
port
         ) ->
          (Socket, SockAddr) -> Socket
forall a b. (a, b) -> a
fst ((Socket, SockAddr) -> Socket)
-> IO (Socket, SockAddr) -> IO Socket
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HostPreference -> String -> IO (Socket, SockAddr)
forall (m :: * -> *).
MonadIO m =>
HostPreference -> String -> m (Socket, SockAddr)
SYS.bindSock (Maybe Text -> HostPreference
hostPreference Maybe Text
mhst) String
port
  ForeignFunc
Socket_toText -> (Socket -> IO String) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Socket -> IO String) -> Args -> Stack -> IO Stack)
-> (Socket -> IO String) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(Socket
sock :: Socket) -> String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ Socket -> String
forall a. Show a => a -> String
show Socket
sock
  ForeignFunc
Handle_toText -> (Handle -> IO String) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Handle -> IO String) -> Args -> Stack -> IO Stack)
-> (Handle -> IO String) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(Handle
hand :: Handle) -> String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ Handle -> String
forall a. Show a => a -> String
show Handle
hand
  ForeignFunc
ThreadId_toText -> (ThreadId -> IO String) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((ThreadId -> IO String) -> Args -> Stack -> IO Stack)
-> (ThreadId -> IO String) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(ThreadId
threadId :: ThreadId) -> String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ ThreadId -> String
forall a. Show a => a -> String
show ThreadId
threadId
  ForeignFunc
IO_socketPort_impl_v3 -> (Socket -> IO ConstructorId) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF ((Socket -> IO ConstructorId) -> Args -> Stack -> IO Stack)
-> (Socket -> IO ConstructorId) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(Socket
handle :: Socket) -> do
      PortNumber
n <- Socket -> IO PortNumber
SYS.socketPort Socket
handle
      return (PortNumber -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral PortNumber
n :: Word64)
  ForeignFunc
IO_listen_impl_v3 -> (Socket -> IO ()) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF ((Socket -> IO ()) -> Args -> Stack -> IO Stack)
-> (Socket -> IO ()) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \Socket
sk -> Socket -> Int -> IO ()
forall (m :: * -> *). MonadIO m => Socket -> Int -> m ()
SYS.listenSock Socket
sk Int
2048
  ForeignFunc
IO_clientSocket_impl_v3 ->
    ((String, String) -> IO Socket) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF (((String, String) -> IO Socket) -> Args -> Stack -> IO Stack)
-> ((String, String) -> IO Socket) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
      ((Socket, SockAddr) -> Socket)
-> IO (Socket, SockAddr) -> IO Socket
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Socket, SockAddr) -> Socket
forall a b. (a, b) -> a
fst (IO (Socket, SockAddr) -> IO Socket)
-> ((String, String) -> IO (Socket, SockAddr))
-> (String, String)
-> IO Socket
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> IO (Socket, SockAddr))
-> (String, String) -> IO (Socket, SockAddr)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> String -> IO (Socket, SockAddr)
forall (m :: * -> *).
MonadIO m =>
String -> String -> m (Socket, SockAddr)
SYS.connectSock
  ForeignFunc
IO_closeSocket_impl_v3 -> (Socket -> IO ()) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF Socket -> IO ()
forall (m :: * -> *). MonadIO m => Socket -> m ()
SYS.closeSock
  ForeignFunc
IO_socketAccept_impl_v3 ->
    (Socket -> IO Socket) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF ((Socket -> IO Socket) -> Args -> Stack -> IO Stack)
-> (Socket -> IO Socket) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
      ((Socket, SockAddr) -> Socket)
-> IO (Socket, SockAddr) -> IO Socket
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Socket, SockAddr) -> Socket
forall a b. (a, b) -> a
fst (IO (Socket, SockAddr) -> IO Socket)
-> (Socket -> IO (Socket, SockAddr)) -> Socket -> IO Socket
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Socket -> IO (Socket, SockAddr)
SYS.accept
  ForeignFunc
IO_socketSend_impl_v3 -> ((Socket, Bytes) -> IO ()) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF (((Socket, Bytes) -> IO ()) -> Args -> Stack -> IO Stack)
-> ((Socket, Bytes) -> IO ()) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(Socket
sk, Bytes
bs) -> Socket -> ByteString -> IO ()
forall (m :: * -> *). MonadIO m => Socket -> ByteString -> m ()
SYS.send Socket
sk (Bytes -> ByteString
forall b. ByteArray b => Bytes -> b
Bytes.toArray Bytes
bs)
  ForeignFunc
IO_socketReceive_impl_v3 -> ((Socket, Int) -> IO Bytes) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF (((Socket, Int) -> IO Bytes) -> Args -> Stack -> IO Stack)
-> ((Socket, Int) -> IO Bytes) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(Socket
hs, Int
n) ->
      Bytes -> (ByteString -> Bytes) -> Maybe ByteString -> Bytes
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bytes
forall a. Monoid a => a
mempty ByteString -> Bytes
forall b. ByteArrayAccess b => b -> Bytes
Bytes.fromArray (Maybe ByteString -> Bytes) -> IO (Maybe ByteString) -> IO Bytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Socket -> Int -> IO (Maybe ByteString)
forall (m :: * -> *).
MonadIO m =>
Socket -> Int -> m (Maybe ByteString)
SYS.recv Socket
hs Int
n
  ForeignFunc
IO_kill_impl_v3 -> (ThreadId -> IO ()) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF ThreadId -> IO ()
killThread
  ForeignFunc
IO_delay_impl_v3 -> (ConstructorId -> IO ()) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF ConstructorId -> IO ()
customDelay
  ForeignFunc
IO_stdHandle -> (Int -> IO Handle) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Int -> IO Handle) -> Args -> Stack -> IO Stack)
-> (Int -> IO Handle) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(Int
n :: Int) -> case Int
n of
      Int
0 -> Handle -> IO Handle
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Handle
SYS.stdin
      Int
1 -> Handle -> IO Handle
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Handle
SYS.stdout
      Int
2 -> Handle -> IO Handle
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Handle
SYS.stderr
      Int
_ -> String -> IO Handle
forall a. HasCallStack => String -> IO a
die String
"IO.stdHandle: invalid input."
  ForeignFunc
IO_process_call -> ((String, [Text]) -> IO Int) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((String, [Text]) -> IO Int) -> Args -> Stack -> IO Stack)
-> ((String, [Text]) -> IO Int) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(String
exe, (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
Util.Text.unpack -> [String]
args) ->
      CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO Int)
-> IO Int
forall a.
CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
withCreateProcess (String -> [String] -> CreateProcess
proc String
exe [String]
args) ((Maybe Handle
  -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO Int)
 -> IO Int)
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO Int)
-> IO Int
forall a b. (a -> b) -> a -> b
$ \Maybe Handle
_ Maybe Handle
_ Maybe Handle
_ ProcessHandle
p ->
        ExitCode -> Int
exitDecode (ExitCode -> Int) -> IO ExitCode -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
p
  ForeignFunc
IO_process_start -> ((String, [Text]) -> IO (Handle, Handle, Handle, ProcessHandle))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((String, [Text]) -> IO (Handle, Handle, Handle, ProcessHandle))
 -> Args -> Stack -> IO Stack)
-> ((String, [Text]) -> IO (Handle, Handle, Handle, ProcessHandle))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$ \(String
exe, (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
Util.Text.unpack -> [String]
args) ->
    String
-> [String]
-> Maybe String
-> Maybe [(String, String)]
-> IO (Handle, Handle, Handle, ProcessHandle)
runInteractiveProcess String
exe [String]
args Maybe String
forall a. Maybe a
Nothing Maybe [(String, String)]
forall a. Maybe a
Nothing
  ForeignFunc
IO_process_kill -> (ProcessHandle -> IO ()) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((ProcessHandle -> IO ()) -> Args -> Stack -> IO Stack)
-> (ProcessHandle -> IO ()) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ ProcessHandle -> IO ()
terminateProcess
  ForeignFunc
IO_process_wait -> (ProcessHandle -> IO Int) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((ProcessHandle -> IO Int) -> Args -> Stack -> IO Stack)
-> (ProcessHandle -> IO Int) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \ProcessHandle
ph -> ExitCode -> Int
exitDecode (ExitCode -> Int) -> IO ExitCode -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
ph
  ForeignFunc
IO_process_exitCode ->
    (ProcessHandle -> IO (Maybe Int)) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((ProcessHandle -> IO (Maybe Int)) -> Args -> Stack -> IO Stack)
-> (ProcessHandle -> IO (Maybe Int)) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
      (Maybe ExitCode -> Maybe Int)
-> IO (Maybe ExitCode) -> IO (Maybe Int)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ExitCode -> Int) -> Maybe ExitCode -> Maybe Int
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ExitCode -> Int
exitDecode) (IO (Maybe ExitCode) -> IO (Maybe Int))
-> (ProcessHandle -> IO (Maybe ExitCode))
-> ProcessHandle
-> IO (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessHandle -> IO (Maybe ExitCode)
getProcessExitCode
  ForeignFunc
MVar_new -> (Val -> IO (MVar Val)) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Val -> IO (MVar Val)) -> Args -> Stack -> IO Stack)
-> (Val -> IO (MVar Val)) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(Val
c :: Val) -> Val -> IO (MVar Val)
forall a. a -> IO (MVar a)
newMVar Val
c
  ForeignFunc
MVar_newEmpty_v2 -> (() -> IO (MVar Val)) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((() -> IO (MVar Val)) -> Args -> Stack -> IO Stack)
-> (() -> IO (MVar Val)) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \() -> forall a. IO (MVar a)
newEmptyMVar @Val
  ForeignFunc
MVar_take_impl_v3 -> (MVar Val -> IO Val) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF ((MVar Val -> IO Val) -> Args -> Stack -> IO Stack)
-> (MVar Val -> IO Val) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(MVar Val
mv :: MVar Val) -> MVar Val -> IO Val
forall a. MVar a -> IO a
takeMVar MVar Val
mv
  ForeignFunc
MVar_tryTake -> (MVar Val -> IO (Maybe Val)) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((MVar Val -> IO (Maybe Val)) -> Args -> Stack -> IO Stack)
-> (MVar Val -> IO (Maybe Val)) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(MVar Val
mv :: MVar Val) -> MVar Val -> IO (Maybe Val)
forall a. MVar a -> IO (Maybe a)
tryTakeMVar MVar Val
mv
  ForeignFunc
MVar_put_impl_v3 -> ((MVar Val, Val) -> IO ()) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF (((MVar Val, Val) -> IO ()) -> Args -> Stack -> IO Stack)
-> ((MVar Val, Val) -> IO ()) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(MVar Val
mv :: MVar Val, Val
x) -> MVar Val -> Val -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar Val
mv Val
x
  ForeignFunc
MVar_tryPut_impl_v3 -> ((MVar Val, Val) -> IO Bool) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF (((MVar Val, Val) -> IO Bool) -> Args -> Stack -> IO Stack)
-> ((MVar Val, Val) -> IO Bool) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(MVar Val
mv :: MVar Val, Val
x) -> MVar Val -> Val -> IO Bool
forall a. MVar a -> a -> IO Bool
tryPutMVar MVar Val
mv Val
x
  ForeignFunc
MVar_swap_impl_v3 -> ((MVar Val, Val) -> IO Val) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF (((MVar Val, Val) -> IO Val) -> Args -> Stack -> IO Stack)
-> ((MVar Val, Val) -> IO Val) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(MVar Val
mv :: MVar Val, Val
x) -> MVar Val -> Val -> IO Val
forall a. MVar a -> a -> IO a
swapMVar MVar Val
mv Val
x
  ForeignFunc
MVar_isEmpty -> (MVar Val -> IO Bool) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((MVar Val -> IO Bool) -> Args -> Stack -> IO Stack)
-> (MVar Val -> IO Bool) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(MVar Val
mv :: MVar Val) -> MVar Val -> IO Bool
forall a. MVar a -> IO Bool
isEmptyMVar MVar Val
mv
  ForeignFunc
MVar_read_impl_v3 -> (MVar Val -> IO Val) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF ((MVar Val -> IO Val) -> Args -> Stack -> IO Stack)
-> (MVar Val -> IO Val) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(MVar Val
mv :: MVar Val) -> MVar Val -> IO Val
forall a. MVar a -> IO a
readMVar MVar Val
mv
  ForeignFunc
MVar_tryRead_impl_v3 -> (MVar Val -> IO (Maybe Val)) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF ((MVar Val -> IO (Maybe Val)) -> Args -> Stack -> IO Stack)
-> (MVar Val -> IO (Maybe Val)) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(MVar Val
mv :: MVar Val) -> MVar Val -> IO (Maybe Val)
forall a. MVar a -> IO (Maybe a)
tryReadMVar MVar Val
mv
  ForeignFunc
Char_toText -> (Char -> IO Text) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Char -> IO Text) -> Args -> Stack -> IO Stack)
-> (Char -> IO Text) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(Char
ch :: Char) -> Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> Text
Util.Text.singleton Char
ch)
  ForeignFunc
Text_repeat -> ((ConstructorId, Text) -> IO Text) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((ConstructorId, Text) -> IO Text) -> Args -> Stack -> IO Stack)
-> ((ConstructorId, Text) -> IO Text) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(ConstructorId
n :: Word64, Text
txt :: Util.Text.Text) -> Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Text -> Text
Util.Text.replicate (ConstructorId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
n) Text
txt)
  ForeignFunc
Text_reverse ->
    (Text -> IO Text) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Text -> IO Text) -> Args -> Stack -> IO Stack)
-> (Text -> IO Text) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
      Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> IO Text) -> (Text -> Text) -> Text -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Util.Text.reverse
  ForeignFunc
Text_toUppercase ->
    (Text -> IO Text) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Text -> IO Text) -> Args -> Stack -> IO Stack)
-> (Text -> IO Text) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
      Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> IO Text) -> (Text -> Text) -> Text -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Util.Text.toUppercase
  ForeignFunc
Text_toLowercase ->
    (Text -> IO Text) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Text -> IO Text) -> Args -> Stack -> IO Stack)
-> (Text -> IO Text) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
      Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> IO Text) -> (Text -> Text) -> Text -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Util.Text.toLowercase
  ForeignFunc
Text_toUtf8 ->
    (Text -> IO Bytes) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Text -> IO Bytes) -> Args -> Stack -> IO Stack)
-> (Text -> IO Bytes) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
      Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> IO Bytes) -> (Text -> Bytes) -> Text -> IO Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bytes
Util.Text.toUtf8
  ForeignFunc
Text_fromUtf8_impl_v3 ->
    (Bytes -> IO (Either (Failure Val) Text))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Bytes -> IO (Either (Failure Val) Text))
 -> Args -> Stack -> IO Stack)
-> (Bytes -> IO (Either (Failure Val) Text))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
      Either (Failure Val) Text -> IO (Either (Failure Val) Text)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Failure Val) Text -> IO (Either (Failure Val) Text))
-> (Bytes -> Either (Failure Val) Text)
-> Bytes
-> IO (Either (Failure Val) Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Failure Val)
-> Either String Text -> Either (Failure Val) Text
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft (\String
t -> Reference -> Text -> Val -> Failure Val
forall a. Reference -> Text -> a -> Failure a
F.Failure Reference
Ty.ioFailureRef (String -> Text
Util.Text.pack String
t) Val
unitValue) (Either String Text -> Either (Failure Val) Text)
-> (Bytes -> Either String Text)
-> Bytes
-> Either (Failure Val) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Either String Text
Util.Text.fromUtf8
  ForeignFunc
Tls_ClientConfig_default -> ((Text, Bytes) -> IO ClientParams) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((Text, Bytes) -> IO ClientParams) -> Args -> Stack -> IO Stack)
-> ((Text, Bytes) -> IO ClientParams) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(Text
hostName :: Util.Text.Text, Bytes
serverId :: Bytes.Bytes) ->
      (CertificateStore -> ClientParams)
-> IO CertificateStore -> IO ClientParams
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
        ( \CertificateStore
store ->
            (String -> ByteString -> ClientParams
defaultParamsClient (Text -> String
Util.Text.unpack Text
hostName) (Bytes -> ByteString
forall b. ByteArray b => Bytes -> b
Bytes.toArray Bytes
serverId))
              { TLS.clientSupported = def {TLS.supportedCiphers = Cipher.ciphersuite_strong},
                TLS.clientShared = def {TLS.sharedCAStore = store}
              }
        )
        IO CertificateStore
X.getSystemCertificateStore
  ForeignFunc
Tls_ServerConfig_default ->
    (([SignedCertificate], PrivKey) -> IO ServerParams)
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((([SignedCertificate], PrivKey) -> IO ServerParams)
 -> Args -> Stack -> IO Stack)
-> (([SignedCertificate], PrivKey) -> IO ServerParams)
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
      \([SignedCertificate]
certs :: [X.SignedCertificate], PrivKey
key :: X.PrivKey) ->
        ServerParams -> IO ServerParams
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ServerParams -> IO ServerParams)
-> ServerParams -> IO ServerParams
forall a b. (a -> b) -> a -> b
$
          (ServerParams
forall a. Default a => a
def :: TLS.ServerParams)
            { TLS.serverSupported = def {TLS.supportedCiphers = Cipher.ciphersuite_strong},
              TLS.serverShared = def {TLS.sharedCredentials = Credentials [(X.CertificateChain certs, key)]}
            }
  ForeignFunc
Tls_ClientConfig_certificates_set ->
    let updateClient :: X.CertificateStore -> TLS.ClientParams -> TLS.ClientParams
        updateClient :: CertificateStore -> ClientParams -> ClientParams
updateClient CertificateStore
certs ClientParams
client = ClientParams
client {TLS.clientShared = ((clientShared client) {TLS.sharedCAStore = certs})}
     in (([SignedCertificate], ClientParams) -> IO ClientParams)
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((([SignedCertificate], ClientParams) -> IO ClientParams)
 -> Args -> Stack -> IO Stack)
-> (([SignedCertificate], ClientParams) -> IO ClientParams)
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
          \([SignedCertificate]
certs :: [X.SignedCertificate], ClientParams
params :: ClientParams) -> ClientParams -> IO ClientParams
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientParams -> IO ClientParams)
-> ClientParams -> IO ClientParams
forall a b. (a -> b) -> a -> b
$ CertificateStore -> ClientParams -> ClientParams
updateClient ([SignedCertificate] -> CertificateStore
X.makeCertificateStore [SignedCertificate]
certs) ClientParams
params
  ForeignFunc
Tls_ServerConfig_certificates_set ->
    let updateServer :: X.CertificateStore -> TLS.ServerParams -> TLS.ServerParams
        updateServer :: CertificateStore -> ServerParams -> ServerParams
updateServer CertificateStore
certs ServerParams
client = ServerParams
client {TLS.serverShared = ((serverShared client) {TLS.sharedCAStore = certs})}
     in (([SignedCertificate], ServerParams) -> IO ServerParams)
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((([SignedCertificate], ServerParams) -> IO ServerParams)
 -> Args -> Stack -> IO Stack)
-> (([SignedCertificate], ServerParams) -> IO ServerParams)
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
          \([SignedCertificate]
certs :: [X.SignedCertificate], ServerParams
params :: ServerParams) -> ServerParams -> IO ServerParams
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ServerParams -> IO ServerParams)
-> ServerParams -> IO ServerParams
forall a b. (a -> b) -> a -> b
$ CertificateStore -> ServerParams -> ServerParams
updateServer ([SignedCertificate] -> CertificateStore
X.makeCertificateStore [SignedCertificate]
certs) ServerParams
params
  ForeignFunc
TVar_new -> (Val -> IO (TVar Val)) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Val -> IO (TVar Val)) -> Args -> Stack -> IO Stack)
-> (Val -> IO (TVar Val)) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(Val
c :: Val) -> STM (TVar Val) -> IO (TVar Val)
forall a. STM a -> IO a
unsafeSTMToIO (STM (TVar Val) -> IO (TVar Val))
-> STM (TVar Val) -> IO (TVar Val)
forall a b. (a -> b) -> a -> b
$ Val -> STM (TVar Val)
forall a. a -> STM (TVar a)
STM.newTVar Val
c
  ForeignFunc
TVar_read -> (TVar Val -> IO Val) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((TVar Val -> IO Val) -> Args -> Stack -> IO Stack)
-> (TVar Val -> IO Val) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(TVar Val
v :: STM.TVar Val) -> STM Val -> IO Val
forall a. STM a -> IO a
unsafeSTMToIO (STM Val -> IO Val) -> STM Val -> IO Val
forall a b. (a -> b) -> a -> b
$ TVar Val -> STM Val
forall a. TVar a -> STM a
STM.readTVar TVar Val
v
  ForeignFunc
TVar_write -> ((TVar Val, Val) -> IO ()) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((TVar Val, Val) -> IO ()) -> Args -> Stack -> IO Stack)
-> ((TVar Val, Val) -> IO ()) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(TVar Val
v :: STM.TVar Val, Val
c :: Val) ->
      STM () -> IO ()
forall a. STM a -> IO a
unsafeSTMToIO (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar Val -> Val -> STM ()
forall a. TVar a -> a -> STM ()
STM.writeTVar TVar Val
v Val
c
  ForeignFunc
TVar_newIO -> (Val -> IO (TVar Val)) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Val -> IO (TVar Val)) -> Args -> Stack -> IO Stack)
-> (Val -> IO (TVar Val)) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(Val
c :: Val) -> Val -> IO (TVar Val)
forall a. a -> IO (TVar a)
STM.newTVarIO Val
c
  ForeignFunc
TVar_readIO -> (TVar Val -> IO Val) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((TVar Val -> IO Val) -> Args -> Stack -> IO Stack)
-> (TVar Val -> IO Val) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(TVar Val
v :: STM.TVar Val) -> TVar Val -> IO Val
forall a. TVar a -> IO a
STM.readTVarIO TVar Val
v
  ForeignFunc
TVar_swap -> ((TVar Val, Val) -> IO Val) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((TVar Val, Val) -> IO Val) -> Args -> Stack -> IO Stack)
-> ((TVar Val, Val) -> IO Val) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(TVar Val
v, Val
c :: Val) -> STM Val -> IO Val
forall a. STM a -> IO a
unsafeSTMToIO (STM Val -> IO Val) -> STM Val -> IO Val
forall a b. (a -> b) -> a -> b
$ TVar Val -> Val -> STM Val
forall a. TVar a -> a -> STM a
STM.swapTVar TVar Val
v Val
c
  ForeignFunc
STM_retry -> (() -> IO Val) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((() -> IO Val) -> Args -> Stack -> IO Stack)
-> (() -> IO Val) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \() -> STM Val -> IO Val
forall a. STM a -> IO a
unsafeSTMToIO STM Val
forall a. STM a
STM.retry :: IO Val
  ForeignFunc
Promise_new -> (() -> IO (Promise Val)) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((() -> IO (Promise Val)) -> Args -> Stack -> IO Stack)
-> (() -> IO (Promise Val)) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \() -> forall a. IO (Promise a)
newPromise @Val
  ForeignFunc
Promise_read -> (Promise Val -> IO Val) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Promise Val -> IO Val) -> Args -> Stack -> IO Stack)
-> (Promise Val -> IO Val) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(Promise Val
p :: Promise Val) -> Promise Val -> IO Val
forall a. Promise a -> IO a
readPromise Promise Val
p
  ForeignFunc
Promise_tryRead -> (Promise Val -> IO (Maybe Val)) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Promise Val -> IO (Maybe Val)) -> Args -> Stack -> IO Stack)
-> (Promise Val -> IO (Maybe Val)) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(Promise Val
p :: Promise Val) -> Promise Val -> IO (Maybe Val)
forall a. Promise a -> IO (Maybe a)
tryReadPromise Promise Val
p
  ForeignFunc
Promise_write -> ((Promise Val, Val) -> IO Bool) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((Promise Val, Val) -> IO Bool) -> Args -> Stack -> IO Stack)
-> ((Promise Val, Val) -> IO Bool) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(Promise Val
p :: Promise Val, Val
a :: Val) -> Promise Val -> Val -> IO Bool
forall a. Promise a -> a -> IO Bool
writePromise Promise Val
p Val
a
  ForeignFunc
Tls_newClient_impl_v3 ->
    ((ClientParams, Socket) -> IO Context) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignTls (((ClientParams, Socket) -> IO Context)
 -> Args -> Stack -> IO Stack)
-> ((ClientParams, Socket) -> IO Context)
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
      \( ClientParams
config :: TLS.ClientParams,
         Socket
socket :: SYS.Socket
         ) -> Socket -> ClientParams -> IO Context
forall (m :: * -> *) backend params.
(MonadIO m, HasBackend backend, TLSParams params) =>
backend -> params -> m Context
TLS.contextNew Socket
socket ClientParams
config
  ForeignFunc
Tls_newServer_impl_v3 ->
    ((ServerParams, Socket) -> IO Context) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignTls (((ServerParams, Socket) -> IO Context)
 -> Args -> Stack -> IO Stack)
-> ((ServerParams, Socket) -> IO Context)
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
      \( ServerParams
config :: TLS.ServerParams,
         Socket
socket :: SYS.Socket
         ) -> Socket -> ServerParams -> IO Context
forall (m :: * -> *) backend params.
(MonadIO m, HasBackend backend, TLSParams params) =>
backend -> params -> m Context
TLS.contextNew Socket
socket ServerParams
config
  ForeignFunc
Tls_handshake_impl_v3 -> (Context -> IO ()) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignTls ((Context -> IO ()) -> Args -> Stack -> IO Stack)
-> (Context -> IO ()) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(Context
tls :: TLS.Context) -> Context -> IO ()
forall (m :: * -> *). MonadIO m => Context -> m ()
TLS.handshake Context
tls
  ForeignFunc
Tls_send_impl_v3 ->
    ((Context, Bytes) -> IO ()) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignTls (((Context, Bytes) -> IO ()) -> Args -> Stack -> IO Stack)
-> ((Context, Bytes) -> IO ()) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
      \( Context
tls :: TLS.Context,
         Bytes
bytes :: Bytes.Bytes
         ) -> Context -> ByteString -> IO ()
forall (m :: * -> *). MonadIO m => Context -> ByteString -> m ()
TLS.sendData Context
tls (Bytes -> ByteString
Bytes.toLazyByteString Bytes
bytes)
  ForeignFunc
Tls_decodeCert_impl_v3 ->
    let wrapFailure :: String -> Failure Val
wrapFailure String
t = Reference -> Text -> Val -> Failure Val
forall a. Reference -> Text -> a -> Failure a
F.Failure Reference
Ty.tlsFailureRef (String -> Text
Util.Text.pack String
t) Val
unitValue
        decoded :: Bytes.Bytes -> Either String PEM
        decoded :: Bytes -> Either String PEM
decoded Bytes
bytes = case ByteString -> Either String [PEM]
pemParseLBS (ByteString -> Either String [PEM])
-> ByteString -> Either String [PEM]
forall a b. (a -> b) -> a -> b
$ Bytes -> ByteString
Bytes.toLazyByteString Bytes
bytes of
          Right (PEM
pem : [PEM]
_) -> PEM -> Either String PEM
forall a b. b -> Either a b
Right PEM
pem
          Right [] -> String -> Either String PEM
forall a b. a -> Either a b
Left String
"no PEM found"
          Left String
l -> String -> Either String PEM
forall a b. a -> Either a b
Left String
l
        asCert :: PEM -> Either String X.SignedCertificate
        asCert :: PEM -> Either String SignedCertificate
asCert PEM
pem = ByteString -> Either String SignedCertificate
X.decodeSignedCertificate (ByteString -> Either String SignedCertificate)
-> ByteString -> Either String SignedCertificate
forall a b. (a -> b) -> a -> b
$ PEM -> ByteString
pemContent PEM
pem
     in (Bytes -> IO (Either (Failure Val) SignedCertificate))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO (Either (Failure Val) r)) -> Args -> Stack -> IO Stack
mkForeignTlsE ((Bytes -> IO (Either (Failure Val) SignedCertificate))
 -> Args -> Stack -> IO Stack)
-> (Bytes -> IO (Either (Failure Val) SignedCertificate))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
          \(Bytes
bytes :: Bytes.Bytes) -> Either (Failure Val) SignedCertificate
-> IO (Either (Failure Val) SignedCertificate)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Failure Val) SignedCertificate
 -> IO (Either (Failure Val) SignedCertificate))
-> Either (Failure Val) SignedCertificate
-> IO (Either (Failure Val) SignedCertificate)
forall a b. (a -> b) -> a -> b
$ (String -> Failure Val)
-> Either String SignedCertificate
-> Either (Failure Val) SignedCertificate
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft String -> Failure Val
wrapFailure (Either String SignedCertificate
 -> Either (Failure Val) SignedCertificate)
-> Either String SignedCertificate
-> Either (Failure Val) SignedCertificate
forall a b. (a -> b) -> a -> b
$ (Bytes -> Either String PEM
decoded (Bytes -> Either String PEM)
-> (PEM -> Either String SignedCertificate)
-> Bytes
-> Either String SignedCertificate
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> PEM -> Either String SignedCertificate
asCert) Bytes
bytes
  ForeignFunc
Tls_encodeCert -> (SignedCertificate -> IO Bytes) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((SignedCertificate -> IO Bytes) -> Args -> Stack -> IO Stack)
-> (SignedCertificate -> IO Bytes) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(SignedCertificate
cert :: X.SignedCertificate) -> Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> IO Bytes) -> Bytes -> IO Bytes
forall a b. (a -> b) -> a -> b
$ ByteString -> Bytes
forall b. ByteArrayAccess b => b -> Bytes
Bytes.fromArray (ByteString -> Bytes) -> ByteString -> Bytes
forall a b. (a -> b) -> a -> b
$ SignedCertificate -> ByteString
forall a.
(Show a, Eq a, ASN1Object a) =>
SignedExact a -> ByteString
X.encodeSignedObject SignedCertificate
cert
  ForeignFunc
Tls_decodePrivateKey -> (Bytes -> IO [PrivKey]) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Bytes -> IO [PrivKey]) -> Args -> Stack -> IO Stack)
-> (Bytes -> IO [PrivKey]) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(Bytes
bytes :: Bytes.Bytes) -> [PrivKey] -> IO [PrivKey]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([PrivKey] -> IO [PrivKey]) -> [PrivKey] -> IO [PrivKey]
forall a b. (a -> b) -> a -> b
$ ByteString -> [PrivKey]
X.readKeyFileFromMemory (ByteString -> [PrivKey]) -> ByteString -> [PrivKey]
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
L.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Bytes -> ByteString
Bytes.toLazyByteString Bytes
bytes
  ForeignFunc
Tls_encodePrivateKey -> (PrivKey -> IO Bytes) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((PrivKey -> IO Bytes) -> Args -> Stack -> IO Stack)
-> (PrivKey -> IO Bytes) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(PrivKey
privateKey :: X.PrivKey) -> Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> IO Bytes) -> Bytes -> IO Bytes
forall a b. (a -> b) -> a -> b
$ Text -> Bytes
Util.Text.toUtf8 (Text -> Bytes) -> Text -> Bytes
forall a b. (a -> b) -> a -> b
$ String -> Text
Util.Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ PrivKey -> String
forall a. Show a => a -> String
show PrivKey
privateKey
  ForeignFunc
Tls_receive_impl_v3 -> (Context -> IO Bytes) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignTls ((Context -> IO Bytes) -> Args -> Stack -> IO Stack)
-> (Context -> IO Bytes) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(Context
tls :: TLS.Context) -> do
      ByteString
bs <- Context -> IO ByteString
forall (m :: * -> *). MonadIO m => Context -> m ByteString
TLS.recvData Context
tls
      pure $ ByteString -> Bytes
forall b. ByteArrayAccess b => b -> Bytes
Bytes.fromArray ByteString
bs
  ForeignFunc
Tls_terminate_impl_v3 -> (Context -> IO ()) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignTls ((Context -> IO ()) -> Args -> Stack -> IO Stack)
-> (Context -> IO ()) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(Context
tls :: TLS.Context) -> Context -> IO ()
forall (m :: * -> *). MonadIO m => Context -> m ()
TLS.bye Context
tls
  ForeignFunc
Code_validateLinks -> ([(Referent, Code)]
 -> IO (Either (Failure [Referent]) (Either [Referent] [Referent])))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (([(Referent, Code)]
  -> IO (Either (Failure [Referent]) (Either [Referent] [Referent])))
 -> Args -> Stack -> IO Stack)
-> ([(Referent, Code)]
    -> IO (Either (Failure [Referent]) (Either [Referent] [Referent])))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
    \([(Referent, Code)]
lsgs0 :: [(Referent, ANF.Code)]) -> do
      let f :: (Text, a) -> Failure a
f (Text
msg, a
rs) =
            Reference -> Text -> a -> Failure a
forall a. Reference -> Text -> a -> Failure a
F.Failure Reference
Ty.miscFailureRef (Text -> Text
Util.Text.fromText Text
msg) a
rs
      Either (Failure [Referent]) (Either [Referent] [Referent])
-> IO (Either (Failure [Referent]) (Either [Referent] [Referent]))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Failure [Referent]) (Either [Referent] [Referent])
 -> IO (Either (Failure [Referent]) (Either [Referent] [Referent])))
-> (Either (Text, [Referent]) (Either [Referent] [Referent])
    -> Either (Failure [Referent]) (Either [Referent] [Referent]))
-> Either (Text, [Referent]) (Either [Referent] [Referent])
-> IO (Either (Failure [Referent]) (Either [Referent] [Referent]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, [Referent]) -> Failure [Referent])
-> Either (Text, [Referent]) (Either [Referent] [Referent])
-> Either (Failure [Referent]) (Either [Referent] [Referent])
forall a c b. (a -> c) -> Either a b -> Either c b
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text, [Referent]) -> Failure [Referent]
forall {a}. (Text, a) -> Failure a
f (Either (Text, [Referent]) (Either [Referent] [Referent])
 -> IO (Either (Failure [Referent]) (Either [Referent] [Referent])))
-> Either (Text, [Referent]) (Either [Referent] [Referent])
-> IO (Either (Failure [Referent]) (Either [Referent] [Referent]))
forall a b. (a -> b) -> a -> b
$ [(Referent, Code)]
-> Either (Text, [Referent]) (Either [Referent] [Referent])
checkGroupHashes [(Referent, Code)]
lsgs0
  ForeignFunc
Code_dependencies -> (Code -> IO [Foreign]) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Code -> IO [Foreign]) -> Args -> Stack -> IO Stack)
-> (Code -> IO [Foreign]) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(ANF.CodeRep SuperGroup Symbol
sg Cacheability
_) ->
      [Foreign] -> IO [Foreign]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Foreign] -> IO [Foreign]) -> [Foreign] -> IO [Foreign]
forall a b. (a -> b) -> a -> b
$ Reference -> Referent -> Foreign
forall e. Reference -> e -> Foreign
Wrap Reference
Ty.termLinkRef (Referent -> Foreign)
-> (Reference -> Referent) -> Reference -> Foreign
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> Referent
Ref (Reference -> Foreign) -> [Reference] -> [Foreign]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SuperGroup Symbol -> [Reference]
forall v. Var v => SuperGroup v -> [Reference]
ANF.groupTermLinks SuperGroup Symbol
sg
  ForeignFunc
Code_serialize -> (Code -> IO Bytes) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Code -> IO Bytes) -> Args -> Stack -> IO Stack)
-> (Code -> IO Bytes) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(Code
co :: ANF.Code) ->
      Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> IO Bytes)
-> (ByteString -> Bytes) -> ByteString -> IO Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bytes
forall b. ByteArrayAccess b => b -> Bytes
Bytes.fromArray (ByteString -> IO Bytes) -> ByteString -> IO Bytes
forall a b. (a -> b) -> a -> b
$ Map ForeignFunc Text -> Code -> ByteString
ANF.serializeCode Map ForeignFunc Text
builtinForeignNames Code
co
  ForeignFunc
Code_deserialize ->
    (Bytes -> IO (Either String Code)) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Bytes -> IO (Either String Code)) -> Args -> Stack -> IO Stack)
-> (Bytes -> IO (Either String Code)) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
      Either String Code -> IO (Either String Code)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Code -> IO (Either String Code))
-> (Bytes -> Either String Code)
-> Bytes
-> IO (Either String Code)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String Code
ANF.deserializeCode (ByteString -> Either String Code)
-> (Bytes -> ByteString) -> Bytes -> Either String Code
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> ByteString
forall b. ByteArray b => Bytes -> b
Bytes.toArray
  ForeignFunc
Code_display -> ((Text, Code) -> IO String) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((Text, Code) -> IO String) -> Args -> Stack -> IO Stack)
-> ((Text, Code) -> IO String) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(Text
nm, (ANF.CodeRep SuperGroup Symbol
sg Cacheability
_)) ->
      String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ forall v. Var v => String -> SuperGroup v -> String -> String
ANF.prettyGroup @Symbol (Text -> String
Util.Text.unpack Text
nm) SuperGroup Symbol
sg String
""
  ForeignFunc
Value_dependencies ->
    (Value -> IO [Foreign]) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Value -> IO [Foreign]) -> Args -> Stack -> IO Stack)
-> (Value -> IO [Foreign]) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
      [Foreign] -> IO [Foreign]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Foreign] -> IO [Foreign])
-> (Value -> [Foreign]) -> Value -> IO [Foreign]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Reference -> Foreign) -> [Reference] -> [Foreign]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Reference -> Referent -> Foreign
forall e. Reference -> e -> Foreign
Wrap Reference
Ty.termLinkRef (Referent -> Foreign)
-> (Reference -> Referent) -> Reference -> Foreign
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> Referent
Ref) ([Reference] -> [Foreign])
-> (Value -> [Reference]) -> Value -> [Foreign]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> [Reference]
ANF.valueTermLinks
  ForeignFunc
Value_serialize ->
    (Value -> IO Bytes) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Value -> IO Bytes) -> Args -> Stack -> IO Stack)
-> (Value -> IO Bytes) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
      Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> IO Bytes) -> (Value -> Bytes) -> Value -> IO Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bytes
forall b. ByteArrayAccess b => b -> Bytes
Bytes.fromArray (ByteString -> Bytes) -> (Value -> ByteString) -> Value -> Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ByteString
ANF.serializeValue
  ForeignFunc
Value_deserialize ->
    (Bytes -> IO (Either String Value)) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Bytes -> IO (Either String Value)) -> Args -> Stack -> IO Stack)
-> (Bytes -> IO (Either String Value)) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
      Either String Value -> IO (Either String Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Value -> IO (Either String Value))
-> (Bytes -> Either String Value)
-> Bytes
-> IO (Either String Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String Value
ANF.deserializeValue (ByteString -> Either String Value)
-> (Bytes -> ByteString) -> Bytes -> Either String Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> ByteString
forall b. ByteArray b => Bytes -> b
Bytes.toArray
  ForeignFunc
Crypto_HashAlgorithm_Sha3_512 -> Text -> SHA3_512 -> Args -> Stack -> IO Stack
forall alg.
HashAlgorithm alg =>
Text -> alg -> Args -> Stack -> IO Stack
mkHashAlgorithm Text
"Sha3_512" SHA3_512
Hash.SHA3_512
  ForeignFunc
Crypto_HashAlgorithm_Sha3_256 -> Text -> SHA3_256 -> Args -> Stack -> IO Stack
forall alg.
HashAlgorithm alg =>
Text -> alg -> Args -> Stack -> IO Stack
mkHashAlgorithm Text
"Sha3_256" SHA3_256
Hash.SHA3_256
  ForeignFunc
Crypto_HashAlgorithm_Sha2_512 -> Text -> SHA512 -> Args -> Stack -> IO Stack
forall alg.
HashAlgorithm alg =>
Text -> alg -> Args -> Stack -> IO Stack
mkHashAlgorithm Text
"Sha2_512" SHA512
Hash.SHA512
  ForeignFunc
Crypto_HashAlgorithm_Sha2_256 -> Text -> SHA256 -> Args -> Stack -> IO Stack
forall alg.
HashAlgorithm alg =>
Text -> alg -> Args -> Stack -> IO Stack
mkHashAlgorithm Text
"Sha2_256" SHA256
Hash.SHA256
  ForeignFunc
Crypto_HashAlgorithm_Sha1 -> Text -> SHA1 -> Args -> Stack -> IO Stack
forall alg.
HashAlgorithm alg =>
Text -> alg -> Args -> Stack -> IO Stack
mkHashAlgorithm Text
"Sha1" SHA1
Hash.SHA1
  ForeignFunc
Crypto_HashAlgorithm_Blake2b_512 -> Text -> Blake2b_512 -> Args -> Stack -> IO Stack
forall alg.
HashAlgorithm alg =>
Text -> alg -> Args -> Stack -> IO Stack
mkHashAlgorithm Text
"Blake2b_512" Blake2b_512
Hash.Blake2b_512
  ForeignFunc
Crypto_HashAlgorithm_Blake2b_256 -> Text -> Blake2b_256 -> Args -> Stack -> IO Stack
forall alg.
HashAlgorithm alg =>
Text -> alg -> Args -> Stack -> IO Stack
mkHashAlgorithm Text
"Blake2b_256" Blake2b_256
Hash.Blake2b_256
  ForeignFunc
Crypto_HashAlgorithm_Blake2s_256 -> Text -> Blake2s_256 -> Args -> Stack -> IO Stack
forall alg.
HashAlgorithm alg =>
Text -> alg -> Args -> Stack -> IO Stack
mkHashAlgorithm Text
"Blake2s_256" Blake2s_256
Hash.Blake2s_256
  ForeignFunc
Crypto_HashAlgorithm_Md5 -> Text -> MD5 -> Args -> Stack -> IO Stack
forall alg.
HashAlgorithm alg =>
Text -> alg -> Args -> Stack -> IO Stack
mkHashAlgorithm Text
"Md5" MD5
Hash.MD5
  ForeignFunc
Crypto_hashBytes -> ((HashAlgorithm, Bytes) -> IO Bytes) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((HashAlgorithm, Bytes) -> IO Bytes) -> Args -> Stack -> IO Stack)
-> ((HashAlgorithm, Bytes) -> IO Bytes)
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(HashAlgorithm Reference
_ a
alg, Bytes
b :: Bytes.Bytes) ->
      let ctx :: Context a
ctx = a -> Context a
forall alg. HashAlgorithm alg => alg -> Context alg
Hash.hashInitWith a
alg
       in Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> IO Bytes)
-> (Context a -> Bytes) -> Context a -> IO Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest a -> Bytes
forall b. ByteArrayAccess b => b -> Bytes
Bytes.fromArray (Digest a -> Bytes)
-> (Context a -> Digest a) -> Context a -> Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context a -> Digest a
forall a. HashAlgorithm a => Context a -> Digest a
Hash.hashFinalize (Context a -> IO Bytes) -> Context a -> IO Bytes
forall a b. (a -> b) -> a -> b
$ Context a -> [ByteString] -> Context a
forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
Context a -> [ba] -> Context a
Hash.hashUpdates Context a
ctx (Bytes -> [ByteString]
Bytes.byteStringChunks Bytes
b)
  ForeignFunc
Crypto_hmacBytes -> ((HashAlgorithm, Bytes, Bytes) -> IO Bytes)
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((HashAlgorithm, Bytes, Bytes) -> IO Bytes)
 -> Args -> Stack -> IO Stack)
-> ((HashAlgorithm, Bytes, Bytes) -> IO Bytes)
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(HashAlgorithm Reference
_ a
alg, Bytes
key :: Bytes.Bytes, Bytes
msg :: Bytes.Bytes) ->
      let out :: HMAC a
out = a -> HMAC a -> HMAC a
forall a. a -> HMAC a -> HMAC a
u a
alg (HMAC a -> HMAC a) -> HMAC a -> HMAC a
forall a b. (a -> b) -> a -> b
$ Bytes -> Bytes -> HMAC a
forall key message a.
(ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
key -> message -> HMAC a
HMAC.hmac (forall b. ByteArray b => Bytes -> b
Bytes.toArray @BA.Bytes Bytes
key) (forall b. ByteArray b => Bytes -> b
Bytes.toArray @BA.Bytes Bytes
msg)
          u :: a -> HMAC.HMAC a -> HMAC.HMAC a
          u :: forall a. a -> HMAC a -> HMAC a
u a
_ HMAC a
h = HMAC a
h -- to help typechecker along
       in Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> IO Bytes) -> Bytes -> IO Bytes
forall a b. (a -> b) -> a -> b
$ HMAC a -> Bytes
forall b. ByteArrayAccess b => b -> Bytes
Bytes.fromArray HMAC a
out
  ForeignFunc
Crypto_hash -> ((HashAlgorithm, Value) -> IO Bytes) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((HashAlgorithm, Value) -> IO Bytes) -> Args -> Stack -> IO Stack)
-> ((HashAlgorithm, Value) -> IO Bytes)
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(HashAlgorithm Reference
_ a
alg, Value
x) ->
      let hashlazy ::
            (Hash.HashAlgorithm a) =>
            a ->
            L.ByteString ->
            Hash.Digest a
          hashlazy :: forall a. HashAlgorithm a => a -> ByteString -> Digest a
hashlazy a
_ ByteString
l = ByteString -> Digest a
forall a. HashAlgorithm a => ByteString -> Digest a
Hash.hashlazy ByteString
l
       in Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> IO Bytes)
-> (ByteString -> Bytes) -> ByteString -> IO Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest a -> Bytes
forall b. ByteArrayAccess b => b -> Bytes
Bytes.fromArray (Digest a -> Bytes)
-> (ByteString -> Digest a) -> ByteString -> Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString -> Digest a
forall a. HashAlgorithm a => a -> ByteString -> Digest a
hashlazy a
alg (ByteString -> IO Bytes) -> ByteString -> IO Bytes
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
ANF.serializeValueForHash Value
x
  ForeignFunc
Crypto_hmac -> ((HashAlgorithm, Bytes, Value) -> IO Bytes)
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((HashAlgorithm, Bytes, Value) -> IO Bytes)
 -> Args -> Stack -> IO Stack)
-> ((HashAlgorithm, Bytes, Value) -> IO Bytes)
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(HashAlgorithm Reference
_ a
alg, Bytes
key, Value
x) ->
      let hmac ::
            (Hash.HashAlgorithm a) => a -> L.ByteString -> HMAC.HMAC a
          hmac :: forall a. HashAlgorithm a => a -> ByteString -> HMAC a
hmac a
_ ByteString
s =
            Context a -> HMAC a
forall a. HashAlgorithm a => Context a -> HMAC a
HMAC.finalize
              (Context a -> HMAC a)
-> ([ByteString] -> Context a) -> [ByteString] -> HMAC a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context a -> [ByteString] -> Context a
forall message a.
(ByteArrayAccess message, HashAlgorithm a) =>
Context a -> [message] -> Context a
HMAC.updates
                (Bytes -> Context a
forall key a.
(ByteArrayAccess key, HashAlgorithm a) =>
key -> Context a
HMAC.initialize (Bytes -> Context a) -> Bytes -> Context a
forall a b. (a -> b) -> a -> b
$ forall b. ByteArray b => Bytes -> b
Bytes.toArray @BA.Bytes Bytes
key)
              ([ByteString] -> HMAC a) -> [ByteString] -> HMAC a
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
L.toChunks ByteString
s
       in Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> IO Bytes)
-> (ByteString -> Bytes) -> ByteString -> IO Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HMAC a -> Bytes
forall b. ByteArrayAccess b => b -> Bytes
Bytes.fromArray (HMAC a -> Bytes) -> (ByteString -> HMAC a) -> ByteString -> Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString -> HMAC a
forall a. HashAlgorithm a => a -> ByteString -> HMAC a
hmac a
alg (ByteString -> IO Bytes) -> ByteString -> IO Bytes
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
ANF.serializeValueForHash Value
x
  ForeignFunc
Crypto_Ed25519_sign_impl ->
    ((Bytes, Bytes, Bytes) -> IO (Either (Failure Val) Bytes))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((Bytes, Bytes, Bytes) -> IO (Either (Failure Val) Bytes))
 -> Args -> Stack -> IO Stack)
-> ((Bytes, Bytes, Bytes) -> IO (Either (Failure Val) Bytes))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
      Either (Failure Val) Bytes -> IO (Either (Failure Val) Bytes)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Failure Val) Bytes -> IO (Either (Failure Val) Bytes))
-> ((Bytes, Bytes, Bytes) -> Either (Failure Val) Bytes)
-> (Bytes, Bytes, Bytes)
-> IO (Either (Failure Val) Bytes)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bytes, Bytes, Bytes) -> Either (Failure Val) Bytes
signEd25519Wrapper
  ForeignFunc
Crypto_Ed25519_verify_impl ->
    ((Bytes, Bytes, Bytes) -> IO (Either (Failure Val) Bool))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((Bytes, Bytes, Bytes) -> IO (Either (Failure Val) Bool))
 -> Args -> Stack -> IO Stack)
-> ((Bytes, Bytes, Bytes) -> IO (Either (Failure Val) Bool))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
      Either (Failure Val) Bool -> IO (Either (Failure Val) Bool)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Failure Val) Bool -> IO (Either (Failure Val) Bool))
-> ((Bytes, Bytes, Bytes) -> Either (Failure Val) Bool)
-> (Bytes, Bytes, Bytes)
-> IO (Either (Failure Val) Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bytes, Bytes, Bytes) -> Either (Failure Val) Bool
verifyEd25519Wrapper
  ForeignFunc
Crypto_Rsa_sign_impl ->
    ((Bytes, Bytes) -> IO (Either (Failure Val) Bytes))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((Bytes, Bytes) -> IO (Either (Failure Val) Bytes))
 -> Args -> Stack -> IO Stack)
-> ((Bytes, Bytes) -> IO (Either (Failure Val) Bytes))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
      Either (Failure Val) Bytes -> IO (Either (Failure Val) Bytes)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Failure Val) Bytes -> IO (Either (Failure Val) Bytes))
-> ((Bytes, Bytes) -> Either (Failure Val) Bytes)
-> (Bytes, Bytes)
-> IO (Either (Failure Val) Bytes)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bytes, Bytes) -> Either (Failure Val) Bytes
signRsaWrapper
  ForeignFunc
Crypto_Rsa_verify_impl ->
    ((Bytes, Bytes, Bytes) -> IO (Either (Failure Val) Bool))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((Bytes, Bytes, Bytes) -> IO (Either (Failure Val) Bool))
 -> Args -> Stack -> IO Stack)
-> ((Bytes, Bytes, Bytes) -> IO (Either (Failure Val) Bool))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
      Either (Failure Val) Bool -> IO (Either (Failure Val) Bool)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Failure Val) Bool -> IO (Either (Failure Val) Bool))
-> ((Bytes, Bytes, Bytes) -> Either (Failure Val) Bool)
-> (Bytes, Bytes, Bytes)
-> IO (Either (Failure Val) Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bytes, Bytes, Bytes) -> Either (Failure Val) Bool
verifyRsaWrapper
  ForeignFunc
Universal_murmurHash ->
    (Value -> IO ConstructorId) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Value -> IO ConstructorId) -> Args -> Stack -> IO Stack)
-> (Value -> IO ConstructorId) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
      ConstructorId -> IO ConstructorId
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConstructorId -> IO ConstructorId)
-> (Value -> ConstructorId) -> Value -> IO ConstructorId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash64 -> ConstructorId
asWord64 (Hash64 -> ConstructorId)
-> (Value -> Hash64) -> Value -> ConstructorId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Hash64
forall a. Hashable64 a => a -> Hash64
hash64 (ByteString -> Hash64) -> (Value -> ByteString) -> Value -> Hash64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ByteString
ANF.serializeValueForHash
  ForeignFunc
IO_randomBytes -> (Int -> IO Bytes) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Int -> IO Bytes) -> Args -> Stack -> IO Stack)
-> (Int -> IO Bytes) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \Int
n -> ByteString -> Bytes
forall b. ByteArrayAccess b => b -> Bytes
Bytes.fromArray (ByteString -> Bytes) -> IO ByteString -> IO Bytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes @IO @ByteString Int
n
  ForeignFunc
Bytes_zlib_compress -> (Bytes -> IO Bytes) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Bytes -> IO Bytes) -> Args -> Stack -> IO Stack)
-> (Bytes -> IO Bytes) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> IO Bytes) -> (Bytes -> Bytes) -> Bytes -> IO Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Bytes
Bytes.zlibCompress
  ForeignFunc
Bytes_gzip_compress -> (Bytes -> IO Bytes) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Bytes -> IO Bytes) -> Args -> Stack -> IO Stack)
-> (Bytes -> IO Bytes) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> IO Bytes) -> (Bytes -> Bytes) -> Bytes -> IO Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Bytes
Bytes.gzipCompress
  ForeignFunc
Bytes_zlib_decompress -> (Bytes -> IO (Either Text Bytes)) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Bytes -> IO (Either Text Bytes)) -> Args -> Stack -> IO Stack)
-> (Bytes -> IO (Either Text Bytes)) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ \Bytes
bs ->
    IO Bytes -> IO (Either Text Bytes)
forall (m :: * -> *) a.
(MonadCatch m, MonadIO m, NFData a) =>
m a -> m (Either Text a)
catchAll (Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> Bytes
Bytes.zlibDecompress Bytes
bs))
  ForeignFunc
Bytes_gzip_decompress -> (Bytes -> IO (Either Text Bytes)) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Bytes -> IO (Either Text Bytes)) -> Args -> Stack -> IO Stack)
-> (Bytes -> IO (Either Text Bytes)) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ \Bytes
bs ->
    IO Bytes -> IO (Either Text Bytes)
forall (m :: * -> *) a.
(MonadCatch m, MonadIO m, NFData a) =>
m a -> m (Either Text a)
catchAll (Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> Bytes
Bytes.gzipDecompress Bytes
bs))
  ForeignFunc
Bytes_toBase16 -> (Bytes -> IO Bytes) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Bytes -> IO Bytes) -> Args -> Stack -> IO Stack)
-> (Bytes -> IO Bytes) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> IO Bytes) -> (Bytes -> Bytes) -> Bytes -> IO Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Bytes
Bytes.toBase16
  ForeignFunc
Bytes_toBase32 -> (Bytes -> IO Bytes) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Bytes -> IO Bytes) -> Args -> Stack -> IO Stack)
-> (Bytes -> IO Bytes) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> IO Bytes) -> (Bytes -> Bytes) -> Bytes -> IO Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Bytes
Bytes.toBase32
  ForeignFunc
Bytes_toBase64 -> (Bytes -> IO Bytes) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Bytes -> IO Bytes) -> Args -> Stack -> IO Stack)
-> (Bytes -> IO Bytes) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> IO Bytes) -> (Bytes -> Bytes) -> Bytes -> IO Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Bytes
Bytes.toBase64
  ForeignFunc
Bytes_toBase64UrlUnpadded -> (Bytes -> IO Bytes) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Bytes -> IO Bytes) -> Args -> Stack -> IO Stack)
-> (Bytes -> IO Bytes) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> IO Bytes) -> (Bytes -> Bytes) -> Bytes -> IO Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Bytes
Bytes.toBase64UrlUnpadded
  ForeignFunc
Bytes_fromBase16 ->
    (Bytes -> IO (Either Text Bytes)) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Bytes -> IO (Either Text Bytes)) -> Args -> Stack -> IO Stack)
-> (Bytes -> IO (Either Text Bytes)) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
      Either Text Bytes -> IO (Either Text Bytes)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Bytes -> IO (Either Text Bytes))
-> (Bytes -> Either Text Bytes) -> Bytes -> IO (Either Text Bytes)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> Either Text Bytes -> Either Text Bytes
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft Text -> Text
Util.Text.fromText (Either Text Bytes -> Either Text Bytes)
-> (Bytes -> Either Text Bytes) -> Bytes -> Either Text Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Either Text Bytes
Bytes.fromBase16
  ForeignFunc
Bytes_fromBase32 ->
    (Bytes -> IO (Either Text Bytes)) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Bytes -> IO (Either Text Bytes)) -> Args -> Stack -> IO Stack)
-> (Bytes -> IO (Either Text Bytes)) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
      Either Text Bytes -> IO (Either Text Bytes)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Bytes -> IO (Either Text Bytes))
-> (Bytes -> Either Text Bytes) -> Bytes -> IO (Either Text Bytes)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> Either Text Bytes -> Either Text Bytes
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft Text -> Text
Util.Text.fromText (Either Text Bytes -> Either Text Bytes)
-> (Bytes -> Either Text Bytes) -> Bytes -> Either Text Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Either Text Bytes
Bytes.fromBase32
  ForeignFunc
Bytes_fromBase64 ->
    (Bytes -> IO (Either Text Bytes)) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Bytes -> IO (Either Text Bytes)) -> Args -> Stack -> IO Stack)
-> (Bytes -> IO (Either Text Bytes)) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
      Either Text Bytes -> IO (Either Text Bytes)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Bytes -> IO (Either Text Bytes))
-> (Bytes -> Either Text Bytes) -> Bytes -> IO (Either Text Bytes)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> Either Text Bytes -> Either Text Bytes
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft Text -> Text
Util.Text.fromText (Either Text Bytes -> Either Text Bytes)
-> (Bytes -> Either Text Bytes) -> Bytes -> Either Text Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Either Text Bytes
Bytes.fromBase64
  ForeignFunc
Bytes_fromBase64UrlUnpadded ->
    (Bytes -> IO (Either Text Bytes)) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Bytes -> IO (Either Text Bytes)) -> Args -> Stack -> IO Stack)
-> (Bytes -> IO (Either Text Bytes)) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
      Either Text Bytes -> IO (Either Text Bytes)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Bytes -> IO (Either Text Bytes))
-> (Bytes -> Either Text Bytes) -> Bytes -> IO (Either Text Bytes)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> Either Text Bytes -> Either Text Bytes
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft Text -> Text
Util.Text.fromText (Either Text Bytes -> Either Text Bytes)
-> (Bytes -> Either Text Bytes) -> Bytes -> Either Text Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Either Text Bytes
Bytes.fromBase64UrlUnpadded
  ForeignFunc
Bytes_decodeNat64be -> (Bytes -> IO (Maybe (ConstructorId, Bytes)))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Bytes -> IO (Maybe (ConstructorId, Bytes)))
 -> Args -> Stack -> IO Stack)
-> (Bytes -> IO (Maybe (ConstructorId, Bytes)))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$ Maybe (ConstructorId, Bytes) -> IO (Maybe (ConstructorId, Bytes))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (ConstructorId, Bytes) -> IO (Maybe (ConstructorId, Bytes)))
-> (Bytes -> Maybe (ConstructorId, Bytes))
-> Bytes
-> IO (Maybe (ConstructorId, Bytes))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Maybe (ConstructorId, Bytes)
Bytes.decodeNat64be
  ForeignFunc
Bytes_decodeNat64le -> (Bytes -> IO (Maybe (ConstructorId, Bytes)))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Bytes -> IO (Maybe (ConstructorId, Bytes)))
 -> Args -> Stack -> IO Stack)
-> (Bytes -> IO (Maybe (ConstructorId, Bytes)))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$ Maybe (ConstructorId, Bytes) -> IO (Maybe (ConstructorId, Bytes))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (ConstructorId, Bytes) -> IO (Maybe (ConstructorId, Bytes)))
-> (Bytes -> Maybe (ConstructorId, Bytes))
-> Bytes
-> IO (Maybe (ConstructorId, Bytes))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Maybe (ConstructorId, Bytes)
Bytes.decodeNat64le
  ForeignFunc
Bytes_decodeNat32be -> (Bytes -> IO (Maybe (ConstructorId, Bytes)))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Bytes -> IO (Maybe (ConstructorId, Bytes)))
 -> Args -> Stack -> IO Stack)
-> (Bytes -> IO (Maybe (ConstructorId, Bytes)))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$ Maybe (ConstructorId, Bytes) -> IO (Maybe (ConstructorId, Bytes))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (ConstructorId, Bytes) -> IO (Maybe (ConstructorId, Bytes)))
-> (Bytes -> Maybe (ConstructorId, Bytes))
-> Bytes
-> IO (Maybe (ConstructorId, Bytes))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Maybe (ConstructorId, Bytes)
Bytes.decodeNat32be
  ForeignFunc
Bytes_decodeNat32le -> (Bytes -> IO (Maybe (ConstructorId, Bytes)))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Bytes -> IO (Maybe (ConstructorId, Bytes)))
 -> Args -> Stack -> IO Stack)
-> (Bytes -> IO (Maybe (ConstructorId, Bytes)))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$ Maybe (ConstructorId, Bytes) -> IO (Maybe (ConstructorId, Bytes))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (ConstructorId, Bytes) -> IO (Maybe (ConstructorId, Bytes)))
-> (Bytes -> Maybe (ConstructorId, Bytes))
-> Bytes
-> IO (Maybe (ConstructorId, Bytes))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Maybe (ConstructorId, Bytes)
Bytes.decodeNat32le
  ForeignFunc
Bytes_decodeNat16be -> (Bytes -> IO (Maybe (ConstructorId, Bytes)))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Bytes -> IO (Maybe (ConstructorId, Bytes)))
 -> Args -> Stack -> IO Stack)
-> (Bytes -> IO (Maybe (ConstructorId, Bytes)))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$ Maybe (ConstructorId, Bytes) -> IO (Maybe (ConstructorId, Bytes))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (ConstructorId, Bytes) -> IO (Maybe (ConstructorId, Bytes)))
-> (Bytes -> Maybe (ConstructorId, Bytes))
-> Bytes
-> IO (Maybe (ConstructorId, Bytes))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Maybe (ConstructorId, Bytes)
Bytes.decodeNat16be
  ForeignFunc
Bytes_decodeNat16le -> (Bytes -> IO (Maybe (ConstructorId, Bytes)))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Bytes -> IO (Maybe (ConstructorId, Bytes)))
 -> Args -> Stack -> IO Stack)
-> (Bytes -> IO (Maybe (ConstructorId, Bytes)))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$ Maybe (ConstructorId, Bytes) -> IO (Maybe (ConstructorId, Bytes))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (ConstructorId, Bytes) -> IO (Maybe (ConstructorId, Bytes)))
-> (Bytes -> Maybe (ConstructorId, Bytes))
-> Bytes
-> IO (Maybe (ConstructorId, Bytes))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Maybe (ConstructorId, Bytes)
Bytes.decodeNat16le
  ForeignFunc
Bytes_encodeNat64be -> (ConstructorId -> IO Bytes) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((ConstructorId -> IO Bytes) -> Args -> Stack -> IO Stack)
-> (ConstructorId -> IO Bytes) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> IO Bytes)
-> (ConstructorId -> Bytes) -> ConstructorId -> IO Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstructorId -> Bytes
Bytes.encodeNat64be
  ForeignFunc
Bytes_encodeNat64le -> (ConstructorId -> IO Bytes) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((ConstructorId -> IO Bytes) -> Args -> Stack -> IO Stack)
-> (ConstructorId -> IO Bytes) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> IO Bytes)
-> (ConstructorId -> Bytes) -> ConstructorId -> IO Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstructorId -> Bytes
Bytes.encodeNat64le
  ForeignFunc
Bytes_encodeNat32be -> (ConstructorId -> IO Bytes) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((ConstructorId -> IO Bytes) -> Args -> Stack -> IO Stack)
-> (ConstructorId -> IO Bytes) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> IO Bytes)
-> (ConstructorId -> Bytes) -> ConstructorId -> IO Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstructorId -> Bytes
Bytes.encodeNat32be
  ForeignFunc
Bytes_encodeNat32le -> (ConstructorId -> IO Bytes) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((ConstructorId -> IO Bytes) -> Args -> Stack -> IO Stack)
-> (ConstructorId -> IO Bytes) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> IO Bytes)
-> (ConstructorId -> Bytes) -> ConstructorId -> IO Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstructorId -> Bytes
Bytes.encodeNat32le
  ForeignFunc
Bytes_encodeNat16be -> (ConstructorId -> IO Bytes) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((ConstructorId -> IO Bytes) -> Args -> Stack -> IO Stack)
-> (ConstructorId -> IO Bytes) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> IO Bytes)
-> (ConstructorId -> Bytes) -> ConstructorId -> IO Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstructorId -> Bytes
Bytes.encodeNat16be
  ForeignFunc
Bytes_encodeNat16le -> (ConstructorId -> IO Bytes) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((ConstructorId -> IO Bytes) -> Args -> Stack -> IO Stack)
-> (ConstructorId -> IO Bytes) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> IO Bytes)
-> (ConstructorId -> Bytes) -> ConstructorId -> IO Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstructorId -> Bytes
Bytes.encodeNat16le
  ForeignFunc
MutableArray_copyTo_force -> ((MutableArray RealWorld Val, ConstructorId,
  MutableArray RealWorld Val, ConstructorId, ConstructorId)
 -> IO (Either (Failure Val) ()))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((MutableArray RealWorld Val, ConstructorId,
   MutableArray RealWorld Val, ConstructorId, ConstructorId)
  -> IO (Either (Failure Val) ()))
 -> Args -> Stack -> IO Stack)
-> ((MutableArray RealWorld Val, ConstructorId,
     MutableArray RealWorld Val, ConstructorId, ConstructorId)
    -> IO (Either (Failure Val) ()))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(MutableArray RealWorld Val
dst, ConstructorId
doff, MutableArray RealWorld Val
src, ConstructorId
soff, ConstructorId
l) ->
      let name :: Text
name = Text
"MutableArray.copyTo!"
       in if ConstructorId
l ConstructorId -> ConstructorId -> Bool
forall a. Eq a => a -> a -> Bool
== ConstructorId
0
            then Either (Failure Val) () -> IO (Either (Failure Val) ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either (Failure Val) ()
forall a b. b -> Either a b
Right ())
            else
              Text
-> Int
-> ConstructorId
-> IO (Either (Failure Val) ())
-> IO (Either (Failure Val) ())
forall b.
Text
-> Int
-> ConstructorId
-> IO (Either (Failure Val) b)
-> IO (Either (Failure Val) b)
checkBounds Text
name (MutableArray RealWorld Val -> Int
forall s a. MutableArray s a -> Int
PA.sizeofMutableArray MutableArray RealWorld Val
dst) (ConstructorId
doff ConstructorId -> ConstructorId -> ConstructorId
forall a. Num a => a -> a -> a
+ ConstructorId
l ConstructorId -> ConstructorId -> ConstructorId
forall a. Num a => a -> a -> a
- ConstructorId
1) (IO (Either (Failure Val) ()) -> IO (Either (Failure Val) ()))
-> IO (Either (Failure Val) ()) -> IO (Either (Failure Val) ())
forall a b. (a -> b) -> a -> b
$
                Text
-> Int
-> ConstructorId
-> IO (Either (Failure Val) ())
-> IO (Either (Failure Val) ())
forall b.
Text
-> Int
-> ConstructorId
-> IO (Either (Failure Val) b)
-> IO (Either (Failure Val) b)
checkBounds Text
name (MutableArray RealWorld Val -> Int
forall s a. MutableArray s a -> Int
PA.sizeofMutableArray MutableArray RealWorld Val
src) (ConstructorId
soff ConstructorId -> ConstructorId -> ConstructorId
forall a. Num a => a -> a -> a
+ ConstructorId
l ConstructorId -> ConstructorId -> ConstructorId
forall a. Num a => a -> a -> a
- ConstructorId
1) (IO (Either (Failure Val) ()) -> IO (Either (Failure Val) ()))
-> IO (Either (Failure Val) ()) -> IO (Either (Failure Val) ())
forall a b. (a -> b) -> a -> b
$
                  () -> Either (Failure Val) ()
forall a b. b -> Either a b
Right
                    (() -> Either (Failure Val) ())
-> IO () -> IO (Either (Failure Val) ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
(() :: Constraint, PrimMonad m) =>
MutableArray (PrimState m) a
-> Int -> MutableArray (PrimState m) a -> Int -> Int -> m ()
PA.copyMutableArray @IO @Val
                      MutableArray RealWorld Val
MutableArray RW Val
dst
                      (ConstructorId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
doff)
                      MutableArray RealWorld Val
MutableArray RW Val
src
                      (ConstructorId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
soff)
                      (ConstructorId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
l)
  ForeignFunc
MutableByteArray_copyTo_force -> ((MutableByteArray RealWorld, ConstructorId,
  MutableByteArray RealWorld, ConstructorId, ConstructorId)
 -> IO (Either (Failure Val) ()))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((MutableByteArray RealWorld, ConstructorId,
   MutableByteArray RealWorld, ConstructorId, ConstructorId)
  -> IO (Either (Failure Val) ()))
 -> Args -> Stack -> IO Stack)
-> ((MutableByteArray RealWorld, ConstructorId,
     MutableByteArray RealWorld, ConstructorId, ConstructorId)
    -> IO (Either (Failure Val) ()))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(MutableByteArray RealWorld
dst, ConstructorId
doff, MutableByteArray RealWorld
src, ConstructorId
soff, ConstructorId
l) ->
      let name :: Text
name = Text
"MutableByteArray.copyTo!"
       in if ConstructorId
l ConstructorId -> ConstructorId -> Bool
forall a. Eq a => a -> a -> Bool
== ConstructorId
0
            then Either (Failure Val) () -> IO (Either (Failure Val) ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either (Failure Val) ()
forall a b. b -> Either a b
Right ())
            else
              Text
-> Int
-> ConstructorId
-> ConstructorId
-> IO (Either (Failure Val) ())
-> IO (Either (Failure Val) ())
forall b.
Text
-> Int
-> ConstructorId
-> ConstructorId
-> IO (Either (Failure Val) b)
-> IO (Either (Failure Val) b)
checkBoundsPrim Text
name (MutableByteArray RealWorld -> Int
forall s. MutableByteArray s -> Int
PA.sizeofMutableByteArray MutableByteArray RealWorld
dst) (ConstructorId
doff ConstructorId -> ConstructorId -> ConstructorId
forall a. Num a => a -> a -> a
+ ConstructorId
l) ConstructorId
0 (IO (Either (Failure Val) ()) -> IO (Either (Failure Val) ()))
-> IO (Either (Failure Val) ()) -> IO (Either (Failure Val) ())
forall a b. (a -> b) -> a -> b
$
                Text
-> Int
-> ConstructorId
-> ConstructorId
-> IO (Either (Failure Val) ())
-> IO (Either (Failure Val) ())
forall b.
Text
-> Int
-> ConstructorId
-> ConstructorId
-> IO (Either (Failure Val) b)
-> IO (Either (Failure Val) b)
checkBoundsPrim Text
name (MutableByteArray RealWorld -> Int
forall s. MutableByteArray s -> Int
PA.sizeofMutableByteArray MutableByteArray RealWorld
src) (ConstructorId
soff ConstructorId -> ConstructorId -> ConstructorId
forall a. Num a => a -> a -> a
+ ConstructorId
l) ConstructorId
0 (IO (Either (Failure Val) ()) -> IO (Either (Failure Val) ()))
-> IO (Either (Failure Val) ()) -> IO (Either (Failure Val) ())
forall a b. (a -> b) -> a -> b
$
                  () -> Either (Failure Val) ()
forall a b. b -> Either a b
Right
                    (() -> Either (Failure Val) ())
-> IO () -> IO (Either (Failure Val) ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
(() :: Constraint, PrimMonad m) =>
MutableByteArray (PrimState m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
PA.copyMutableByteArray @IO
                      MutableByteArray RealWorld
MutableByteArray RW
dst
                      (ConstructorId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
doff)
                      MutableByteArray RealWorld
MutableByteArray RW
src
                      (ConstructorId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
soff)
                      (ConstructorId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
l)
  ForeignFunc
ImmutableArray_copyTo_force -> ((MutableArray RealWorld Val, ConstructorId, Array Val,
  ConstructorId, ConstructorId)
 -> IO (Either (Failure Val) ()))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((MutableArray RealWorld Val, ConstructorId, Array Val,
   ConstructorId, ConstructorId)
  -> IO (Either (Failure Val) ()))
 -> Args -> Stack -> IO Stack)
-> ((MutableArray RealWorld Val, ConstructorId, Array Val,
     ConstructorId, ConstructorId)
    -> IO (Either (Failure Val) ()))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(MutableArray RealWorld Val
dst, ConstructorId
doff, Array Val
src, ConstructorId
soff, ConstructorId
l) ->
      let name :: Text
name = Text
"ImmutableArray.copyTo!"
       in if ConstructorId
l ConstructorId -> ConstructorId -> Bool
forall a. Eq a => a -> a -> Bool
== ConstructorId
0
            then Either (Failure Val) () -> IO (Either (Failure Val) ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either (Failure Val) ()
forall a b. b -> Either a b
Right ())
            else
              Text
-> Int
-> ConstructorId
-> IO (Either (Failure Val) ())
-> IO (Either (Failure Val) ())
forall b.
Text
-> Int
-> ConstructorId
-> IO (Either (Failure Val) b)
-> IO (Either (Failure Val) b)
checkBounds Text
name (MutableArray RealWorld Val -> Int
forall s a. MutableArray s a -> Int
PA.sizeofMutableArray MutableArray RealWorld Val
dst) (ConstructorId
doff ConstructorId -> ConstructorId -> ConstructorId
forall a. Num a => a -> a -> a
+ ConstructorId
l ConstructorId -> ConstructorId -> ConstructorId
forall a. Num a => a -> a -> a
- ConstructorId
1) (IO (Either (Failure Val) ()) -> IO (Either (Failure Val) ()))
-> IO (Either (Failure Val) ()) -> IO (Either (Failure Val) ())
forall a b. (a -> b) -> a -> b
$
                Text
-> Int
-> ConstructorId
-> IO (Either (Failure Val) ())
-> IO (Either (Failure Val) ())
forall b.
Text
-> Int
-> ConstructorId
-> IO (Either (Failure Val) b)
-> IO (Either (Failure Val) b)
checkBounds Text
name (Array Val -> Int
forall a. Array a -> Int
PA.sizeofArray Array Val
src) (ConstructorId
soff ConstructorId -> ConstructorId -> ConstructorId
forall a. Num a => a -> a -> a
+ ConstructorId
l ConstructorId -> ConstructorId -> ConstructorId
forall a. Num a => a -> a -> a
- ConstructorId
1) (IO (Either (Failure Val) ()) -> IO (Either (Failure Val) ()))
-> IO (Either (Failure Val) ()) -> IO (Either (Failure Val) ())
forall a b. (a -> b) -> a -> b
$
                  () -> Either (Failure Val) ()
forall a b. b -> Either a b
Right
                    (() -> Either (Failure Val) ())
-> IO () -> IO (Either (Failure Val) ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
(() :: Constraint, PrimMonad m) =>
MutableArray (PrimState m) a
-> Int -> Array a -> Int -> Int -> m ()
PA.copyArray @IO @Val
                      MutableArray RealWorld Val
MutableArray RW Val
dst
                      (ConstructorId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
doff)
                      Array Val
src
                      (ConstructorId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
soff)
                      (ConstructorId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
l)
  ForeignFunc
ImmutableArray_size ->
    (Array Val -> IO ConstructorId) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Array Val -> IO ConstructorId) -> Args -> Stack -> IO Stack)
-> (Array Val -> IO ConstructorId) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
      ConstructorId -> IO ConstructorId
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConstructorId -> IO ConstructorId)
-> (Array Val -> ConstructorId) -> Array Val -> IO ConstructorId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Word64 (Int -> ConstructorId)
-> (Array Val -> Int) -> Array Val -> ConstructorId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Array a -> Int
PA.sizeofArray @Val
  ForeignFunc
MutableArray_size ->
    (MutableArray RealWorld Val -> IO ConstructorId)
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((MutableArray RealWorld Val -> IO ConstructorId)
 -> Args -> Stack -> IO Stack)
-> (MutableArray RealWorld Val -> IO ConstructorId)
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
      ConstructorId -> IO ConstructorId
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConstructorId -> IO ConstructorId)
-> (MutableArray RealWorld Val -> ConstructorId)
-> MutableArray RealWorld Val
-> IO ConstructorId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Word64 (Int -> ConstructorId)
-> (MutableArray RealWorld Val -> Int)
-> MutableArray RealWorld Val
-> ConstructorId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. MutableArray s a -> Int
PA.sizeofMutableArray @PA.RealWorld @Val
  ForeignFunc
ImmutableByteArray_size ->
    (ByteArray -> IO ConstructorId) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((ByteArray -> IO ConstructorId) -> Args -> Stack -> IO Stack)
-> (ByteArray -> IO ConstructorId) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
      ConstructorId -> IO ConstructorId
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConstructorId -> IO ConstructorId)
-> (ByteArray -> ConstructorId) -> ByteArray -> IO ConstructorId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Word64 (Int -> ConstructorId)
-> (ByteArray -> Int) -> ByteArray -> ConstructorId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteArray -> Int
PA.sizeofByteArray
  ForeignFunc
MutableByteArray_size ->
    (MutableByteArray RealWorld -> IO ConstructorId)
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((MutableByteArray RealWorld -> IO ConstructorId)
 -> Args -> Stack -> IO Stack)
-> (MutableByteArray RealWorld -> IO ConstructorId)
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
      ConstructorId -> IO ConstructorId
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConstructorId -> IO ConstructorId)
-> (MutableByteArray RealWorld -> ConstructorId)
-> MutableByteArray RealWorld
-> IO ConstructorId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Word64 (Int -> ConstructorId)
-> (MutableByteArray RealWorld -> Int)
-> MutableByteArray RealWorld
-> ConstructorId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. MutableByteArray s -> Int
PA.sizeofMutableByteArray @PA.RealWorld
  ForeignFunc
ImmutableByteArray_copyTo_force -> ((MutableByteArray RealWorld, ConstructorId, ByteArray,
  ConstructorId, ConstructorId)
 -> IO (Either (Failure Val) ()))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((MutableByteArray RealWorld, ConstructorId, ByteArray,
   ConstructorId, ConstructorId)
  -> IO (Either (Failure Val) ()))
 -> Args -> Stack -> IO Stack)
-> ((MutableByteArray RealWorld, ConstructorId, ByteArray,
     ConstructorId, ConstructorId)
    -> IO (Either (Failure Val) ()))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(MutableByteArray RealWorld
dst, ConstructorId
doff, ByteArray
src, ConstructorId
soff, ConstructorId
l) ->
      let name :: Text
name = Text
"ImmutableByteArray.copyTo!"
       in if ConstructorId
l ConstructorId -> ConstructorId -> Bool
forall a. Eq a => a -> a -> Bool
== ConstructorId
0
            then Either (Failure Val) () -> IO (Either (Failure Val) ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either (Failure Val) ()
forall a b. b -> Either a b
Right ())
            else
              Text
-> Int
-> ConstructorId
-> ConstructorId
-> IO (Either (Failure Val) ())
-> IO (Either (Failure Val) ())
forall b.
Text
-> Int
-> ConstructorId
-> ConstructorId
-> IO (Either (Failure Val) b)
-> IO (Either (Failure Val) b)
checkBoundsPrim Text
name (MutableByteArray RealWorld -> Int
forall s. MutableByteArray s -> Int
PA.sizeofMutableByteArray MutableByteArray RealWorld
dst) (ConstructorId
doff ConstructorId -> ConstructorId -> ConstructorId
forall a. Num a => a -> a -> a
+ ConstructorId
l) ConstructorId
0 (IO (Either (Failure Val) ()) -> IO (Either (Failure Val) ()))
-> IO (Either (Failure Val) ()) -> IO (Either (Failure Val) ())
forall a b. (a -> b) -> a -> b
$
                Text
-> Int
-> ConstructorId
-> ConstructorId
-> IO (Either (Failure Val) ())
-> IO (Either (Failure Val) ())
forall b.
Text
-> Int
-> ConstructorId
-> ConstructorId
-> IO (Either (Failure Val) b)
-> IO (Either (Failure Val) b)
checkBoundsPrim Text
name (ByteArray -> Int
PA.sizeofByteArray ByteArray
src) (ConstructorId
soff ConstructorId -> ConstructorId -> ConstructorId
forall a. Num a => a -> a -> a
+ ConstructorId
l) ConstructorId
0 (IO (Either (Failure Val) ()) -> IO (Either (Failure Val) ()))
-> IO (Either (Failure Val) ()) -> IO (Either (Failure Val) ())
forall a b. (a -> b) -> a -> b
$
                  () -> Either (Failure Val) ()
forall a b. b -> Either a b
Right
                    (() -> Either (Failure Val) ())
-> IO () -> IO (Either (Failure Val) ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
(() :: Constraint, PrimMonad m) =>
MutableByteArray (PrimState m)
-> Int -> ByteArray -> Int -> Int -> m ()
PA.copyByteArray @IO
                      MutableByteArray RealWorld
MutableByteArray RW
dst
                      (ConstructorId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
doff)
                      ByteArray
src
                      (ConstructorId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
soff)
                      (ConstructorId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
l)
  ForeignFunc
MutableArray_read ->
    ((MutableArray RW Val, ConstructorId)
 -> IO (Either (Failure Val) Val))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((MutableArray RW Val, ConstructorId)
  -> IO (Either (Failure Val) Val))
 -> Args -> Stack -> IO Stack)
-> ((MutableArray RW Val, ConstructorId)
    -> IO (Either (Failure Val) Val))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
      Text
-> (MutableArray RW Val, ConstructorId)
-> IO (Either (Failure Val) Val)
checkedRead Text
"MutableArray.read"
  ForeignFunc
MutableByteArray_read8 ->
    ((MutableByteArray RW, ConstructorId)
 -> IO (Either (Failure Val) ConstructorId))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((MutableByteArray RW, ConstructorId)
  -> IO (Either (Failure Val) ConstructorId))
 -> Args -> Stack -> IO Stack)
-> ((MutableByteArray RW, ConstructorId)
    -> IO (Either (Failure Val) ConstructorId))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
      Text
-> (MutableByteArray RW, ConstructorId)
-> IO (Either (Failure Val) ConstructorId)
checkedRead8 Text
"MutableByteArray.read8"
  ForeignFunc
MutableByteArray_read16be ->
    ((MutableByteArray RW, ConstructorId)
 -> IO (Either (Failure Val) ConstructorId))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((MutableByteArray RW, ConstructorId)
  -> IO (Either (Failure Val) ConstructorId))
 -> Args -> Stack -> IO Stack)
-> ((MutableByteArray RW, ConstructorId)
    -> IO (Either (Failure Val) ConstructorId))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
      Text
-> (MutableByteArray RW, ConstructorId)
-> IO (Either (Failure Val) ConstructorId)
checkedRead16 Text
"MutableByteArray.read16be"
  ForeignFunc
MutableByteArray_read24be ->
    ((MutableByteArray RW, ConstructorId)
 -> IO (Either (Failure Val) ConstructorId))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((MutableByteArray RW, ConstructorId)
  -> IO (Either (Failure Val) ConstructorId))
 -> Args -> Stack -> IO Stack)
-> ((MutableByteArray RW, ConstructorId)
    -> IO (Either (Failure Val) ConstructorId))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
      Text
-> (MutableByteArray RW, ConstructorId)
-> IO (Either (Failure Val) ConstructorId)
checkedRead24 Text
"MutableByteArray.read24be"
  ForeignFunc
MutableByteArray_read32be ->
    ((MutableByteArray RW, ConstructorId)
 -> IO (Either (Failure Val) ConstructorId))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((MutableByteArray RW, ConstructorId)
  -> IO (Either (Failure Val) ConstructorId))
 -> Args -> Stack -> IO Stack)
-> ((MutableByteArray RW, ConstructorId)
    -> IO (Either (Failure Val) ConstructorId))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
      Text
-> (MutableByteArray RW, ConstructorId)
-> IO (Either (Failure Val) ConstructorId)
checkedRead32 Text
"MutableByteArray.read32be"
  ForeignFunc
MutableByteArray_read40be ->
    ((MutableByteArray RW, ConstructorId)
 -> IO (Either (Failure Val) ConstructorId))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((MutableByteArray RW, ConstructorId)
  -> IO (Either (Failure Val) ConstructorId))
 -> Args -> Stack -> IO Stack)
-> ((MutableByteArray RW, ConstructorId)
    -> IO (Either (Failure Val) ConstructorId))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
      Text
-> (MutableByteArray RW, ConstructorId)
-> IO (Either (Failure Val) ConstructorId)
checkedRead40 Text
"MutableByteArray.read40be"
  ForeignFunc
MutableByteArray_read64be ->
    ((MutableByteArray RW, ConstructorId)
 -> IO (Either (Failure Val) ConstructorId))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((MutableByteArray RW, ConstructorId)
  -> IO (Either (Failure Val) ConstructorId))
 -> Args -> Stack -> IO Stack)
-> ((MutableByteArray RW, ConstructorId)
    -> IO (Either (Failure Val) ConstructorId))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
      Text
-> (MutableByteArray RW, ConstructorId)
-> IO (Either (Failure Val) ConstructorId)
checkedRead64 Text
"MutableByteArray.read64be"
  ForeignFunc
MutableArray_write ->
    ((MutableArray RW Val, ConstructorId, Val)
 -> IO (Either (Failure Val) ()))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((MutableArray RW Val, ConstructorId, Val)
  -> IO (Either (Failure Val) ()))
 -> Args -> Stack -> IO Stack)
-> ((MutableArray RW Val, ConstructorId, Val)
    -> IO (Either (Failure Val) ()))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
      Text
-> (MutableArray RW Val, ConstructorId, Val)
-> IO (Either (Failure Val) ())
checkedWrite Text
"MutableArray.write"
  ForeignFunc
MutableByteArray_write8 ->
    ((MutableByteArray RW, ConstructorId, ConstructorId)
 -> IO (Either (Failure Val) ()))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((MutableByteArray RW, ConstructorId, ConstructorId)
  -> IO (Either (Failure Val) ()))
 -> Args -> Stack -> IO Stack)
-> ((MutableByteArray RW, ConstructorId, ConstructorId)
    -> IO (Either (Failure Val) ()))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
      Text
-> (MutableByteArray RW, ConstructorId, ConstructorId)
-> IO (Either (Failure Val) ())
checkedWrite8 Text
"MutableByteArray.write8"
  ForeignFunc
MutableByteArray_write16be ->
    ((MutableByteArray RW, ConstructorId, ConstructorId)
 -> IO (Either (Failure Val) ()))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((MutableByteArray RW, ConstructorId, ConstructorId)
  -> IO (Either (Failure Val) ()))
 -> Args -> Stack -> IO Stack)
-> ((MutableByteArray RW, ConstructorId, ConstructorId)
    -> IO (Either (Failure Val) ()))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
      Text
-> (MutableByteArray RW, ConstructorId, ConstructorId)
-> IO (Either (Failure Val) ())
checkedWrite16 Text
"MutableByteArray.write16be"
  ForeignFunc
MutableByteArray_write32be ->
    ((MutableByteArray RW, ConstructorId, ConstructorId)
 -> IO (Either (Failure Val) ()))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((MutableByteArray RW, ConstructorId, ConstructorId)
  -> IO (Either (Failure Val) ()))
 -> Args -> Stack -> IO Stack)
-> ((MutableByteArray RW, ConstructorId, ConstructorId)
    -> IO (Either (Failure Val) ()))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
      Text
-> (MutableByteArray RW, ConstructorId, ConstructorId)
-> IO (Either (Failure Val) ())
checkedWrite32 Text
"MutableByteArray.write32be"
  ForeignFunc
MutableByteArray_write64be ->
    ((MutableByteArray RW, ConstructorId, ConstructorId)
 -> IO (Either (Failure Val) ()))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((MutableByteArray RW, ConstructorId, ConstructorId)
  -> IO (Either (Failure Val) ()))
 -> Args -> Stack -> IO Stack)
-> ((MutableByteArray RW, ConstructorId, ConstructorId)
    -> IO (Either (Failure Val) ()))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
      Text
-> (MutableByteArray RW, ConstructorId, ConstructorId)
-> IO (Either (Failure Val) ())
checkedWrite64 Text
"MutableByteArray.write64be"
  ForeignFunc
ImmutableArray_read ->
    ((Array Val, ConstructorId) -> IO (Either (Failure Val) Val))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((Array Val, ConstructorId) -> IO (Either (Failure Val) Val))
 -> Args -> Stack -> IO Stack)
-> ((Array Val, ConstructorId) -> IO (Either (Failure Val) Val))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
      Text -> (Array Val, ConstructorId) -> IO (Either (Failure Val) Val)
checkedIndex Text
"ImmutableArray.read"
  ForeignFunc
ImmutableByteArray_read8 ->
    ((ByteArray, ConstructorId)
 -> IO (Either (Failure Val) ConstructorId))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((ByteArray, ConstructorId)
  -> IO (Either (Failure Val) ConstructorId))
 -> Args -> Stack -> IO Stack)
-> ((ByteArray, ConstructorId)
    -> IO (Either (Failure Val) ConstructorId))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
      Text
-> (ByteArray, ConstructorId)
-> IO (Either (Failure Val) ConstructorId)
checkedIndex8 Text
"ImmutableByteArray.read8"
  ForeignFunc
ImmutableByteArray_read16be ->
    ((ByteArray, ConstructorId)
 -> IO (Either (Failure Val) ConstructorId))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((ByteArray, ConstructorId)
  -> IO (Either (Failure Val) ConstructorId))
 -> Args -> Stack -> IO Stack)
-> ((ByteArray, ConstructorId)
    -> IO (Either (Failure Val) ConstructorId))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
      Text
-> (ByteArray, ConstructorId)
-> IO (Either (Failure Val) ConstructorId)
checkedIndex16 Text
"ImmutableByteArray.read16be"
  ForeignFunc
ImmutableByteArray_read24be ->
    ((ByteArray, ConstructorId)
 -> IO (Either (Failure Val) ConstructorId))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((ByteArray, ConstructorId)
  -> IO (Either (Failure Val) ConstructorId))
 -> Args -> Stack -> IO Stack)
-> ((ByteArray, ConstructorId)
    -> IO (Either (Failure Val) ConstructorId))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
      Text
-> (ByteArray, ConstructorId)
-> IO (Either (Failure Val) ConstructorId)
checkedIndex24 Text
"ImmutableByteArray.read24be"
  ForeignFunc
ImmutableByteArray_read32be ->
    ((ByteArray, ConstructorId)
 -> IO (Either (Failure Val) ConstructorId))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((ByteArray, ConstructorId)
  -> IO (Either (Failure Val) ConstructorId))
 -> Args -> Stack -> IO Stack)
-> ((ByteArray, ConstructorId)
    -> IO (Either (Failure Val) ConstructorId))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
      Text
-> (ByteArray, ConstructorId)
-> IO (Either (Failure Val) ConstructorId)
checkedIndex32 Text
"ImmutableByteArray.read32be"
  ForeignFunc
ImmutableByteArray_read40be ->
    ((ByteArray, ConstructorId)
 -> IO (Either (Failure Val) ConstructorId))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((ByteArray, ConstructorId)
  -> IO (Either (Failure Val) ConstructorId))
 -> Args -> Stack -> IO Stack)
-> ((ByteArray, ConstructorId)
    -> IO (Either (Failure Val) ConstructorId))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
      Text
-> (ByteArray, ConstructorId)
-> IO (Either (Failure Val) ConstructorId)
checkedIndex40 Text
"ImmutableByteArray.read40be"
  ForeignFunc
ImmutableByteArray_read64be ->
    ((ByteArray, ConstructorId)
 -> IO (Either (Failure Val) ConstructorId))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((ByteArray, ConstructorId)
  -> IO (Either (Failure Val) ConstructorId))
 -> Args -> Stack -> IO Stack)
-> ((ByteArray, ConstructorId)
    -> IO (Either (Failure Val) ConstructorId))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
      Text
-> (ByteArray, ConstructorId)
-> IO (Either (Failure Val) ConstructorId)
checkedIndex64 Text
"ImmutableByteArray.read64be"
  ForeignFunc
MutableByteArray_freeze_force ->
    (MutableByteArray RealWorld -> IO ByteArray)
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((MutableByteArray RealWorld -> IO ByteArray)
 -> Args -> Stack -> IO Stack)
-> (MutableByteArray RealWorld -> IO ByteArray)
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
      MutableByteArray RealWorld -> IO ByteArray
MutableByteArray RW -> IO ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PA.unsafeFreezeByteArray
  ForeignFunc
MutableArray_freeze_force ->
    (MutableArray RW Val -> IO (Array Val))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((MutableArray RW Val -> IO (Array Val))
 -> Args -> Stack -> IO Stack)
-> (MutableArray RW Val -> IO (Array Val))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
PA.unsafeFreezeArray @IO @Val
  ForeignFunc
MutableByteArray_freeze -> ((MutableByteArray RealWorld, ConstructorId, ConstructorId)
 -> IO (Either (Failure Val) ByteArray))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((MutableByteArray RealWorld, ConstructorId, ConstructorId)
  -> IO (Either (Failure Val) ByteArray))
 -> Args -> Stack -> IO Stack)
-> ((MutableByteArray RealWorld, ConstructorId, ConstructorId)
    -> IO (Either (Failure Val) ByteArray))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(MutableByteArray RealWorld
src, ConstructorId
off, ConstructorId
len) ->
      if ConstructorId
len ConstructorId -> ConstructorId -> Bool
forall a. Eq a => a -> a -> Bool
== ConstructorId
0
        then (ByteArray -> Either (Failure Val) ByteArray)
-> IO ByteArray -> IO (Either (Failure Val) ByteArray)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteArray -> Either (Failure Val) ByteArray
forall a b. b -> Either a b
Right (IO ByteArray -> IO (Either (Failure Val) ByteArray))
-> (MutableByteArray RealWorld -> IO ByteArray)
-> MutableByteArray RealWorld
-> IO (Either (Failure Val) ByteArray)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MutableByteArray RealWorld -> IO ByteArray
MutableByteArray RW -> IO ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PA.unsafeFreezeByteArray (MutableByteArray RealWorld -> IO (Either (Failure Val) ByteArray))
-> IO (MutableByteArray RealWorld)
-> IO (Either (Failure Val) ByteArray)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> IO (MutableByteArray RW)
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PA.newByteArray Int
0
        else
          Text
-> Int
-> ConstructorId
-> ConstructorId
-> IO (Either (Failure Val) ByteArray)
-> IO (Either (Failure Val) ByteArray)
forall b.
Text
-> Int
-> ConstructorId
-> ConstructorId
-> IO (Either (Failure Val) b)
-> IO (Either (Failure Val) b)
checkBoundsPrim
            Text
"MutableByteArray.freeze"
            (MutableByteArray RealWorld -> Int
forall s. MutableByteArray s -> Int
PA.sizeofMutableByteArray MutableByteArray RealWorld
src)
            (ConstructorId
off ConstructorId -> ConstructorId -> ConstructorId
forall a. Num a => a -> a -> a
+ ConstructorId
len)
            ConstructorId
0
            (IO (Either (Failure Val) ByteArray)
 -> IO (Either (Failure Val) ByteArray))
-> IO (Either (Failure Val) ByteArray)
-> IO (Either (Failure Val) ByteArray)
forall a b. (a -> b) -> a -> b
$ ByteArray -> Either (Failure Val) ByteArray
forall a b. b -> Either a b
Right (ByteArray -> Either (Failure Val) ByteArray)
-> IO ByteArray -> IO (Either (Failure Val) ByteArray)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutableByteArray RW -> Int -> Int -> IO ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Int -> m ByteArray
PA.freezeByteArray MutableByteArray RealWorld
MutableByteArray RW
src (ConstructorId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
off) (ConstructorId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
len)
  ForeignFunc
MutableArray_freeze -> ((MutableArray RealWorld Val, ConstructorId, ConstructorId)
 -> IO (Either (Failure Val) (Array Val)))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((MutableArray RealWorld Val, ConstructorId, ConstructorId)
  -> IO (Either (Failure Val) (Array Val)))
 -> Args -> Stack -> IO Stack)
-> ((MutableArray RealWorld Val, ConstructorId, ConstructorId)
    -> IO (Either (Failure Val) (Array Val)))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(MutableArray RealWorld Val
src :: PA.MutableArray PA.RealWorld Val, ConstructorId
off, ConstructorId
len) ->
      if ConstructorId
len ConstructorId -> ConstructorId -> Bool
forall a. Eq a => a -> a -> Bool
== ConstructorId
0
        then (Array Val -> Either (Failure Val) (Array Val))
-> IO (Array Val) -> IO (Either (Failure Val) (Array Val))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Array Val -> Either (Failure Val) (Array Val)
forall a b. b -> Either a b
Right (IO (Array Val) -> IO (Either (Failure Val) (Array Val)))
-> (MutableArray RealWorld Val -> IO (Array Val))
-> MutableArray RealWorld Val
-> IO (Either (Failure Val) (Array Val))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MutableArray RealWorld Val -> IO (Array Val)
MutableArray RW Val -> IO (Array Val)
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
PA.unsafeFreezeArray (MutableArray RealWorld Val
 -> IO (Either (Failure Val) (Array Val)))
-> IO (MutableArray RealWorld Val)
-> IO (Either (Failure Val) (Array Val))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> Val -> IO (MutableArray RW Val)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
PA.newArray Int
0 Val
emptyVal
        else
          Text
-> Int
-> ConstructorId
-> IO (Either (Failure Val) (Array Val))
-> IO (Either (Failure Val) (Array Val))
forall b.
Text
-> Int
-> ConstructorId
-> IO (Either (Failure Val) b)
-> IO (Either (Failure Val) b)
checkBounds
            Text
"MutableArray.freeze"
            (MutableArray RealWorld Val -> Int
forall s a. MutableArray s a -> Int
PA.sizeofMutableArray MutableArray RealWorld Val
src)
            (ConstructorId
off ConstructorId -> ConstructorId -> ConstructorId
forall a. Num a => a -> a -> a
+ ConstructorId
len ConstructorId -> ConstructorId -> ConstructorId
forall a. Num a => a -> a -> a
- ConstructorId
1)
            (IO (Either (Failure Val) (Array Val))
 -> IO (Either (Failure Val) (Array Val)))
-> IO (Either (Failure Val) (Array Val))
-> IO (Either (Failure Val) (Array Val))
forall a b. (a -> b) -> a -> b
$ Array Val -> Either (Failure Val) (Array Val)
forall a b. b -> Either a b
Right (Array Val -> Either (Failure Val) (Array Val))
-> IO (Array Val) -> IO (Either (Failure Val) (Array Val))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutableArray RW Val -> Int -> Int -> IO (Array Val)
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> Int -> m (Array a)
PA.freezeArray MutableArray RealWorld Val
MutableArray RW Val
src (ConstructorId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
off) (ConstructorId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
len)
  ForeignFunc
MutableByteArray_length ->
    (MutableByteArray RealWorld -> IO Int) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((MutableByteArray RealWorld -> IO Int)
 -> Args -> Stack -> IO Stack)
-> (MutableByteArray RealWorld -> IO Int)
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
      Int -> IO Int
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> IO Int)
-> (MutableByteArray RealWorld -> Int)
-> MutableByteArray RealWorld
-> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. MutableByteArray s -> Int
PA.sizeofMutableByteArray @PA.RealWorld
  ForeignFunc
ImmutableByteArray_length ->
    (ByteArray -> IO Int) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((ByteArray -> IO Int) -> Args -> Stack -> IO Stack)
-> (ByteArray -> IO Int) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
      Int -> IO Int
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> IO Int) -> (ByteArray -> Int) -> ByteArray -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteArray -> Int
PA.sizeofByteArray
  ForeignFunc
IO_array -> (Int -> IO (MutableArray RealWorld Val))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Int -> IO (MutableArray RealWorld Val))
 -> Args -> Stack -> IO Stack)
-> (Int -> IO (MutableArray RealWorld Val))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
    \Int
n -> Int -> Val -> IO (MutableArray RW Val)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
PA.newArray Int
n Val
emptyVal
  ForeignFunc
IO_arrayOf -> ((Val, Int) -> IO (MutableArray RealWorld Val))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((Val, Int) -> IO (MutableArray RealWorld Val))
 -> Args -> Stack -> IO Stack)
-> ((Val, Int) -> IO (MutableArray RealWorld Val))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(Val
v :: Val, Int
n) -> Int -> Val -> IO (MutableArray RW Val)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
PA.newArray Int
n Val
v
  ForeignFunc
IO_bytearray -> (Int -> IO (MutableByteArray RealWorld))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Int -> IO (MutableByteArray RealWorld))
 -> Args -> Stack -> IO Stack)
-> (Int -> IO (MutableByteArray RealWorld))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$ Int -> IO (MutableByteArray RealWorld)
Int -> IO (MutableByteArray RW)
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PA.newByteArray
  ForeignFunc
IO_bytearrayOf -> ((Word8, Int) -> IO (MutableByteArray RealWorld))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((Word8, Int) -> IO (MutableByteArray RealWorld))
 -> Args -> Stack -> IO Stack)
-> ((Word8, Int) -> IO (MutableByteArray RealWorld))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(Word8
init, Int
sz) -> do
      MutableByteArray RealWorld
arr <- Int -> IO (MutableByteArray RW)
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PA.newByteArray Int
sz
      MutableByteArray RW -> Int -> Int -> Word8 -> IO ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Int -> Word8 -> m ()
PA.fillByteArray MutableByteArray RealWorld
MutableByteArray RW
arr Int
0 Int
sz Word8
init
      pure MutableByteArray RealWorld
arr
  ForeignFunc
Scope_array -> (Int -> IO (MutableArray RealWorld Val))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Int -> IO (MutableArray RealWorld Val))
 -> Args -> Stack -> IO Stack)
-> (Int -> IO (MutableArray RealWorld Val))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
    \Int
n -> Int -> Val -> IO (MutableArray RW Val)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
PA.newArray Int
n Val
emptyVal
  ForeignFunc
Scope_arrayOf -> ((Val, Int) -> IO (MutableArray RealWorld Val))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((Val, Int) -> IO (MutableArray RealWorld Val))
 -> Args -> Stack -> IO Stack)
-> ((Val, Int) -> IO (MutableArray RealWorld Val))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(Val
v :: Val, Int
n) -> Int -> Val -> IO (MutableArray RW Val)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
PA.newArray Int
n Val
v
  ForeignFunc
Scope_bytearray -> (Int -> IO (MutableByteArray RealWorld))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Int -> IO (MutableByteArray RealWorld))
 -> Args -> Stack -> IO Stack)
-> (Int -> IO (MutableByteArray RealWorld))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$ Int -> IO (MutableByteArray RealWorld)
Int -> IO (MutableByteArray RW)
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PA.newByteArray
  ForeignFunc
Scope_bytearrayOf -> ((Word8, Int) -> IO (MutableByteArray RealWorld))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((Word8, Int) -> IO (MutableByteArray RealWorld))
 -> Args -> Stack -> IO Stack)
-> ((Word8, Int) -> IO (MutableByteArray RealWorld))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(Word8
init, Int
sz) -> do
      MutableByteArray RealWorld
arr <- Int -> IO (MutableByteArray RW)
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PA.newByteArray Int
sz
      MutableByteArray RW -> Int -> Int -> Word8 -> IO ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Int -> Word8 -> m ()
PA.fillByteArray MutableByteArray RealWorld
MutableByteArray RW
arr Int
0 Int
sz Word8
init
      pure MutableByteArray RealWorld
arr
  ForeignFunc
Text_patterns_literal -> (Text -> IO CPattern) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((Text -> IO CPattern) -> Args -> Stack -> IO Stack)
-> (Text -> IO CPattern) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \Text
txt -> CPattern -> IO CPattern
forall a. a -> IO a
evaluate (CPattern -> IO CPattern)
-> (Pattern -> CPattern) -> Pattern -> IO CPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> CPattern
TPat.cpattern (Pattern -> IO CPattern) -> Pattern -> IO CPattern
forall a b. (a -> b) -> a -> b
$ Text -> Pattern
TPat.Literal Text
txt
  ForeignFunc
Text_patterns_digit ->
    (() -> IO CPattern) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((() -> IO CPattern) -> Args -> Stack -> IO Stack)
-> (() -> IO CPattern) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
      let v :: CPattern
v = Pattern -> CPattern
TPat.cpattern (CharPattern -> Pattern
TPat.Char (Char -> Char -> CharPattern
TPat.CharRange Char
'0' Char
'9')) in \() -> CPattern -> IO CPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CPattern
v
  ForeignFunc
Text_patterns_letter ->
    (() -> IO CPattern) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((() -> IO CPattern) -> Args -> Stack -> IO Stack)
-> (() -> IO CPattern) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
      let v :: CPattern
v = Pattern -> CPattern
TPat.cpattern (CharPattern -> Pattern
TPat.Char (CharClass -> CharPattern
TPat.CharClass CharClass
TPat.Letter)) in \() -> CPattern -> IO CPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CPattern
v
  ForeignFunc
Text_patterns_space ->
    (() -> IO CPattern) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((() -> IO CPattern) -> Args -> Stack -> IO Stack)
-> (() -> IO CPattern) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
      let v :: CPattern
v = Pattern -> CPattern
TPat.cpattern (CharPattern -> Pattern
TPat.Char (CharClass -> CharPattern
TPat.CharClass CharClass
TPat.Whitespace)) in \() -> CPattern -> IO CPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CPattern
v
  ForeignFunc
Text_patterns_punctuation ->
    (() -> IO CPattern) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((() -> IO CPattern) -> Args -> Stack -> IO Stack)
-> (() -> IO CPattern) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
      let v :: CPattern
v = Pattern -> CPattern
TPat.cpattern (CharPattern -> Pattern
TPat.Char (CharClass -> CharPattern
TPat.CharClass CharClass
TPat.Punctuation)) in \() -> CPattern -> IO CPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CPattern
v
  ForeignFunc
Text_patterns_anyChar ->
    (() -> IO CPattern) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((() -> IO CPattern) -> Args -> Stack -> IO Stack)
-> (() -> IO CPattern) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
      let v :: CPattern
v = Pattern -> CPattern
TPat.cpattern (CharPattern -> Pattern
TPat.Char CharPattern
TPat.Any) in \() -> CPattern -> IO CPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CPattern
v
  ForeignFunc
Text_patterns_eof ->
    (() -> IO CPattern) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((() -> IO CPattern) -> Args -> Stack -> IO Stack)
-> (() -> IO CPattern) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
      let v :: CPattern
v = Pattern -> CPattern
TPat.cpattern Pattern
TPat.Eof in \() -> CPattern -> IO CPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CPattern
v
  ForeignFunc
Text_patterns_charRange -> ((Char, Char) -> IO CPattern) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((Char, Char) -> IO CPattern) -> Args -> Stack -> IO Stack)
-> ((Char, Char) -> IO CPattern) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(Char
beg, Char
end) -> CPattern -> IO CPattern
forall a. a -> IO a
evaluate (CPattern -> IO CPattern)
-> (CharPattern -> CPattern) -> CharPattern -> IO CPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> CPattern
TPat.cpattern (Pattern -> CPattern)
-> (CharPattern -> Pattern) -> CharPattern -> CPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharPattern -> Pattern
TPat.Char (CharPattern -> IO CPattern) -> CharPattern -> IO CPattern
forall a b. (a -> b) -> a -> b
$ Char -> Char -> CharPattern
TPat.CharRange Char
beg Char
end
  ForeignFunc
Text_patterns_notCharRange -> ((Char, Char) -> IO CPattern) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((Char, Char) -> IO CPattern) -> Args -> Stack -> IO Stack)
-> ((Char, Char) -> IO CPattern) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(Char
beg, Char
end) -> CPattern -> IO CPattern
forall a. a -> IO a
evaluate (CPattern -> IO CPattern)
-> (CharPattern -> CPattern) -> CharPattern -> IO CPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> CPattern
TPat.cpattern (Pattern -> CPattern)
-> (CharPattern -> Pattern) -> CharPattern -> CPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharPattern -> Pattern
TPat.Char (CharPattern -> Pattern)
-> (CharPattern -> CharPattern) -> CharPattern -> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharPattern -> CharPattern
TPat.Not (CharPattern -> IO CPattern) -> CharPattern -> IO CPattern
forall a b. (a -> b) -> a -> b
$ Char -> Char -> CharPattern
TPat.CharRange Char
beg Char
end
  ForeignFunc
Text_patterns_charIn -> ([Val] -> IO CPattern) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (([Val] -> IO CPattern) -> Args -> Stack -> IO Stack)
-> ([Val] -> IO CPattern) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ \[Val]
ccs -> do
    String
cs <- [Val] -> (Val -> IO Char) -> IO String
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Val]
ccs ((Val -> IO Char) -> IO String) -> (Val -> IO Char) -> IO String
forall a b. (a -> b) -> a -> b
$ \case
      CharVal Char
c -> Char -> IO Char
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
c
      Val
_ -> String -> IO Char
forall a. HasCallStack => String -> IO a
die String
"Text.patterns.charIn: non-character closure"
    CPattern -> IO CPattern
forall a. a -> IO a
evaluate (CPattern -> IO CPattern)
-> (CharPattern -> CPattern) -> CharPattern -> IO CPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> CPattern
TPat.cpattern (Pattern -> CPattern)
-> (CharPattern -> Pattern) -> CharPattern -> CPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharPattern -> Pattern
TPat.Char (CharPattern -> IO CPattern) -> CharPattern -> IO CPattern
forall a b. (a -> b) -> a -> b
$ String -> CharPattern
TPat.CharSet String
cs
  ForeignFunc
Text_patterns_notCharIn -> ([Val] -> IO CPattern) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (([Val] -> IO CPattern) -> Args -> Stack -> IO Stack)
-> ([Val] -> IO CPattern) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ \[Val]
ccs -> do
    String
cs <- [Val] -> (Val -> IO Char) -> IO String
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Val]
ccs ((Val -> IO Char) -> IO String) -> (Val -> IO Char) -> IO String
forall a b. (a -> b) -> a -> b
$ \case
      CharVal Char
c -> Char -> IO Char
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
c
      Val
_ -> String -> IO Char
forall a. HasCallStack => String -> IO a
die String
"Text.patterns.notCharIn: non-character closure"
    CPattern -> IO CPattern
forall a. a -> IO a
evaluate (CPattern -> IO CPattern)
-> (CharPattern -> CPattern) -> CharPattern -> IO CPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> CPattern
TPat.cpattern (Pattern -> CPattern)
-> (CharPattern -> Pattern) -> CharPattern -> CPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharPattern -> Pattern
TPat.Char (CharPattern -> Pattern)
-> (CharPattern -> CharPattern) -> CharPattern -> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharPattern -> CharPattern
TPat.Not (CharPattern -> IO CPattern) -> CharPattern -> IO CPattern
forall a b. (a -> b) -> a -> b
$ String -> CharPattern
TPat.CharSet String
cs
  ForeignFunc
Pattern_many -> (CPattern -> IO CPattern) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((CPattern -> IO CPattern) -> Args -> Stack -> IO Stack)
-> (CPattern -> IO CPattern) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(TPat.CP Pattern
p Text -> Maybe ([Text], Text)
_) -> CPattern -> IO CPattern
forall a. a -> IO a
evaluate (CPattern -> IO CPattern)
-> (Pattern -> CPattern) -> Pattern -> IO CPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> CPattern
TPat.cpattern (Pattern -> IO CPattern) -> Pattern -> IO CPattern
forall a b. (a -> b) -> a -> b
$ Bool -> Pattern -> Pattern
TPat.Many Bool
False Pattern
p
  ForeignFunc
Pattern_many_corrected -> (CPattern -> IO CPattern) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((CPattern -> IO CPattern) -> Args -> Stack -> IO Stack)
-> (CPattern -> IO CPattern) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(TPat.CP Pattern
p Text -> Maybe ([Text], Text)
_) -> CPattern -> IO CPattern
forall a. a -> IO a
evaluate (CPattern -> IO CPattern)
-> (Pattern -> CPattern) -> Pattern -> IO CPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> CPattern
TPat.cpattern (Pattern -> IO CPattern) -> Pattern -> IO CPattern
forall a b. (a -> b) -> a -> b
$ Bool -> Pattern -> Pattern
TPat.Many Bool
True Pattern
p
  ForeignFunc
Pattern_capture -> (CPattern -> IO CPattern) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((CPattern -> IO CPattern) -> Args -> Stack -> IO Stack)
-> (CPattern -> IO CPattern) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(TPat.CP Pattern
p Text -> Maybe ([Text], Text)
_) -> CPattern -> IO CPattern
forall a. a -> IO a
evaluate (CPattern -> IO CPattern)
-> (Pattern -> CPattern) -> Pattern -> IO CPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> CPattern
TPat.cpattern (Pattern -> IO CPattern) -> Pattern -> IO CPattern
forall a b. (a -> b) -> a -> b
$ Pattern -> Pattern
TPat.Capture Pattern
p
  ForeignFunc
Pattern_captureAs -> ((Text, CPattern) -> IO CPattern) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((Text, CPattern) -> IO CPattern) -> Args -> Stack -> IO Stack)
-> ((Text, CPattern) -> IO CPattern) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(Text
t, (TPat.CP Pattern
p Text -> Maybe ([Text], Text)
_)) -> CPattern -> IO CPattern
forall a. a -> IO a
evaluate (CPattern -> IO CPattern)
-> (Pattern -> CPattern) -> Pattern -> IO CPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> CPattern
TPat.cpattern (Pattern -> IO CPattern) -> Pattern -> IO CPattern
forall a b. (a -> b) -> a -> b
$ Text -> Pattern -> Pattern
TPat.CaptureAs Text
t Pattern
p
  ForeignFunc
Pattern_join -> ([CPattern] -> IO CPattern) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (([CPattern] -> IO CPattern) -> Args -> Stack -> IO Stack)
-> ([CPattern] -> IO CPattern) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ \[CPattern]
ps ->
    CPattern -> IO CPattern
forall a. a -> IO a
evaluate (CPattern -> IO CPattern)
-> ([Pattern] -> CPattern) -> [Pattern] -> IO CPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> CPattern
TPat.cpattern (Pattern -> CPattern)
-> ([Pattern] -> Pattern) -> [Pattern] -> CPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pattern] -> Pattern
TPat.Join ([Pattern] -> IO CPattern) -> [Pattern] -> IO CPattern
forall a b. (a -> b) -> a -> b
$ (CPattern -> Pattern) -> [CPattern] -> [Pattern]
forall a b. (a -> b) -> [a] -> [b]
map (\(TPat.CP Pattern
p Text -> Maybe ([Text], Text)
_) -> Pattern
p) [CPattern]
ps
  ForeignFunc
Pattern_or -> ((CPattern, CPattern) -> IO CPattern) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((CPattern, CPattern) -> IO CPattern)
 -> Args -> Stack -> IO Stack)
-> ((CPattern, CPattern) -> IO CPattern)
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(TPat.CP Pattern
l Text -> Maybe ([Text], Text)
_, TPat.CP Pattern
r Text -> Maybe ([Text], Text)
_) -> CPattern -> IO CPattern
forall a. a -> IO a
evaluate (CPattern -> IO CPattern)
-> (Pattern -> CPattern) -> Pattern -> IO CPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> CPattern
TPat.cpattern (Pattern -> IO CPattern) -> Pattern -> IO CPattern
forall a b. (a -> b) -> a -> b
$ Pattern -> Pattern -> Pattern
TPat.Or Pattern
l Pattern
r
  ForeignFunc
Pattern_replicate -> ((ConstructorId, ConstructorId, CPattern) -> IO CPattern)
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((ConstructorId, ConstructorId, CPattern) -> IO CPattern)
 -> Args -> Stack -> IO Stack)
-> ((ConstructorId, ConstructorId, CPattern) -> IO CPattern)
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(ConstructorId
m0 :: Word64, ConstructorId
n0 :: Word64, TPat.CP Pattern
p Text -> Maybe ([Text], Text)
_) ->
      let m :: Int
m = ConstructorId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
m0; n :: Int
n = ConstructorId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
n0
       in CPattern -> IO CPattern
forall a. a -> IO a
evaluate (CPattern -> IO CPattern)
-> (Pattern -> CPattern) -> Pattern -> IO CPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> CPattern
TPat.cpattern (Pattern -> IO CPattern) -> Pattern -> IO CPattern
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Pattern -> Pattern
TPat.Replicate Int
m Int
n Pattern
p
  ForeignFunc
Pattern_run -> ((CPattern, Text) -> IO (Maybe ([Text], Text)))
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((CPattern, Text) -> IO (Maybe ([Text], Text)))
 -> Args -> Stack -> IO Stack)
-> ((CPattern, Text) -> IO (Maybe ([Text], Text)))
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(TPat.CP Pattern
_ Text -> Maybe ([Text], Text)
matcher, Text
input :: Text) -> Maybe ([Text], Text) -> IO (Maybe ([Text], Text))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ([Text], Text) -> IO (Maybe ([Text], Text)))
-> Maybe ([Text], Text) -> IO (Maybe ([Text], Text))
forall a b. (a -> b) -> a -> b
$ Text -> Maybe ([Text], Text)
matcher Text
input
  ForeignFunc
Pattern_isMatch -> ((CPattern, Text) -> IO Bool) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((CPattern, Text) -> IO Bool) -> Args -> Stack -> IO Stack)
-> ((CPattern, Text) -> IO Bool) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$
    \(TPat.CP Pattern
_ Text -> Maybe ([Text], Text)
matcher, Text
input :: Text) -> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool)
-> (Maybe ([Text], Text) -> Bool)
-> Maybe ([Text], Text)
-> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe ([Text], Text) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe ([Text], Text) -> IO Bool)
-> Maybe ([Text], Text) -> IO Bool
forall a b. (a -> b) -> a -> b
$ Text -> Maybe ([Text], Text)
matcher Text
input
  ForeignFunc
Char_Class_any -> (() -> IO CharPattern) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((() -> IO CharPattern) -> Args -> Stack -> IO Stack)
-> (() -> IO CharPattern) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ \() -> CharPattern -> IO CharPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CharPattern
TPat.Any
  ForeignFunc
Char_Class_not -> (CharPattern -> IO CharPattern) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((CharPattern -> IO CharPattern) -> Args -> Stack -> IO Stack)
-> (CharPattern -> IO CharPattern) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ CharPattern -> IO CharPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CharPattern -> IO CharPattern)
-> (CharPattern -> CharPattern) -> CharPattern -> IO CharPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharPattern -> CharPattern
TPat.Not
  ForeignFunc
Char_Class_and -> ((CharPattern, CharPattern) -> IO CharPattern)
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((CharPattern, CharPattern) -> IO CharPattern)
 -> Args -> Stack -> IO Stack)
-> ((CharPattern, CharPattern) -> IO CharPattern)
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$ \(CharPattern
a, CharPattern
b) -> CharPattern -> IO CharPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CharPattern -> IO CharPattern) -> CharPattern -> IO CharPattern
forall a b. (a -> b) -> a -> b
$ CharPattern -> CharPattern -> CharPattern
TPat.Intersect CharPattern
a CharPattern
b
  ForeignFunc
Char_Class_or -> ((CharPattern, CharPattern) -> IO CharPattern)
-> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((CharPattern, CharPattern) -> IO CharPattern)
 -> Args -> Stack -> IO Stack)
-> ((CharPattern, CharPattern) -> IO CharPattern)
-> Args
-> Stack
-> IO Stack
forall a b. (a -> b) -> a -> b
$ \(CharPattern
a, CharPattern
b) -> CharPattern -> IO CharPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CharPattern -> IO CharPattern) -> CharPattern -> IO CharPattern
forall a b. (a -> b) -> a -> b
$ CharPattern -> CharPattern -> CharPattern
TPat.Union CharPattern
a CharPattern
b
  ForeignFunc
Char_Class_range -> ((Char, Char) -> IO CharPattern) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((Char, Char) -> IO CharPattern) -> Args -> Stack -> IO Stack)
-> ((Char, Char) -> IO CharPattern) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ \(Char
a, Char
b) -> CharPattern -> IO CharPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CharPattern -> IO CharPattern) -> CharPattern -> IO CharPattern
forall a b. (a -> b) -> a -> b
$ Char -> Char -> CharPattern
TPat.CharRange Char
a Char
b
  ForeignFunc
Char_Class_anyOf -> ([Val] -> IO CharPattern) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (([Val] -> IO CharPattern) -> Args -> Stack -> IO Stack)
-> ([Val] -> IO CharPattern) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ \[Val]
ccs -> do
    String
cs <- [Val] -> (Val -> IO Char) -> IO String
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Val]
ccs ((Val -> IO Char) -> IO String) -> (Val -> IO Char) -> IO String
forall a b. (a -> b) -> a -> b
$ \case
      CharVal Char
c -> Char -> IO Char
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
c
      Val
_ -> String -> IO Char
forall a. HasCallStack => String -> IO a
die String
"Text.patterns.charIn: non-character closure"
    CharPattern -> IO CharPattern
forall a. a -> IO a
evaluate (CharPattern -> IO CharPattern) -> CharPattern -> IO CharPattern
forall a b. (a -> b) -> a -> b
$ String -> CharPattern
TPat.CharSet String
cs
  ForeignFunc
Char_Class_alphanumeric -> (() -> IO CharPattern) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((() -> IO CharPattern) -> Args -> Stack -> IO Stack)
-> (() -> IO CharPattern) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ \() -> CharPattern -> IO CharPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CharClass -> CharPattern
TPat.CharClass CharClass
TPat.AlphaNum)
  ForeignFunc
Char_Class_upper -> (() -> IO CharPattern) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((() -> IO CharPattern) -> Args -> Stack -> IO Stack)
-> (() -> IO CharPattern) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ \() -> CharPattern -> IO CharPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CharClass -> CharPattern
TPat.CharClass CharClass
TPat.Upper)
  ForeignFunc
Char_Class_lower -> (() -> IO CharPattern) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((() -> IO CharPattern) -> Args -> Stack -> IO Stack)
-> (() -> IO CharPattern) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ \() -> CharPattern -> IO CharPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CharClass -> CharPattern
TPat.CharClass CharClass
TPat.Lower)
  ForeignFunc
Char_Class_whitespace -> (() -> IO CharPattern) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((() -> IO CharPattern) -> Args -> Stack -> IO Stack)
-> (() -> IO CharPattern) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ \() -> CharPattern -> IO CharPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CharClass -> CharPattern
TPat.CharClass CharClass
TPat.Whitespace)
  ForeignFunc
Char_Class_control -> (() -> IO CharPattern) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((() -> IO CharPattern) -> Args -> Stack -> IO Stack)
-> (() -> IO CharPattern) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ \() -> CharPattern -> IO CharPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CharClass -> CharPattern
TPat.CharClass CharClass
TPat.Control)
  ForeignFunc
Char_Class_printable -> (() -> IO CharPattern) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((() -> IO CharPattern) -> Args -> Stack -> IO Stack)
-> (() -> IO CharPattern) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ \() -> CharPattern -> IO CharPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CharClass -> CharPattern
TPat.CharClass CharClass
TPat.Printable)
  ForeignFunc
Char_Class_mark -> (() -> IO CharPattern) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((() -> IO CharPattern) -> Args -> Stack -> IO Stack)
-> (() -> IO CharPattern) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ \() -> CharPattern -> IO CharPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CharClass -> CharPattern
TPat.CharClass CharClass
TPat.MarkChar)
  ForeignFunc
Char_Class_number -> (() -> IO CharPattern) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((() -> IO CharPattern) -> Args -> Stack -> IO Stack)
-> (() -> IO CharPattern) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ \() -> CharPattern -> IO CharPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CharClass -> CharPattern
TPat.CharClass CharClass
TPat.Number)
  ForeignFunc
Char_Class_punctuation -> (() -> IO CharPattern) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((() -> IO CharPattern) -> Args -> Stack -> IO Stack)
-> (() -> IO CharPattern) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ \() -> CharPattern -> IO CharPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CharClass -> CharPattern
TPat.CharClass CharClass
TPat.Punctuation)
  ForeignFunc
Char_Class_symbol -> (() -> IO CharPattern) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((() -> IO CharPattern) -> Args -> Stack -> IO Stack)
-> (() -> IO CharPattern) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ \() -> CharPattern -> IO CharPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CharClass -> CharPattern
TPat.CharClass CharClass
TPat.Symbol)
  ForeignFunc
Char_Class_separator -> (() -> IO CharPattern) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((() -> IO CharPattern) -> Args -> Stack -> IO Stack)
-> (() -> IO CharPattern) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ \() -> CharPattern -> IO CharPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CharClass -> CharPattern
TPat.CharClass CharClass
TPat.Separator)
  ForeignFunc
Char_Class_letter -> (() -> IO CharPattern) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((() -> IO CharPattern) -> Args -> Stack -> IO Stack)
-> (() -> IO CharPattern) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ \() -> CharPattern -> IO CharPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CharClass -> CharPattern
TPat.CharClass CharClass
TPat.Letter)
  ForeignFunc
Char_Class_is -> ((CharPattern, Char) -> IO Bool) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign (((CharPattern, Char) -> IO Bool) -> Args -> Stack -> IO Stack)
-> ((CharPattern, Char) -> IO Bool) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ \(CharPattern
cl, Char
c) -> Bool -> IO Bool
forall a. a -> IO a
evaluate (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ CharPattern -> Char -> Bool
TPat.charPatternPred CharPattern
cl Char
c
  ForeignFunc
Text_patterns_char -> (CharPattern -> IO CPattern) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((CharPattern -> IO CPattern) -> Args -> Stack -> IO Stack)
-> (CharPattern -> IO CPattern) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ \CharPattern
c ->
    let v :: CPattern
v = Pattern -> CPattern
TPat.cpattern (CharPattern -> Pattern
TPat.Char CharPattern
c) in CPattern -> IO CPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CPattern
v
  where
    chop :: String -> String
chop = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isPathSeparator (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse

    hostPreference :: Maybe Util.Text.Text -> SYS.HostPreference
    hostPreference :: Maybe Text -> HostPreference
hostPreference Maybe Text
Nothing = HostPreference
SYS.HostAny
    hostPreference (Just Text
host) = String -> HostPreference
SYS.Host (String -> HostPreference) -> String -> HostPreference
forall a b. (a -> b) -> a -> b
$ Text -> String
Util.Text.unpack Text
host

    mx :: Word64
    mx :: ConstructorId
mx = Int -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
forall a. Bounded a => a
maxBound :: Int)

    customDelay :: Word64 -> IO ()
    customDelay :: ConstructorId -> IO ()
customDelay ConstructorId
n
      | ConstructorId
n ConstructorId -> ConstructorId -> Bool
forall a. Ord a => a -> a -> Bool
< ConstructorId
mx = Int -> IO ()
threadDelay (ConstructorId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
n)
      | Bool
otherwise = Int -> IO ()
threadDelay Int
forall a. Bounded a => a
maxBound IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConstructorId -> IO ()
customDelay (ConstructorId
n ConstructorId -> ConstructorId -> ConstructorId
forall a. Num a => a -> a -> a
- ConstructorId
mx)

    exitDecode :: ExitCode -> Int
exitDecode ExitCode
ExitSuccess = Int
0
    exitDecode (ExitFailure Int
n) = Int
n

    catchAll :: (MonadCatch m, MonadIO m, NFData a) => m a -> m (Either Util.Text.Text a)
    catchAll :: forall (m :: * -> *) a.
(MonadCatch m, MonadIO m, NFData a) =>
m a -> m (Either Text a)
catchAll m a
e = do
      Either SomeException a
e <- m a -> m (Either SomeException a)
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m, MonadIO m, NFData a) =>
m a -> m (Either SomeException a)
Exception.tryAnyDeep m a
e
      pure $ case Either SomeException a
e of
        Left SomeException
se -> Text -> Either Text a
forall a b. a -> Either a b
Left (String -> Text
Util.Text.pack (SomeException -> String
forall a. Show a => a -> String
show SomeException
se))
        Right a
a -> a -> Either Text a
forall a b. b -> Either a b
Right a
a

{-# INLINE mkHashAlgorithm #-}
mkHashAlgorithm :: forall alg. (Hash.HashAlgorithm alg) => Data.Text.Text -> alg -> Args -> Stack -> IO Stack
mkHashAlgorithm :: forall alg.
HashAlgorithm alg =>
Text -> alg -> Args -> Stack -> IO Stack
mkHashAlgorithm Text
txt alg
alg =
  let algoRef :: Reference
algoRef = Text -> Reference
forall t h. t -> Reference' t h
Builtin (Text
"crypto.HashAlgorithm." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
txt)
   in (() -> IO HashAlgorithm) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((() -> IO HashAlgorithm) -> Args -> Stack -> IO Stack)
-> (() -> IO HashAlgorithm) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ \() -> HashAlgorithm -> IO HashAlgorithm
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Reference -> alg -> HashAlgorithm
forall a. HashAlgorithm a => Reference -> a -> HashAlgorithm
HashAlgorithm Reference
algoRef alg
alg)

{-# INLINE mkForeign #-}
mkForeign :: (ForeignConvention a, ForeignConvention b) => (a -> IO b) -> Args -> Stack -> IO Stack
mkForeign :: forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign !a -> IO b
f !Args
args !Stack
stk = do
  a
args <- Args -> Stack -> IO a
forall x. ForeignConvention x => Args -> Stack -> IO x
decodeArgs Args
args Stack
stk
  b
res <- a -> IO b
f a
args
  Stack -> b -> IO Stack
forall a. ForeignConvention a => Stack -> a -> IO Stack
writeForeign Stack
stk b
res
  where
    decodeArgs :: (ForeignConvention x) => Args -> Stack -> IO x
    decodeArgs :: forall x. ForeignConvention x => Args -> Stack -> IO x
decodeArgs !Args
args !Stack
stk =
      [Int] -> Stack -> IO ([Int], x)
forall a. ForeignConvention a => [Int] -> Stack -> IO ([Int], a)
readForeign (Args -> [Int]
argsToLists Args
args) Stack
stk IO ([Int], x) -> (([Int], x) -> IO x) -> IO x
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        ([], x
a) -> x -> IO x
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure x
a
        ([Int], x)
_ ->
          String -> IO x
forall a. HasCallStack => String -> a
error
            String
"mkForeign: too many arguments for foreign function"

{-# INLINE mkForeignIOF #-}
mkForeignIOF ::
  (ForeignConvention a, ForeignConvention r) =>
  (a -> IO r) ->
  Args ->
  Stack ->
  IO Stack
mkForeignIOF :: forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignIOF a -> IO r
f = (a -> IO (Either (Failure Val) r)) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((a -> IO (Either (Failure Val) r)) -> Args -> Stack -> IO Stack)
-> (a -> IO (Either (Failure Val) r)) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ \a
a -> IO r -> IO (Either (Failure Val) r)
forall a. IO a -> IO (Either (Failure Val) a)
tryIOE (a -> IO r
f a
a)
  where
    tryIOE :: IO a -> IO (Either (F.Failure Val) a)
    tryIOE :: forall a. IO a -> IO (Either (Failure Val) a)
tryIOE = (Either IOException a -> Either (Failure Val) a)
-> IO (Either IOException a) -> IO (Either (Failure Val) a)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either IOException a -> Either (Failure Val) a
forall a. Either IOException a -> Either (Failure Val) a
handleIOE (IO (Either IOException a) -> IO (Either (Failure Val) a))
-> (IO a -> IO (Either IOException a))
-> IO a
-> IO (Either (Failure Val) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> IO (Either IOException a)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
UnliftIO.try
    handleIOE :: Either IOException a -> Either (F.Failure Val) a
    handleIOE :: forall a. Either IOException a -> Either (Failure Val) a
handleIOE (Left IOException
e) = Failure Val -> Either (Failure Val) a
forall a b. a -> Either a b
Left (Failure Val -> Either (Failure Val) a)
-> Failure Val -> Either (Failure Val) a
forall a b. (a -> b) -> a -> b
$ Reference -> Text -> Val -> Failure Val
forall a. Reference -> Text -> a -> Failure a
F.Failure Reference
Ty.ioFailureRef (String -> Text
Util.Text.pack (IOException -> String
forall a. Show a => a -> String
show IOException
e)) Val
unitValue
    handleIOE (Right a
a) = a -> Either (Failure Val) a
forall a b. b -> Either a b
Right a
a

{-# INLINE mkForeignTls #-}
mkForeignTls ::
  forall a r.
  (ForeignConvention a, ForeignConvention r) =>
  (a -> IO r) ->
  Args ->
  Stack ->
  IO Stack
mkForeignTls :: forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeignTls a -> IO r
f = (a -> IO (Either (Failure Val) r)) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((a -> IO (Either (Failure Val) r)) -> Args -> Stack -> IO Stack)
-> (a -> IO (Either (Failure Val) r)) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ \a
a -> (Either IOException (Either TLSException r)
 -> Either (Failure Val) r)
-> IO (Either IOException (Either TLSException r))
-> IO (Either (Failure Val) r)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either IOException (Either TLSException r)
-> Either (Failure Val) r
flatten (IO (Either TLSException r)
-> IO (Either IOException (Either TLSException r))
tryIO2 (IO r -> IO (Either TLSException r)
tryIO1 (a -> IO r
f a
a)))
  where
    tryIO1 :: IO r -> IO (Either TLS.TLSException r)
    tryIO1 :: IO r -> IO (Either TLSException r)
tryIO1 = IO r -> IO (Either TLSException r)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
UnliftIO.try
    tryIO2 :: IO (Either TLS.TLSException r) -> IO (Either IOException (Either TLS.TLSException r))
    tryIO2 :: IO (Either TLSException r)
-> IO (Either IOException (Either TLSException r))
tryIO2 = IO (Either TLSException r)
-> IO (Either IOException (Either TLSException r))
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
UnliftIO.try
    flatten :: Either IOException (Either TLS.TLSException r) -> Either ((F.Failure Val)) r
    flatten :: Either IOException (Either TLSException r)
-> Either (Failure Val) r
flatten (Left IOException
e) = Failure Val -> Either (Failure Val) r
forall a b. a -> Either a b
Left (Reference -> Text -> Val -> Failure Val
forall a. Reference -> Text -> a -> Failure a
F.Failure Reference
Ty.ioFailureRef (String -> Text
Util.Text.pack (IOException -> String
forall a. Show a => a -> String
show IOException
e)) Val
unitValue)
    flatten (Right (Left TLSException
e)) = Failure Val -> Either (Failure Val) r
forall a b. a -> Either a b
Left (Reference -> Text -> Val -> Failure Val
forall a. Reference -> Text -> a -> Failure a
F.Failure Reference
Ty.tlsFailureRef (String -> Text
Util.Text.pack (TLSException -> String
forall a. Show a => a -> String
show TLSException
e)) Val
unitValue)
    flatten (Right (Right r
a)) = r -> Either (Failure Val) r
forall a b. b -> Either a b
Right r
a

{-# INLINE mkForeignTlsE #-}
mkForeignTlsE ::
  forall a r.
  (ForeignConvention a, ForeignConvention r) =>
  (a -> IO (Either Failure r)) ->
  Args ->
  Stack ->
  IO Stack
mkForeignTlsE :: forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO (Either (Failure Val) r)) -> Args -> Stack -> IO Stack
mkForeignTlsE a -> IO (Either (Failure Val) r)
f = (a -> IO (Either (Failure Val) r)) -> Args -> Stack -> IO Stack
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> Args -> Stack -> IO Stack
mkForeign ((a -> IO (Either (Failure Val) r)) -> Args -> Stack -> IO Stack)
-> (a -> IO (Either (Failure Val) r)) -> Args -> Stack -> IO Stack
forall a b. (a -> b) -> a -> b
$ \a
a -> (Either IOException (Either TLSException (Either (Failure Val) r))
 -> Either (Failure Val) r)
-> IO
     (Either IOException (Either TLSException (Either (Failure Val) r)))
-> IO (Either (Failure Val) r)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either IOException (Either TLSException (Either (Failure Val) r))
-> Either (Failure Val) r
flatten (IO (Either TLSException (Either (Failure Val) r))
-> IO
     (Either IOException (Either TLSException (Either (Failure Val) r)))
tryIO2 (IO (Either (Failure Val) r)
-> IO (Either TLSException (Either (Failure Val) r))
tryIO1 (a -> IO (Either (Failure Val) r)
f a
a)))
  where
    tryIO1 :: IO (Either Failure r) -> IO (Either TLS.TLSException (Either Failure r))
    tryIO1 :: IO (Either (Failure Val) r)
-> IO (Either TLSException (Either (Failure Val) r))
tryIO1 = IO (Either (Failure Val) r)
-> IO (Either TLSException (Either (Failure Val) r))
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
UnliftIO.try
    tryIO2 :: IO (Either TLS.TLSException (Either Failure r)) -> IO (Either IOException (Either TLS.TLSException (Either Failure r)))
    tryIO2 :: IO (Either TLSException (Either (Failure Val) r))
-> IO
     (Either IOException (Either TLSException (Either (Failure Val) r)))
tryIO2 = IO (Either TLSException (Either (Failure Val) r))
-> IO
     (Either IOException (Either TLSException (Either (Failure Val) r)))
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
UnliftIO.try
    flatten :: Either IOException (Either TLS.TLSException (Either Failure r)) -> Either Failure r
    flatten :: Either IOException (Either TLSException (Either (Failure Val) r))
-> Either (Failure Val) r
flatten (Left IOException
e) = Failure Val -> Either (Failure Val) r
forall a b. a -> Either a b
Left (Reference -> Text -> Val -> Failure Val
forall a. Reference -> Text -> a -> Failure a
F.Failure Reference
Ty.ioFailureRef (String -> Text
Util.Text.pack (IOException -> String
forall a. Show a => a -> String
show IOException
e)) Val
unitValue)
    flatten (Right (Left TLSException
e)) = Failure Val -> Either (Failure Val) r
forall a b. a -> Either a b
Left (Reference -> Text -> Val -> Failure Val
forall a. Reference -> Text -> a -> Failure a
F.Failure Reference
Ty.tlsFailureRef (String -> Text
Util.Text.pack (TLSException -> String
forall a. Show a => a -> String
show TLSException
e)) Val
unitValue)
    flatten (Right (Right (Left Failure Val
e))) = Failure Val -> Either (Failure Val) r
forall a b. a -> Either a b
Left Failure Val
e
    flatten (Right (Right (Right r
a))) = r -> Either (Failure Val) r
forall a b. b -> Either a b
Right r
a

{-# INLINE unsafeSTMToIO #-}
unsafeSTMToIO :: STM.STM a -> IO a
unsafeSTMToIO :: forall a. STM a -> IO a
unsafeSTMToIO (STM.STM State# RealWorld -> (# State# RealWorld, a #)
m) = (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO State# RealWorld -> (# State# RealWorld, a #)
m

signEd25519Wrapper ::
  (Bytes.Bytes, Bytes.Bytes, Bytes.Bytes) -> Either Failure Bytes.Bytes
signEd25519Wrapper :: (Bytes, Bytes, Bytes) -> Either (Failure Val) Bytes
signEd25519Wrapper (Bytes
secret0, Bytes
public0, Bytes
msg0) = case CryptoFailable (SecretKey, PublicKey)
validated of
  CryptoFailed CryptoError
err ->
    Failure Val -> Either (Failure Val) Bytes
forall a b. a -> Either a b
Left (Reference -> Text -> Val -> Failure Val
forall a. Reference -> Text -> a -> Failure a
F.Failure Reference
Ty.cryptoFailureRef (CryptoError -> Text
forall {a}. IsString a => CryptoError -> a
errMsg CryptoError
err) Val
unitValue)
  CryptoPassed (SecretKey
secret, PublicKey
public) ->
    Bytes -> Either (Failure Val) Bytes
forall a b. b -> Either a b
Right (Bytes -> Either (Failure Val) Bytes)
-> (Signature -> Bytes) -> Signature -> Either (Failure Val) Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> Bytes
forall b. ByteArrayAccess b => b -> Bytes
Bytes.fromArray (Signature -> Either (Failure Val) Bytes)
-> Signature -> Either (Failure Val) Bytes
forall a b. (a -> b) -> a -> b
$ SecretKey -> PublicKey -> ByteString -> Signature
forall ba.
ByteArrayAccess ba =>
SecretKey -> PublicKey -> ba -> Signature
Ed25519.sign SecretKey
secret PublicKey
public ByteString
msg
  where
    msg :: ByteString
msg = Bytes -> ByteString
forall b. ByteArray b => Bytes -> b
Bytes.toArray Bytes
msg0 :: ByteString
    validated :: CryptoFailable (SecretKey, PublicKey)
validated =
      (,)
        (SecretKey -> PublicKey -> (SecretKey, PublicKey))
-> CryptoFailable SecretKey
-> CryptoFailable (PublicKey -> (SecretKey, PublicKey))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> CryptoFailable SecretKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Ed25519.secretKey (Bytes -> ByteString
forall b. ByteArray b => Bytes -> b
Bytes.toArray Bytes
secret0 :: ByteString)
        CryptoFailable (PublicKey -> (SecretKey, PublicKey))
-> CryptoFailable PublicKey
-> CryptoFailable (SecretKey, PublicKey)
forall a b.
CryptoFailable (a -> b) -> CryptoFailable a -> CryptoFailable b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> CryptoFailable PublicKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable PublicKey
Ed25519.publicKey (Bytes -> ByteString
forall b. ByteArray b => Bytes -> b
Bytes.toArray Bytes
public0 :: ByteString)

    errMsg :: CryptoError -> a
errMsg CryptoError
CryptoError_PublicKeySizeInvalid =
      a
"ed25519: Public key size invalid"
    errMsg CryptoError
CryptoError_SecretKeySizeInvalid =
      a
"ed25519: Secret key size invalid"
    errMsg CryptoError
CryptoError_SecretKeyStructureInvalid =
      a
"ed25519: Secret key structure invalid"
    errMsg CryptoError
_ = a
"ed25519: unexpected error"

verifyEd25519Wrapper ::
  (Bytes.Bytes, Bytes.Bytes, Bytes.Bytes) -> Either Failure Bool
verifyEd25519Wrapper :: (Bytes, Bytes, Bytes) -> Either (Failure Val) Bool
verifyEd25519Wrapper (Bytes
public0, Bytes
msg0, Bytes
sig0) = case CryptoFailable (PublicKey, Signature)
validated of
  CryptoFailed CryptoError
err ->
    Failure Val -> Either (Failure Val) Bool
forall a b. a -> Either a b
Left (Failure Val -> Either (Failure Val) Bool)
-> Failure Val -> Either (Failure Val) Bool
forall a b. (a -> b) -> a -> b
$ Reference -> Text -> Val -> Failure Val
forall a. Reference -> Text -> a -> Failure a
F.Failure Reference
Ty.cryptoFailureRef (CryptoError -> Text
forall {a}. IsString a => CryptoError -> a
errMsg CryptoError
err) Val
unitValue
  CryptoPassed (PublicKey
public, Signature
sig) ->
    Bool -> Either (Failure Val) Bool
forall a b. b -> Either a b
Right (Bool -> Either (Failure Val) Bool)
-> Bool -> Either (Failure Val) Bool
forall a b. (a -> b) -> a -> b
$ PublicKey -> ByteString -> Signature -> Bool
forall ba.
ByteArrayAccess ba =>
PublicKey -> ba -> Signature -> Bool
Ed25519.verify PublicKey
public ByteString
msg Signature
sig
  where
    msg :: ByteString
msg = Bytes -> ByteString
forall b. ByteArray b => Bytes -> b
Bytes.toArray Bytes
msg0 :: ByteString
    validated :: CryptoFailable (PublicKey, Signature)
validated =
      (,)
        (PublicKey -> Signature -> (PublicKey, Signature))
-> CryptoFailable PublicKey
-> CryptoFailable (Signature -> (PublicKey, Signature))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> CryptoFailable PublicKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable PublicKey
Ed25519.publicKey (Bytes -> ByteString
forall b. ByteArray b => Bytes -> b
Bytes.toArray Bytes
public0 :: ByteString)
        CryptoFailable (Signature -> (PublicKey, Signature))
-> CryptoFailable Signature
-> CryptoFailable (PublicKey, Signature)
forall a b.
CryptoFailable (a -> b) -> CryptoFailable a -> CryptoFailable b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> CryptoFailable Signature
forall ba. ByteArrayAccess ba => ba -> CryptoFailable Signature
Ed25519.signature (Bytes -> ByteString
forall b. ByteArray b => Bytes -> b
Bytes.toArray Bytes
sig0 :: ByteString)

    errMsg :: CryptoError -> a
errMsg CryptoError
CryptoError_PublicKeySizeInvalid =
      a
"ed25519: Public key size invalid"
    errMsg CryptoError
CryptoError_SecretKeySizeInvalid =
      a
"ed25519: Secret key size invalid"
    errMsg CryptoError
CryptoError_SecretKeyStructureInvalid =
      a
"ed25519: Secret key structure invalid"
    errMsg CryptoError
_ = a
"ed25519: unexpected error"

signRsaWrapper ::
  (Bytes.Bytes, Bytes.Bytes) -> Either Failure Bytes.Bytes
signRsaWrapper :: (Bytes, Bytes) -> Either (Failure Val) Bytes
signRsaWrapper (Bytes
secret0, Bytes
msg0) = case Either Text PrivateKey
validated of
  Left Text
err ->
    Failure Val -> Either (Failure Val) Bytes
forall a b. a -> Either a b
Left (Reference -> Text -> Val -> Failure Val
forall a. Reference -> Text -> a -> Failure a
F.Failure Reference
Ty.cryptoFailureRef Text
err Val
unitValue)
  Right PrivateKey
secret ->
    case Maybe Blinder
-> Maybe SHA256
-> PrivateKey
-> ByteString
-> Either Error ByteString
forall hashAlg.
HashAlgorithmASN1 hashAlg =>
Maybe Blinder
-> Maybe hashAlg
-> PrivateKey
-> ByteString
-> Either Error ByteString
RSA.sign Maybe Blinder
forall a. Maybe a
Nothing (SHA256 -> Maybe SHA256
forall a. a -> Maybe a
Just SHA256
Hash.SHA256) PrivateKey
secret ByteString
msg of
      Left Error
err -> Failure Val -> Either (Failure Val) Bytes
forall a b. a -> Either a b
Left (Reference -> Text -> Val -> Failure Val
forall a. Reference -> Text -> a -> Failure a
F.Failure Reference
Ty.cryptoFailureRef (Error -> Text
Rsa.rsaErrorToText Error
err) Val
unitValue)
      Right ByteString
signature -> Bytes -> Either (Failure Val) Bytes
forall a b. b -> Either a b
Right (Bytes -> Either (Failure Val) Bytes)
-> Bytes -> Either (Failure Val) Bytes
forall a b. (a -> b) -> a -> b
$ ByteString -> Bytes
Bytes.fromByteString ByteString
signature
  where
    msg :: ByteString
msg = Bytes -> ByteString
forall b. ByteArray b => Bytes -> b
Bytes.toArray Bytes
msg0 :: ByteString
    validated :: Either Text PrivateKey
validated = ByteString -> Either Text PrivateKey
Rsa.parseRsaPrivateKey (Bytes -> ByteString
forall b. ByteArray b => Bytes -> b
Bytes.toArray Bytes
secret0 :: ByteString)

verifyRsaWrapper ::
  (Bytes.Bytes, Bytes.Bytes, Bytes.Bytes) -> Either Failure Bool
verifyRsaWrapper :: (Bytes, Bytes, Bytes) -> Either (Failure Val) Bool
verifyRsaWrapper (Bytes
public0, Bytes
msg0, Bytes
sig0) = case Either Text PublicKey
validated of
  Left Text
err ->
    Failure Val -> Either (Failure Val) Bool
forall a b. a -> Either a b
Left (Failure Val -> Either (Failure Val) Bool)
-> Failure Val -> Either (Failure Val) Bool
forall a b. (a -> b) -> a -> b
$ Reference -> Text -> Val -> Failure Val
forall a. Reference -> Text -> a -> Failure a
F.Failure Reference
Ty.cryptoFailureRef Text
err Val
unitValue
  Right PublicKey
public ->
    Bool -> Either (Failure Val) Bool
forall a b. b -> Either a b
Right (Bool -> Either (Failure Val) Bool)
-> Bool -> Either (Failure Val) Bool
forall a b. (a -> b) -> a -> b
$ Maybe SHA256 -> PublicKey -> ByteString -> ByteString -> Bool
forall hashAlg.
HashAlgorithmASN1 hashAlg =>
Maybe hashAlg -> PublicKey -> ByteString -> ByteString -> Bool
RSA.verify (SHA256 -> Maybe SHA256
forall a. a -> Maybe a
Just SHA256
Hash.SHA256) PublicKey
public ByteString
msg ByteString
sig
  where
    msg :: ByteString
msg = Bytes -> ByteString
forall b. ByteArray b => Bytes -> b
Bytes.toArray Bytes
msg0 :: ByteString
    sig :: ByteString
sig = Bytes -> ByteString
forall b. ByteArray b => Bytes -> b
Bytes.toArray Bytes
sig0 :: ByteString
    validated :: Either Text PublicKey
validated = ByteString -> Either Text PublicKey
Rsa.parseRsaPublicKey (Bytes -> ByteString
forall b. ByteArray b => Bytes -> b
Bytes.toArray Bytes
public0 :: ByteString)

type Failure = F.Failure Val

checkBounds :: Text -> Int -> Word64 -> IO (Either Failure b) -> IO (Either Failure b)
checkBounds :: forall b.
Text
-> Int
-> ConstructorId
-> IO (Either (Failure Val) b)
-> IO (Either (Failure Val) b)
checkBounds Text
name Int
l ConstructorId
w IO (Either (Failure Val) b)
act
  | ConstructorId
w ConstructorId -> ConstructorId -> Bool
forall a. Ord a => a -> a -> Bool
< Int -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l = IO (Either (Failure Val) b)
act
  | Bool
otherwise = Either (Failure Val) b -> IO (Either (Failure Val) b)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Failure Val) b -> IO (Either (Failure Val) b))
-> Either (Failure Val) b -> IO (Either (Failure Val) b)
forall a b. (a -> b) -> a -> b
$ Failure Val -> Either (Failure Val) b
forall a b. a -> Either a b
Left Failure Val
err
  where
    msg :: Text
msg = Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": array index out of bounds"
    err :: Failure Val
err = Reference -> Text -> Val -> Failure Val
forall a. Reference -> Text -> a -> Failure a
F.Failure Reference
Ty.arrayFailureRef Text
msg (ConstructorId -> Val
natValue ConstructorId
w)

-- Performs a bounds check on a byte array. Strategy is as follows:
--
--   isz = signed array size-in-bytes
--   off = unsigned byte offset into the array
--   esz = unsigned number of bytes to be read
--
--   1. Turn the signed size-in-bytes of the array unsigned
--   2. Add the offset to the to-be-read number to get the maximum size needed
--   3. Check that the actual array size is at least as big as the needed size
--   4. Check that the offset is less than the size
--
-- Step 4 ensures that step 3 has not overflowed. Since an actual array size can
-- only be 63 bits (since it is signed), the only way for 3 to overflow is if
-- the offset is larger than a possible array size, since it would need to be
-- 2^64-k, where k is the small (<=8) number of bytes to be read.
checkBoundsPrim ::
  Text -> Int -> Word64 -> Word64 -> IO (Either Failure b) -> IO (Either Failure b)
checkBoundsPrim :: forall b.
Text
-> Int
-> ConstructorId
-> ConstructorId
-> IO (Either (Failure Val) b)
-> IO (Either (Failure Val) b)
checkBoundsPrim Text
name Int
isz ConstructorId
off ConstructorId
esz IO (Either (Failure Val) b)
act
  | ConstructorId
w ConstructorId -> ConstructorId -> Bool
forall a. Ord a => a -> a -> Bool
> ConstructorId
bsz Bool -> Bool -> Bool
|| ConstructorId
off ConstructorId -> ConstructorId -> Bool
forall a. Ord a => a -> a -> Bool
> ConstructorId
bsz = Either (Failure Val) b -> IO (Either (Failure Val) b)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Failure Val) b -> IO (Either (Failure Val) b))
-> Either (Failure Val) b -> IO (Either (Failure Val) b)
forall a b. (a -> b) -> a -> b
$ Failure Val -> Either (Failure Val) b
forall a b. a -> Either a b
Left Failure Val
err
  | Bool
otherwise = IO (Either (Failure Val) b)
act
  where
    msg :: Text
msg = Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": array index out of bounds"
    err :: Failure Val
err = Reference -> Text -> Val -> Failure Val
forall a. Reference -> Text -> a -> Failure a
F.Failure Reference
Ty.arrayFailureRef Text
msg (ConstructorId -> Val
natValue ConstructorId
off)

    bsz :: ConstructorId
bsz = Int -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
isz
    w :: ConstructorId
w = ConstructorId
off ConstructorId -> ConstructorId -> ConstructorId
forall a. Num a => a -> a -> a
+ ConstructorId
esz

type RW = PA.PrimState IO

checkedRead ::
  Text -> (PA.MutableArray RW Val, Word64) -> IO (Either Failure Val)
checkedRead :: Text
-> (MutableArray RW Val, ConstructorId)
-> IO (Either (Failure Val) Val)
checkedRead Text
name (MutableArray RW Val
arr, ConstructorId
w) =
  Text
-> Int
-> ConstructorId
-> IO (Either (Failure Val) Val)
-> IO (Either (Failure Val) Val)
forall b.
Text
-> Int
-> ConstructorId
-> IO (Either (Failure Val) b)
-> IO (Either (Failure Val) b)
checkBounds
    Text
name
    (MutableArray RealWorld Val -> Int
forall s a. MutableArray s a -> Int
PA.sizeofMutableArray MutableArray RealWorld Val
MutableArray RW Val
arr)
    ConstructorId
w
    (Val -> Either (Failure Val) Val
forall a b. b -> Either a b
Right (Val -> Either (Failure Val) Val)
-> IO Val -> IO (Either (Failure Val) Val)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutableArray RW Val -> Int -> IO Val
forall (m :: * -> *) a.
(() :: Constraint, PrimMonad m) =>
MutableArray (PrimState m) a -> Int -> m a
PA.readArray MutableArray RW Val
arr (ConstructorId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
w))

checkedWrite ::
  Text -> (PA.MutableArray RW Val, Word64, Val) -> IO (Either Failure ())
checkedWrite :: Text
-> (MutableArray RW Val, ConstructorId, Val)
-> IO (Either (Failure Val) ())
checkedWrite Text
name (MutableArray RW Val
arr, ConstructorId
w, Val
v) =
  Text
-> Int
-> ConstructorId
-> IO (Either (Failure Val) ())
-> IO (Either (Failure Val) ())
forall b.
Text
-> Int
-> ConstructorId
-> IO (Either (Failure Val) b)
-> IO (Either (Failure Val) b)
checkBounds
    Text
name
    (MutableArray RealWorld Val -> Int
forall s a. MutableArray s a -> Int
PA.sizeofMutableArray MutableArray RealWorld Val
MutableArray RW Val
arr)
    ConstructorId
w
    (() -> Either (Failure Val) ()
forall a b. b -> Either a b
Right (() -> Either (Failure Val) ())
-> IO () -> IO (Either (Failure Val) ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutableArray RW Val -> Int -> Val -> IO ()
forall (m :: * -> *) a.
(() :: Constraint, PrimMonad m) =>
MutableArray (PrimState m) a -> Int -> a -> m ()
PA.writeArray MutableArray RW Val
arr (ConstructorId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
w) Val
v)

checkedIndex ::
  Text -> (PA.Array Val, Word64) -> IO (Either Failure Val)
checkedIndex :: Text -> (Array Val, ConstructorId) -> IO (Either (Failure Val) Val)
checkedIndex Text
name (Array Val
arr, ConstructorId
w) =
  Text
-> Int
-> ConstructorId
-> IO (Either (Failure Val) Val)
-> IO (Either (Failure Val) Val)
forall b.
Text
-> Int
-> ConstructorId
-> IO (Either (Failure Val) b)
-> IO (Either (Failure Val) b)
checkBounds
    Text
name
    (Array Val -> Int
forall a. Array a -> Int
PA.sizeofArray Array Val
arr)
    ConstructorId
w
    (Val -> Either (Failure Val) Val
forall a b. b -> Either a b
Right (Val -> Either (Failure Val) Val)
-> IO Val -> IO (Either (Failure Val) Val)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Array Val -> Int -> IO Val
forall (m :: * -> *) a. Monad m => Array a -> Int -> m a
PA.indexArrayM Array Val
arr (ConstructorId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
w))

checkedRead8 :: Text -> (PA.MutableByteArray RW, Word64) -> IO (Either Failure Word64)
checkedRead8 :: Text
-> (MutableByteArray RW, ConstructorId)
-> IO (Either (Failure Val) ConstructorId)
checkedRead8 Text
name (MutableByteArray RW
arr, ConstructorId
i) =
  Text
-> Int
-> ConstructorId
-> ConstructorId
-> IO (Either (Failure Val) ConstructorId)
-> IO (Either (Failure Val) ConstructorId)
forall b.
Text
-> Int
-> ConstructorId
-> ConstructorId
-> IO (Either (Failure Val) b)
-> IO (Either (Failure Val) b)
checkBoundsPrim Text
name (MutableByteArray RealWorld -> Int
forall s. MutableByteArray s -> Int
PA.sizeofMutableByteArray MutableByteArray RealWorld
MutableByteArray RW
arr) ConstructorId
i ConstructorId
1 (IO (Either (Failure Val) ConstructorId)
 -> IO (Either (Failure Val) ConstructorId))
-> IO (Either (Failure Val) ConstructorId)
-> IO (Either (Failure Val) ConstructorId)
forall a b. (a -> b) -> a -> b
$
    (ConstructorId -> Either (Failure Val) ConstructorId
forall a b. b -> Either a b
Right (ConstructorId -> Either (Failure Val) ConstructorId)
-> (Word8 -> ConstructorId)
-> Word8
-> Either (Failure Val) ConstructorId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (Word8 -> Either (Failure Val) ConstructorId)
-> IO Word8 -> IO (Either (Failure Val) ConstructorId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray RW
arr Int
j
  where
    j :: Int
j = ConstructorId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
i

checkedRead16 :: Text -> (PA.MutableByteArray RW, Word64) -> IO (Either Failure Word64)
checkedRead16 :: Text
-> (MutableByteArray RW, ConstructorId)
-> IO (Either (Failure Val) ConstructorId)
checkedRead16 Text
name (MutableByteArray RW
arr, ConstructorId
i) =
  Text
-> Int
-> ConstructorId
-> ConstructorId
-> IO (Either (Failure Val) ConstructorId)
-> IO (Either (Failure Val) ConstructorId)
forall b.
Text
-> Int
-> ConstructorId
-> ConstructorId
-> IO (Either (Failure Val) b)
-> IO (Either (Failure Val) b)
checkBoundsPrim Text
name (MutableByteArray RealWorld -> Int
forall s. MutableByteArray s -> Int
PA.sizeofMutableByteArray MutableByteArray RealWorld
MutableByteArray RW
arr) ConstructorId
i ConstructorId
2 (IO (Either (Failure Val) ConstructorId)
 -> IO (Either (Failure Val) ConstructorId))
-> IO (Either (Failure Val) ConstructorId)
-> IO (Either (Failure Val) ConstructorId)
forall a b. (a -> b) -> a -> b
$
    Word8 -> Word8 -> Either (Failure Val) ConstructorId
mk16
      (Word8 -> Word8 -> Either (Failure Val) ConstructorId)
-> IO Word8 -> IO (Word8 -> Either (Failure Val) ConstructorId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray RW
arr Int
j
      IO (Word8 -> Either (Failure Val) ConstructorId)
-> IO Word8 -> IO (Either (Failure Val) ConstructorId)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray RW
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  where
    j :: Int
j = ConstructorId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
i

checkedRead24 :: Text -> (PA.MutableByteArray RW, Word64) -> IO (Either Failure Word64)
checkedRead24 :: Text
-> (MutableByteArray RW, ConstructorId)
-> IO (Either (Failure Val) ConstructorId)
checkedRead24 Text
name (MutableByteArray RW
arr, ConstructorId
i) =
  Text
-> Int
-> ConstructorId
-> ConstructorId
-> IO (Either (Failure Val) ConstructorId)
-> IO (Either (Failure Val) ConstructorId)
forall b.
Text
-> Int
-> ConstructorId
-> ConstructorId
-> IO (Either (Failure Val) b)
-> IO (Either (Failure Val) b)
checkBoundsPrim Text
name (MutableByteArray RealWorld -> Int
forall s. MutableByteArray s -> Int
PA.sizeofMutableByteArray MutableByteArray RealWorld
MutableByteArray RW
arr) ConstructorId
i ConstructorId
3 (IO (Either (Failure Val) ConstructorId)
 -> IO (Either (Failure Val) ConstructorId))
-> IO (Either (Failure Val) ConstructorId)
-> IO (Either (Failure Val) ConstructorId)
forall a b. (a -> b) -> a -> b
$
    Word8 -> Word8 -> Word8 -> Either (Failure Val) ConstructorId
mk24
      (Word8 -> Word8 -> Word8 -> Either (Failure Val) ConstructorId)
-> IO Word8
-> IO (Word8 -> Word8 -> Either (Failure Val) ConstructorId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray RW
arr Int
j
      IO (Word8 -> Word8 -> Either (Failure Val) ConstructorId)
-> IO Word8 -> IO (Word8 -> Either (Failure Val) ConstructorId)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray RW
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      IO (Word8 -> Either (Failure Val) ConstructorId)
-> IO Word8 -> IO (Either (Failure Val) ConstructorId)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray RW
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
  where
    j :: Int
j = ConstructorId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
i

checkedRead32 :: Text -> (PA.MutableByteArray RW, Word64) -> IO (Either Failure Word64)
checkedRead32 :: Text
-> (MutableByteArray RW, ConstructorId)
-> IO (Either (Failure Val) ConstructorId)
checkedRead32 Text
name (MutableByteArray RW
arr, ConstructorId
i) =
  Text
-> Int
-> ConstructorId
-> ConstructorId
-> IO (Either (Failure Val) ConstructorId)
-> IO (Either (Failure Val) ConstructorId)
forall b.
Text
-> Int
-> ConstructorId
-> ConstructorId
-> IO (Either (Failure Val) b)
-> IO (Either (Failure Val) b)
checkBoundsPrim Text
name (MutableByteArray RealWorld -> Int
forall s. MutableByteArray s -> Int
PA.sizeofMutableByteArray MutableByteArray RealWorld
MutableByteArray RW
arr) ConstructorId
i ConstructorId
4 (IO (Either (Failure Val) ConstructorId)
 -> IO (Either (Failure Val) ConstructorId))
-> IO (Either (Failure Val) ConstructorId)
-> IO (Either (Failure Val) ConstructorId)
forall a b. (a -> b) -> a -> b
$
    Word8
-> Word8 -> Word8 -> Word8 -> Either (Failure Val) ConstructorId
mk32
      (Word8
 -> Word8 -> Word8 -> Word8 -> Either (Failure Val) ConstructorId)
-> IO Word8
-> IO
     (Word8 -> Word8 -> Word8 -> Either (Failure Val) ConstructorId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray RW
arr Int
j
      IO (Word8 -> Word8 -> Word8 -> Either (Failure Val) ConstructorId)
-> IO Word8
-> IO (Word8 -> Word8 -> Either (Failure Val) ConstructorId)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray RW
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      IO (Word8 -> Word8 -> Either (Failure Val) ConstructorId)
-> IO Word8 -> IO (Word8 -> Either (Failure Val) ConstructorId)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray RW
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
      IO (Word8 -> Either (Failure Val) ConstructorId)
-> IO Word8 -> IO (Either (Failure Val) ConstructorId)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray RW
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
  where
    j :: Int
j = ConstructorId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
i

checkedRead40 :: Text -> (PA.MutableByteArray RW, Word64) -> IO (Either Failure Word64)
checkedRead40 :: Text
-> (MutableByteArray RW, ConstructorId)
-> IO (Either (Failure Val) ConstructorId)
checkedRead40 Text
name (MutableByteArray RW
arr, ConstructorId
i) =
  Text
-> Int
-> ConstructorId
-> ConstructorId
-> IO (Either (Failure Val) ConstructorId)
-> IO (Either (Failure Val) ConstructorId)
forall b.
Text
-> Int
-> ConstructorId
-> ConstructorId
-> IO (Either (Failure Val) b)
-> IO (Either (Failure Val) b)
checkBoundsPrim Text
name (MutableByteArray RealWorld -> Int
forall s. MutableByteArray s -> Int
PA.sizeofMutableByteArray MutableByteArray RealWorld
MutableByteArray RW
arr) ConstructorId
i ConstructorId
6 (IO (Either (Failure Val) ConstructorId)
 -> IO (Either (Failure Val) ConstructorId))
-> IO (Either (Failure Val) ConstructorId)
-> IO (Either (Failure Val) ConstructorId)
forall a b. (a -> b) -> a -> b
$
    Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Either (Failure Val) ConstructorId
mk40
      (Word8
 -> Word8
 -> Word8
 -> Word8
 -> Word8
 -> Either (Failure Val) ConstructorId)
-> IO Word8
-> IO
     (Word8
      -> Word8 -> Word8 -> Word8 -> Either (Failure Val) ConstructorId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray RW
arr Int
j
      IO
  (Word8
   -> Word8 -> Word8 -> Word8 -> Either (Failure Val) ConstructorId)
-> IO Word8
-> IO
     (Word8 -> Word8 -> Word8 -> Either (Failure Val) ConstructorId)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray RW
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      IO (Word8 -> Word8 -> Word8 -> Either (Failure Val) ConstructorId)
-> IO Word8
-> IO (Word8 -> Word8 -> Either (Failure Val) ConstructorId)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray RW
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
      IO (Word8 -> Word8 -> Either (Failure Val) ConstructorId)
-> IO Word8 -> IO (Word8 -> Either (Failure Val) ConstructorId)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray RW
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
      IO (Word8 -> Either (Failure Val) ConstructorId)
-> IO Word8 -> IO (Either (Failure Val) ConstructorId)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray RW
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4)
  where
    j :: Int
j = ConstructorId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
i

checkedRead64 :: Text -> (PA.MutableByteArray RW, Word64) -> IO (Either Failure Word64)
checkedRead64 :: Text
-> (MutableByteArray RW, ConstructorId)
-> IO (Either (Failure Val) ConstructorId)
checkedRead64 Text
name (MutableByteArray RW
arr, ConstructorId
i) =
  Text
-> Int
-> ConstructorId
-> ConstructorId
-> IO (Either (Failure Val) ConstructorId)
-> IO (Either (Failure Val) ConstructorId)
forall b.
Text
-> Int
-> ConstructorId
-> ConstructorId
-> IO (Either (Failure Val) b)
-> IO (Either (Failure Val) b)
checkBoundsPrim Text
name (MutableByteArray RealWorld -> Int
forall s. MutableByteArray s -> Int
PA.sizeofMutableByteArray MutableByteArray RealWorld
MutableByteArray RW
arr) ConstructorId
i ConstructorId
8 (IO (Either (Failure Val) ConstructorId)
 -> IO (Either (Failure Val) ConstructorId))
-> IO (Either (Failure Val) ConstructorId)
-> IO (Either (Failure Val) ConstructorId)
forall a b. (a -> b) -> a -> b
$
    Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Either (Failure Val) ConstructorId
mk64
      (Word8
 -> Word8
 -> Word8
 -> Word8
 -> Word8
 -> Word8
 -> Word8
 -> Word8
 -> Either (Failure Val) ConstructorId)
-> IO Word8
-> IO
     (Word8
      -> Word8
      -> Word8
      -> Word8
      -> Word8
      -> Word8
      -> Word8
      -> Either (Failure Val) ConstructorId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray RW
arr Int
j
      IO
  (Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Either (Failure Val) ConstructorId)
-> IO Word8
-> IO
     (Word8
      -> Word8
      -> Word8
      -> Word8
      -> Word8
      -> Word8
      -> Either (Failure Val) ConstructorId)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray RW
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      IO
  (Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Either (Failure Val) ConstructorId)
-> IO Word8
-> IO
     (Word8
      -> Word8
      -> Word8
      -> Word8
      -> Word8
      -> Either (Failure Val) ConstructorId)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray RW
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
      IO
  (Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Either (Failure Val) ConstructorId)
-> IO Word8
-> IO
     (Word8
      -> Word8 -> Word8 -> Word8 -> Either (Failure Val) ConstructorId)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray RW
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
      IO
  (Word8
   -> Word8 -> Word8 -> Word8 -> Either (Failure Val) ConstructorId)
-> IO Word8
-> IO
     (Word8 -> Word8 -> Word8 -> Either (Failure Val) ConstructorId)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray RW
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4)
      IO (Word8 -> Word8 -> Word8 -> Either (Failure Val) ConstructorId)
-> IO Word8
-> IO (Word8 -> Word8 -> Either (Failure Val) ConstructorId)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray RW
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5)
      IO (Word8 -> Word8 -> Either (Failure Val) ConstructorId)
-> IO Word8 -> IO (Word8 -> Either (Failure Val) ConstructorId)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray RW
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
6)
      IO (Word8 -> Either (Failure Val) ConstructorId)
-> IO Word8 -> IO (Either (Failure Val) ConstructorId)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray RW
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7)
  where
    j :: Int
j = ConstructorId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
i

mk16 :: Word8 -> Word8 -> Either Failure Word64
mk16 :: Word8 -> Word8 -> Either (Failure Val) ConstructorId
mk16 Word8
b0 Word8
b1 = ConstructorId -> Either (Failure Val) ConstructorId
forall a b. b -> Either a b
Right (ConstructorId -> Either (Failure Val) ConstructorId)
-> ConstructorId -> Either (Failure Val) ConstructorId
forall a b. (a -> b) -> a -> b
$ (Word8 -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b0 ConstructorId -> Int -> ConstructorId
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) ConstructorId -> ConstructorId -> ConstructorId
forall a. Bits a => a -> a -> a
.|. (Word8 -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b1)

mk24 :: Word8 -> Word8 -> Word8 -> Either Failure Word64
mk24 :: Word8 -> Word8 -> Word8 -> Either (Failure Val) ConstructorId
mk24 Word8
b0 Word8
b1 Word8
b2 =
  ConstructorId -> Either (Failure Val) ConstructorId
forall a b. b -> Either a b
Right (ConstructorId -> Either (Failure Val) ConstructorId)
-> ConstructorId -> Either (Failure Val) ConstructorId
forall a b. (a -> b) -> a -> b
$
    (Word8 -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b0 ConstructorId -> Int -> ConstructorId
forall a. Bits a => a -> Int -> a
`shiftL` Int
16)
      ConstructorId -> ConstructorId -> ConstructorId
forall a. Bits a => a -> a -> a
.|. (Word8 -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b1 ConstructorId -> Int -> ConstructorId
forall a. Bits a => a -> Int -> a
`shiftL` Int
8)
      ConstructorId -> ConstructorId -> ConstructorId
forall a. Bits a => a -> a -> a
.|. (Word8 -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b2)

mk32 :: Word8 -> Word8 -> Word8 -> Word8 -> Either Failure Word64
mk32 :: Word8
-> Word8 -> Word8 -> Word8 -> Either (Failure Val) ConstructorId
mk32 Word8
b0 Word8
b1 Word8
b2 Word8
b3 =
  ConstructorId -> Either (Failure Val) ConstructorId
forall a b. b -> Either a b
Right (ConstructorId -> Either (Failure Val) ConstructorId)
-> ConstructorId -> Either (Failure Val) ConstructorId
forall a b. (a -> b) -> a -> b
$
    (Word8 -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b0 ConstructorId -> Int -> ConstructorId
forall a. Bits a => a -> Int -> a
`shiftL` Int
24)
      ConstructorId -> ConstructorId -> ConstructorId
forall a. Bits a => a -> a -> a
.|. (Word8 -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b1 ConstructorId -> Int -> ConstructorId
forall a. Bits a => a -> Int -> a
`shiftL` Int
16)
      ConstructorId -> ConstructorId -> ConstructorId
forall a. Bits a => a -> a -> a
.|. (Word8 -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b2 ConstructorId -> Int -> ConstructorId
forall a. Bits a => a -> Int -> a
`shiftL` Int
8)
      ConstructorId -> ConstructorId -> ConstructorId
forall a. Bits a => a -> a -> a
.|. (Word8 -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b3)

mk40 :: Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Either Failure Word64
mk40 :: Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Either (Failure Val) ConstructorId
mk40 Word8
b0 Word8
b1 Word8
b2 Word8
b3 Word8
b4 =
  ConstructorId -> Either (Failure Val) ConstructorId
forall a b. b -> Either a b
Right (ConstructorId -> Either (Failure Val) ConstructorId)
-> ConstructorId -> Either (Failure Val) ConstructorId
forall a b. (a -> b) -> a -> b
$
    (Word8 -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b0 ConstructorId -> Int -> ConstructorId
forall a. Bits a => a -> Int -> a
`shiftL` Int
32)
      ConstructorId -> ConstructorId -> ConstructorId
forall a. Bits a => a -> a -> a
.|. (Word8 -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b1 ConstructorId -> Int -> ConstructorId
forall a. Bits a => a -> Int -> a
`shiftL` Int
24)
      ConstructorId -> ConstructorId -> ConstructorId
forall a. Bits a => a -> a -> a
.|. (Word8 -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b2 ConstructorId -> Int -> ConstructorId
forall a. Bits a => a -> Int -> a
`shiftL` Int
16)
      ConstructorId -> ConstructorId -> ConstructorId
forall a. Bits a => a -> a -> a
.|. (Word8 -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b3 ConstructorId -> Int -> ConstructorId
forall a. Bits a => a -> Int -> a
`shiftL` Int
8)
      ConstructorId -> ConstructorId -> ConstructorId
forall a. Bits a => a -> a -> a
.|. (Word8 -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b4)

mk64 :: Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Either Failure Word64
mk64 :: Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Either (Failure Val) ConstructorId
mk64 Word8
b0 Word8
b1 Word8
b2 Word8
b3 Word8
b4 Word8
b5 Word8
b6 Word8
b7 =
  ConstructorId -> Either (Failure Val) ConstructorId
forall a b. b -> Either a b
Right (ConstructorId -> Either (Failure Val) ConstructorId)
-> ConstructorId -> Either (Failure Val) ConstructorId
forall a b. (a -> b) -> a -> b
$
    (Word8 -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b0 ConstructorId -> Int -> ConstructorId
forall a. Bits a => a -> Int -> a
`shiftL` Int
56)
      ConstructorId -> ConstructorId -> ConstructorId
forall a. Bits a => a -> a -> a
.|. (Word8 -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b1 ConstructorId -> Int -> ConstructorId
forall a. Bits a => a -> Int -> a
`shiftL` Int
48)
      ConstructorId -> ConstructorId -> ConstructorId
forall a. Bits a => a -> a -> a
.|. (Word8 -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b2 ConstructorId -> Int -> ConstructorId
forall a. Bits a => a -> Int -> a
`shiftL` Int
40)
      ConstructorId -> ConstructorId -> ConstructorId
forall a. Bits a => a -> a -> a
.|. (Word8 -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b3 ConstructorId -> Int -> ConstructorId
forall a. Bits a => a -> Int -> a
`shiftL` Int
32)
      ConstructorId -> ConstructorId -> ConstructorId
forall a. Bits a => a -> a -> a
.|. (Word8 -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b4 ConstructorId -> Int -> ConstructorId
forall a. Bits a => a -> Int -> a
`shiftL` Int
24)
      ConstructorId -> ConstructorId -> ConstructorId
forall a. Bits a => a -> a -> a
.|. (Word8 -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b5 ConstructorId -> Int -> ConstructorId
forall a. Bits a => a -> Int -> a
`shiftL` Int
16)
      ConstructorId -> ConstructorId -> ConstructorId
forall a. Bits a => a -> a -> a
.|. (Word8 -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b6 ConstructorId -> Int -> ConstructorId
forall a. Bits a => a -> Int -> a
`shiftL` Int
8)
      ConstructorId -> ConstructorId -> ConstructorId
forall a. Bits a => a -> a -> a
.|. (Word8 -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b7)

checkedWrite8 :: Text -> (PA.MutableByteArray RW, Word64, Word64) -> IO (Either Failure ())
checkedWrite8 :: Text
-> (MutableByteArray RW, ConstructorId, ConstructorId)
-> IO (Either (Failure Val) ())
checkedWrite8 Text
name (MutableByteArray RW
arr, ConstructorId
i, ConstructorId
v) =
  Text
-> Int
-> ConstructorId
-> ConstructorId
-> IO (Either (Failure Val) ())
-> IO (Either (Failure Val) ())
forall b.
Text
-> Int
-> ConstructorId
-> ConstructorId
-> IO (Either (Failure Val) b)
-> IO (Either (Failure Val) b)
checkBoundsPrim Text
name (MutableByteArray RealWorld -> Int
forall s. MutableByteArray s -> Int
PA.sizeofMutableByteArray MutableByteArray RealWorld
MutableByteArray RW
arr) ConstructorId
i ConstructorId
1 (IO (Either (Failure Val) ()) -> IO (Either (Failure Val) ()))
-> IO (Either (Failure Val) ()) -> IO (Either (Failure Val) ())
forall a b. (a -> b) -> a -> b
$ do
    MutableByteArray RW -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PA.writeByteArray MutableByteArray RW
arr Int
j (ConstructorId -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
v :: Word8)
    pure (() -> Either (Failure Val) ()
forall a b. b -> Either a b
Right ())
  where
    j :: Int
j = ConstructorId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
i

checkedWrite16 :: Text -> (PA.MutableByteArray RW, Word64, Word64) -> IO (Either Failure ())
checkedWrite16 :: Text
-> (MutableByteArray RW, ConstructorId, ConstructorId)
-> IO (Either (Failure Val) ())
checkedWrite16 Text
name (MutableByteArray RW
arr, ConstructorId
i, ConstructorId
v) =
  Text
-> Int
-> ConstructorId
-> ConstructorId
-> IO (Either (Failure Val) ())
-> IO (Either (Failure Val) ())
forall b.
Text
-> Int
-> ConstructorId
-> ConstructorId
-> IO (Either (Failure Val) b)
-> IO (Either (Failure Val) b)
checkBoundsPrim Text
name (MutableByteArray RealWorld -> Int
forall s. MutableByteArray s -> Int
PA.sizeofMutableByteArray MutableByteArray RealWorld
MutableByteArray RW
arr) ConstructorId
i ConstructorId
2 (IO (Either (Failure Val) ()) -> IO (Either (Failure Val) ()))
-> IO (Either (Failure Val) ()) -> IO (Either (Failure Val) ())
forall a b. (a -> b) -> a -> b
$ do
    MutableByteArray RW -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PA.writeByteArray MutableByteArray RW
arr Int
j (ConstructorId -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ConstructorId -> Word8) -> ConstructorId -> Word8
forall a b. (a -> b) -> a -> b
$ ConstructorId
v ConstructorId -> Int -> ConstructorId
forall a. Bits a => a -> Int -> a
`shiftR` Int
8 :: Word8)
    MutableByteArray RW -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PA.writeByteArray MutableByteArray RW
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (ConstructorId -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
v :: Word8)
    pure (() -> Either (Failure Val) ()
forall a b. b -> Either a b
Right ())
  where
    j :: Int
j = ConstructorId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
i

checkedWrite32 :: Text -> (PA.MutableByteArray RW, Word64, Word64) -> IO (Either Failure ())
checkedWrite32 :: Text
-> (MutableByteArray RW, ConstructorId, ConstructorId)
-> IO (Either (Failure Val) ())
checkedWrite32 Text
name (MutableByteArray RW
arr, ConstructorId
i, ConstructorId
v) =
  Text
-> Int
-> ConstructorId
-> ConstructorId
-> IO (Either (Failure Val) ())
-> IO (Either (Failure Val) ())
forall b.
Text
-> Int
-> ConstructorId
-> ConstructorId
-> IO (Either (Failure Val) b)
-> IO (Either (Failure Val) b)
checkBoundsPrim Text
name (MutableByteArray RealWorld -> Int
forall s. MutableByteArray s -> Int
PA.sizeofMutableByteArray MutableByteArray RealWorld
MutableByteArray RW
arr) ConstructorId
i ConstructorId
4 (IO (Either (Failure Val) ()) -> IO (Either (Failure Val) ()))
-> IO (Either (Failure Val) ()) -> IO (Either (Failure Val) ())
forall a b. (a -> b) -> a -> b
$ do
    MutableByteArray RW -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PA.writeByteArray MutableByteArray RW
arr Int
j (ConstructorId -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ConstructorId -> Word8) -> ConstructorId -> Word8
forall a b. (a -> b) -> a -> b
$ ConstructorId
v ConstructorId -> Int -> ConstructorId
forall a. Bits a => a -> Int -> a
`shiftR` Int
24 :: Word8)
    MutableByteArray RW -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PA.writeByteArray MutableByteArray RW
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (ConstructorId -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ConstructorId -> Word8) -> ConstructorId -> Word8
forall a b. (a -> b) -> a -> b
$ ConstructorId
v ConstructorId -> Int -> ConstructorId
forall a. Bits a => a -> Int -> a
`shiftR` Int
16 :: Word8)
    MutableByteArray RW -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PA.writeByteArray MutableByteArray RW
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (ConstructorId -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ConstructorId -> Word8) -> ConstructorId -> Word8
forall a b. (a -> b) -> a -> b
$ ConstructorId
v ConstructorId -> Int -> ConstructorId
forall a. Bits a => a -> Int -> a
`shiftR` Int
8 :: Word8)
    MutableByteArray RW -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PA.writeByteArray MutableByteArray RW
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) (ConstructorId -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
v :: Word8)
    pure (() -> Either (Failure Val) ()
forall a b. b -> Either a b
Right ())
  where
    j :: Int
j = ConstructorId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
i

checkedWrite64 :: Text -> (PA.MutableByteArray RW, Word64, Word64) -> IO (Either Failure ())
checkedWrite64 :: Text
-> (MutableByteArray RW, ConstructorId, ConstructorId)
-> IO (Either (Failure Val) ())
checkedWrite64 Text
name (MutableByteArray RW
arr, ConstructorId
i, ConstructorId
v) =
  Text
-> Int
-> ConstructorId
-> ConstructorId
-> IO (Either (Failure Val) ())
-> IO (Either (Failure Val) ())
forall b.
Text
-> Int
-> ConstructorId
-> ConstructorId
-> IO (Either (Failure Val) b)
-> IO (Either (Failure Val) b)
checkBoundsPrim Text
name (MutableByteArray RealWorld -> Int
forall s. MutableByteArray s -> Int
PA.sizeofMutableByteArray MutableByteArray RealWorld
MutableByteArray RW
arr) ConstructorId
i ConstructorId
8 (IO (Either (Failure Val) ()) -> IO (Either (Failure Val) ()))
-> IO (Either (Failure Val) ()) -> IO (Either (Failure Val) ())
forall a b. (a -> b) -> a -> b
$ do
    MutableByteArray RW -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PA.writeByteArray MutableByteArray RW
arr Int
j (ConstructorId -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ConstructorId -> Word8) -> ConstructorId -> Word8
forall a b. (a -> b) -> a -> b
$ ConstructorId
v ConstructorId -> Int -> ConstructorId
forall a. Bits a => a -> Int -> a
`shiftR` Int
56 :: Word8)
    MutableByteArray RW -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PA.writeByteArray MutableByteArray RW
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (ConstructorId -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ConstructorId -> Word8) -> ConstructorId -> Word8
forall a b. (a -> b) -> a -> b
$ ConstructorId
v ConstructorId -> Int -> ConstructorId
forall a. Bits a => a -> Int -> a
`shiftR` Int
48 :: Word8)
    MutableByteArray RW -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PA.writeByteArray MutableByteArray RW
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (ConstructorId -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ConstructorId -> Word8) -> ConstructorId -> Word8
forall a b. (a -> b) -> a -> b
$ ConstructorId
v ConstructorId -> Int -> ConstructorId
forall a. Bits a => a -> Int -> a
`shiftR` Int
40 :: Word8)
    MutableByteArray RW -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PA.writeByteArray MutableByteArray RW
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) (ConstructorId -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ConstructorId -> Word8) -> ConstructorId -> Word8
forall a b. (a -> b) -> a -> b
$ ConstructorId
v ConstructorId -> Int -> ConstructorId
forall a. Bits a => a -> Int -> a
`shiftR` Int
32 :: Word8)
    MutableByteArray RW -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PA.writeByteArray MutableByteArray RW
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) (ConstructorId -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ConstructorId -> Word8) -> ConstructorId -> Word8
forall a b. (a -> b) -> a -> b
$ ConstructorId
v ConstructorId -> Int -> ConstructorId
forall a. Bits a => a -> Int -> a
`shiftR` Int
24 :: Word8)
    MutableByteArray RW -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PA.writeByteArray MutableByteArray RW
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5) (ConstructorId -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ConstructorId -> Word8) -> ConstructorId -> Word8
forall a b. (a -> b) -> a -> b
$ ConstructorId
v ConstructorId -> Int -> ConstructorId
forall a. Bits a => a -> Int -> a
`shiftR` Int
16 :: Word8)
    MutableByteArray RW -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PA.writeByteArray MutableByteArray RW
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
6) (ConstructorId -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ConstructorId -> Word8) -> ConstructorId -> Word8
forall a b. (a -> b) -> a -> b
$ ConstructorId
v ConstructorId -> Int -> ConstructorId
forall a. Bits a => a -> Int -> a
`shiftR` Int
8 :: Word8)
    MutableByteArray RW -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PA.writeByteArray MutableByteArray RW
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) (ConstructorId -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
v :: Word8)
    pure (() -> Either (Failure Val) ()
forall a b. b -> Either a b
Right ())
  where
    j :: Int
j = ConstructorId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
i

-- index single byte
checkedIndex8 :: Text -> (PA.ByteArray, Word64) -> IO (Either Failure Word64)
checkedIndex8 :: Text
-> (ByteArray, ConstructorId)
-> IO (Either (Failure Val) ConstructorId)
checkedIndex8 Text
name (ByteArray
arr, ConstructorId
i) =
  Text
-> Int
-> ConstructorId
-> ConstructorId
-> IO (Either (Failure Val) ConstructorId)
-> IO (Either (Failure Val) ConstructorId)
forall b.
Text
-> Int
-> ConstructorId
-> ConstructorId
-> IO (Either (Failure Val) b)
-> IO (Either (Failure Val) b)
checkBoundsPrim Text
name (ByteArray -> Int
PA.sizeofByteArray ByteArray
arr) ConstructorId
i ConstructorId
1 (IO (Either (Failure Val) ConstructorId)
 -> IO (Either (Failure Val) ConstructorId))
-> (Either (Failure Val) ConstructorId
    -> IO (Either (Failure Val) ConstructorId))
-> Either (Failure Val) ConstructorId
-> IO (Either (Failure Val) ConstructorId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (Failure Val) ConstructorId
-> IO (Either (Failure Val) ConstructorId)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Failure Val) ConstructorId
 -> IO (Either (Failure Val) ConstructorId))
-> Either (Failure Val) ConstructorId
-> IO (Either (Failure Val) ConstructorId)
forall a b. (a -> b) -> a -> b
$
    let j :: Int
j = ConstructorId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
i
     in ConstructorId -> Either (Failure Val) ConstructorId
forall a b. b -> Either a b
Right (ConstructorId -> Either (Failure Val) ConstructorId)
-> (Word8 -> ConstructorId)
-> Word8
-> Either (Failure Val) ConstructorId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Either (Failure Val) ConstructorId)
-> Word8 -> Either (Failure Val) ConstructorId
forall a b. (a -> b) -> a -> b
$ forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray @Word8 ByteArray
arr Int
j

-- index 16 big-endian
checkedIndex16 :: Text -> (PA.ByteArray, Word64) -> IO (Either Failure Word64)
checkedIndex16 :: Text
-> (ByteArray, ConstructorId)
-> IO (Either (Failure Val) ConstructorId)
checkedIndex16 Text
name (ByteArray
arr, ConstructorId
i) =
  Text
-> Int
-> ConstructorId
-> ConstructorId
-> IO (Either (Failure Val) ConstructorId)
-> IO (Either (Failure Val) ConstructorId)
forall b.
Text
-> Int
-> ConstructorId
-> ConstructorId
-> IO (Either (Failure Val) b)
-> IO (Either (Failure Val) b)
checkBoundsPrim Text
name (ByteArray -> Int
PA.sizeofByteArray ByteArray
arr) ConstructorId
i ConstructorId
2 (IO (Either (Failure Val) ConstructorId)
 -> IO (Either (Failure Val) ConstructorId))
-> (Either (Failure Val) ConstructorId
    -> IO (Either (Failure Val) ConstructorId))
-> Either (Failure Val) ConstructorId
-> IO (Either (Failure Val) ConstructorId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (Failure Val) ConstructorId
-> IO (Either (Failure Val) ConstructorId)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Failure Val) ConstructorId
 -> IO (Either (Failure Val) ConstructorId))
-> Either (Failure Val) ConstructorId
-> IO (Either (Failure Val) ConstructorId)
forall a b. (a -> b) -> a -> b
$
    let j :: Int
j = ConstructorId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
i
     in Word8 -> Word8 -> Either (Failure Val) ConstructorId
mk16 (ByteArray -> Int -> Word8
forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray ByteArray
arr Int
j) (ByteArray -> Int -> Word8
forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray ByteArray
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))

-- index 32 big-endian
checkedIndex24 :: Text -> (PA.ByteArray, Word64) -> IO (Either Failure Word64)
checkedIndex24 :: Text
-> (ByteArray, ConstructorId)
-> IO (Either (Failure Val) ConstructorId)
checkedIndex24 Text
name (ByteArray
arr, ConstructorId
i) =
  Text
-> Int
-> ConstructorId
-> ConstructorId
-> IO (Either (Failure Val) ConstructorId)
-> IO (Either (Failure Val) ConstructorId)
forall b.
Text
-> Int
-> ConstructorId
-> ConstructorId
-> IO (Either (Failure Val) b)
-> IO (Either (Failure Val) b)
checkBoundsPrim Text
name (ByteArray -> Int
PA.sizeofByteArray ByteArray
arr) ConstructorId
i ConstructorId
3 (IO (Either (Failure Val) ConstructorId)
 -> IO (Either (Failure Val) ConstructorId))
-> (Either (Failure Val) ConstructorId
    -> IO (Either (Failure Val) ConstructorId))
-> Either (Failure Val) ConstructorId
-> IO (Either (Failure Val) ConstructorId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (Failure Val) ConstructorId
-> IO (Either (Failure Val) ConstructorId)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Failure Val) ConstructorId
 -> IO (Either (Failure Val) ConstructorId))
-> Either (Failure Val) ConstructorId
-> IO (Either (Failure Val) ConstructorId)
forall a b. (a -> b) -> a -> b
$
    let j :: Int
j = ConstructorId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
i
     in Word8 -> Word8 -> Word8 -> Either (Failure Val) ConstructorId
mk24
          (ByteArray -> Int -> Word8
forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray ByteArray
arr Int
j)
          (ByteArray -> Int -> Word8
forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray ByteArray
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
          (ByteArray -> Int -> Word8
forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray ByteArray
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2))

-- index 32 big-endian
checkedIndex32 :: Text -> (PA.ByteArray, Word64) -> IO (Either Failure Word64)
checkedIndex32 :: Text
-> (ByteArray, ConstructorId)
-> IO (Either (Failure Val) ConstructorId)
checkedIndex32 Text
name (ByteArray
arr, ConstructorId
i) =
  Text
-> Int
-> ConstructorId
-> ConstructorId
-> IO (Either (Failure Val) ConstructorId)
-> IO (Either (Failure Val) ConstructorId)
forall b.
Text
-> Int
-> ConstructorId
-> ConstructorId
-> IO (Either (Failure Val) b)
-> IO (Either (Failure Val) b)
checkBoundsPrim Text
name (ByteArray -> Int
PA.sizeofByteArray ByteArray
arr) ConstructorId
i ConstructorId
4 (IO (Either (Failure Val) ConstructorId)
 -> IO (Either (Failure Val) ConstructorId))
-> (Either (Failure Val) ConstructorId
    -> IO (Either (Failure Val) ConstructorId))
-> Either (Failure Val) ConstructorId
-> IO (Either (Failure Val) ConstructorId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (Failure Val) ConstructorId
-> IO (Either (Failure Val) ConstructorId)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Failure Val) ConstructorId
 -> IO (Either (Failure Val) ConstructorId))
-> Either (Failure Val) ConstructorId
-> IO (Either (Failure Val) ConstructorId)
forall a b. (a -> b) -> a -> b
$
    let j :: Int
j = ConstructorId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
i
     in Word8
-> Word8 -> Word8 -> Word8 -> Either (Failure Val) ConstructorId
mk32
          (ByteArray -> Int -> Word8
forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray ByteArray
arr Int
j)
          (ByteArray -> Int -> Word8
forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray ByteArray
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
          (ByteArray -> Int -> Word8
forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray ByteArray
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2))
          (ByteArray -> Int -> Word8
forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray ByteArray
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3))

-- index 40 big-endian
checkedIndex40 :: Text -> (PA.ByteArray, Word64) -> IO (Either Failure Word64)
checkedIndex40 :: Text
-> (ByteArray, ConstructorId)
-> IO (Either (Failure Val) ConstructorId)
checkedIndex40 Text
name (ByteArray
arr, ConstructorId
i) =
  Text
-> Int
-> ConstructorId
-> ConstructorId
-> IO (Either (Failure Val) ConstructorId)
-> IO (Either (Failure Val) ConstructorId)
forall b.
Text
-> Int
-> ConstructorId
-> ConstructorId
-> IO (Either (Failure Val) b)
-> IO (Either (Failure Val) b)
checkBoundsPrim Text
name (ByteArray -> Int
PA.sizeofByteArray ByteArray
arr) ConstructorId
i ConstructorId
5 (IO (Either (Failure Val) ConstructorId)
 -> IO (Either (Failure Val) ConstructorId))
-> (Either (Failure Val) ConstructorId
    -> IO (Either (Failure Val) ConstructorId))
-> Either (Failure Val) ConstructorId
-> IO (Either (Failure Val) ConstructorId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (Failure Val) ConstructorId
-> IO (Either (Failure Val) ConstructorId)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Failure Val) ConstructorId
 -> IO (Either (Failure Val) ConstructorId))
-> Either (Failure Val) ConstructorId
-> IO (Either (Failure Val) ConstructorId)
forall a b. (a -> b) -> a -> b
$
    let j :: Int
j = ConstructorId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
i
     in Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Either (Failure Val) ConstructorId
mk40
          (ByteArray -> Int -> Word8
forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray ByteArray
arr Int
j)
          (ByteArray -> Int -> Word8
forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray ByteArray
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
          (ByteArray -> Int -> Word8
forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray ByteArray
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2))
          (ByteArray -> Int -> Word8
forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray ByteArray
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3))
          (ByteArray -> Int -> Word8
forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray ByteArray
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4))

-- index 64 big-endian
checkedIndex64 :: Text -> (PA.ByteArray, Word64) -> IO (Either Failure Word64)
checkedIndex64 :: Text
-> (ByteArray, ConstructorId)
-> IO (Either (Failure Val) ConstructorId)
checkedIndex64 Text
name (ByteArray
arr, ConstructorId
i) =
  Text
-> Int
-> ConstructorId
-> ConstructorId
-> IO (Either (Failure Val) ConstructorId)
-> IO (Either (Failure Val) ConstructorId)
forall b.
Text
-> Int
-> ConstructorId
-> ConstructorId
-> IO (Either (Failure Val) b)
-> IO (Either (Failure Val) b)
checkBoundsPrim Text
name (ByteArray -> Int
PA.sizeofByteArray ByteArray
arr) ConstructorId
i ConstructorId
8 (IO (Either (Failure Val) ConstructorId)
 -> IO (Either (Failure Val) ConstructorId))
-> (Either (Failure Val) ConstructorId
    -> IO (Either (Failure Val) ConstructorId))
-> Either (Failure Val) ConstructorId
-> IO (Either (Failure Val) ConstructorId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (Failure Val) ConstructorId
-> IO (Either (Failure Val) ConstructorId)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Failure Val) ConstructorId
 -> IO (Either (Failure Val) ConstructorId))
-> Either (Failure Val) ConstructorId
-> IO (Either (Failure Val) ConstructorId)
forall a b. (a -> b) -> a -> b
$
    let j :: Int
j = ConstructorId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
i
     in Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Either (Failure Val) ConstructorId
mk64
          (ByteArray -> Int -> Word8
forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray ByteArray
arr Int
j)
          (ByteArray -> Int -> Word8
forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray ByteArray
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
          (ByteArray -> Int -> Word8
forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray ByteArray
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2))
          (ByteArray -> Int -> Word8
forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray ByteArray
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3))
          (ByteArray -> Int -> Word8
forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray ByteArray
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4))
          (ByteArray -> Int -> Word8
forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray ByteArray
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5))
          (ByteArray -> Int -> Word8
forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray ByteArray
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
6))
          (ByteArray -> Int -> Word8
forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray ByteArray
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7))

class ForeignConvention a where
  readForeign ::
    [Int] -> Stack -> IO ([Int], a)
  writeForeign ::
    Stack -> a -> IO Stack

instance ForeignConvention Int where
  readForeign :: [Int] -> Stack -> IO ([Int], Int)
readForeign (Int
i : [Int]
args) !Stack
stk = ([Int]
args,) (Int -> ([Int], Int)) -> IO Int -> IO ([Int], Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (() :: Constraint) => Stack -> Int -> IO Int
Stack -> Int -> IO Int
peekOffI Stack
stk Int
i
  readForeign [] !Stack
_ = String -> IO ([Int], Int)
forall a. String -> IO a
foreignCCError String
"Int"
  writeForeign :: Stack -> Int -> IO Stack
writeForeign !Stack
stk !Int
i = do
    Stack
stk <- Stack -> IO Stack
bump Stack
stk
    Stack
stk Stack -> IO () -> IO Stack
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Stack -> Int -> IO ()
pokeI Stack
stk Int
i

instance ForeignConvention Word64 where
  readForeign :: [Int] -> Stack -> IO ([Int], ConstructorId)
readForeign (Int
i : [Int]
args) !Stack
stk = ([Int]
args,) (ConstructorId -> ([Int], ConstructorId))
-> IO ConstructorId -> IO ([Int], ConstructorId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Stack -> Int -> IO ConstructorId
peekOffN Stack
stk Int
i
  readForeign [] !Stack
_ = String -> IO ([Int], ConstructorId)
forall a. String -> IO a
foreignCCError String
"Word64"
  writeForeign :: Stack -> ConstructorId -> IO Stack
writeForeign !Stack
stk !ConstructorId
n = do
    Stack
stk <- Stack -> IO Stack
bump Stack
stk
    Stack
stk Stack -> IO () -> IO Stack
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Stack -> ConstructorId -> IO ()
pokeN Stack
stk ConstructorId
n

-- We don't have a clear mapping from these types to Unison types, most are just mapped to Nats.

instance ForeignConvention Word8 where
  readForeign :: [Int] -> Stack -> IO ([Int], Word8)
readForeign = (ConstructorId -> Word8) -> [Int] -> Stack -> IO ([Int], Word8)
forall a b.
ForeignConvention a =>
(a -> b) -> [Int] -> Stack -> IO ([Int], b)
readForeignAs (ConstructorId -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word64 -> Word8)
  writeForeign :: Stack -> Word8 -> IO Stack
writeForeign = (Word8 -> ConstructorId) -> Stack -> Word8 -> IO Stack
forall b a.
ForeignConvention b =>
(a -> b) -> Stack -> a -> IO Stack
writeForeignAs (Word8 -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word8 -> Word64)

instance ForeignConvention Word16 where
  readForeign :: [Int] -> Stack -> IO ([Int], Word16)
readForeign = (ConstructorId -> Word16) -> [Int] -> Stack -> IO ([Int], Word16)
forall a b.
ForeignConvention a =>
(a -> b) -> [Int] -> Stack -> IO ([Int], b)
readForeignAs (ConstructorId -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word64 -> Word16)
  writeForeign :: Stack -> Word16 -> IO Stack
writeForeign = (Word16 -> ConstructorId) -> Stack -> Word16 -> IO Stack
forall b a.
ForeignConvention b =>
(a -> b) -> Stack -> a -> IO Stack
writeForeignAs (Word16 -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word16 -> Word64)

instance ForeignConvention Word32 where
  readForeign :: [Int] -> Stack -> IO ([Int], Word32)
readForeign = (ConstructorId -> Word32) -> [Int] -> Stack -> IO ([Int], Word32)
forall a b.
ForeignConvention a =>
(a -> b) -> [Int] -> Stack -> IO ([Int], b)
readForeignAs (ConstructorId -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word64 -> Word32)
  writeForeign :: Stack -> Word32 -> IO Stack
writeForeign = (Word32 -> ConstructorId) -> Stack -> Word32 -> IO Stack
forall b a.
ForeignConvention b =>
(a -> b) -> Stack -> a -> IO Stack
writeForeignAs (Word32 -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word32 -> Word64)

instance ForeignConvention Char where
  readForeign :: [Int] -> Stack -> IO ([Int], Char)
readForeign (Int
i : [Int]
args) !Stack
stk = ([Int]
args,) (Char -> ([Int], Char)) -> IO Char -> IO ([Int], Char)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Stack -> Int -> IO Char
peekOffC Stack
stk Int
i
  readForeign [] !Stack
_ = String -> IO ([Int], Char)
forall a. String -> IO a
foreignCCError String
"Char"
  writeForeign :: Stack -> Char -> IO Stack
writeForeign !Stack
stk !Char
ch = do
    Stack
stk <- Stack -> IO Stack
bump Stack
stk
    Stack
stk Stack -> IO () -> IO Stack
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Stack -> Char -> IO ()
pokeC Stack
stk Char
ch

instance ForeignConvention Val where
  readForeign :: [Int] -> Stack -> IO ([Int], Val)
readForeign (Int
i : [Int]
args) !Stack
stk = ([Int]
args,) (Val -> ([Int], Val)) -> IO Val -> IO ([Int], Val)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (() :: Constraint) => Stack -> Int -> IO Val
Stack -> Int -> IO Val
peekOff Stack
stk Int
i
  readForeign [] !Stack
_ = String -> IO ([Int], Val)
forall a. String -> IO a
foreignCCError String
"Val"
  writeForeign :: Stack -> Val -> IO Stack
writeForeign !Stack
stk !Val
v = do
    Stack
stk <- Stack -> IO Stack
bump Stack
stk
    Stack
stk Stack -> IO () -> IO Stack
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ((() :: Constraint) => Stack -> Val -> IO ()
Stack -> Val -> IO ()
poke Stack
stk (Val -> IO ()) -> IO Val -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Val -> IO Val
forall a. a -> IO a
evaluate Val
v)

-- In reality this fixes the type to be 'RClosure', but allows us to defer
-- the typechecker a bit and avoid a bunch of annoying type annotations.
instance ForeignConvention Closure where
  readForeign :: [Int] -> Stack -> IO ([Int], Closure)
readForeign (Int
i : [Int]
args) !Stack
stk = ([Int]
args,) (Closure -> ([Int], Closure)) -> IO Closure -> IO ([Int], Closure)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (() :: Constraint) => Stack -> Int -> IO Closure
Stack -> Int -> IO Closure
bpeekOff Stack
stk Int
i
  readForeign [] !Stack
_ = String -> IO ([Int], Closure)
forall a. String -> IO a
foreignCCError String
"Closure"
  writeForeign :: Stack -> Closure -> IO Stack
writeForeign !Stack
stk !Closure
c = do
    Stack
stk <- Stack -> IO Stack
bump Stack
stk
    Stack
stk Stack -> IO () -> IO Stack
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ((() :: Constraint) => Stack -> Closure -> IO ()
Stack -> Closure -> IO ()
bpoke Stack
stk (Closure -> IO ()) -> IO Closure -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Closure -> IO Closure
forall a. a -> IO a
evaluate Closure
c)

instance ForeignConvention Text where
  readForeign :: [Int] -> Stack -> IO ([Int], Text)
readForeign = [Int] -> Stack -> IO ([Int], Text)
forall b. BuiltinForeign b => [Int] -> Stack -> IO ([Int], b)
readForeignBuiltin
  writeForeign :: Stack -> Text -> IO Stack
writeForeign = Stack -> Text -> IO Stack
forall b. BuiltinForeign b => Stack -> b -> IO Stack
writeForeignBuiltin

instance ForeignConvention Unison.Util.Bytes.Bytes where
  readForeign :: [Int] -> Stack -> IO ([Int], Bytes)
readForeign = [Int] -> Stack -> IO ([Int], Bytes)
forall b. BuiltinForeign b => [Int] -> Stack -> IO ([Int], b)
readForeignBuiltin
  writeForeign :: Stack -> Bytes -> IO Stack
writeForeign = Stack -> Bytes -> IO Stack
forall b. BuiltinForeign b => Stack -> b -> IO Stack
writeForeignBuiltin

instance ForeignConvention Socket where
  readForeign :: [Int] -> Stack -> IO ([Int], Socket)
readForeign = [Int] -> Stack -> IO ([Int], Socket)
forall b. BuiltinForeign b => [Int] -> Stack -> IO ([Int], b)
readForeignBuiltin
  writeForeign :: Stack -> Socket -> IO Stack
writeForeign = Stack -> Socket -> IO Stack
forall b. BuiltinForeign b => Stack -> b -> IO Stack
writeForeignBuiltin

instance ForeignConvention UDPSocket where
  readForeign :: [Int] -> Stack -> IO ([Int], UDPSocket)
readForeign = [Int] -> Stack -> IO ([Int], UDPSocket)
forall b. BuiltinForeign b => [Int] -> Stack -> IO ([Int], b)
readForeignBuiltin
  writeForeign :: Stack -> UDPSocket -> IO Stack
writeForeign = Stack -> UDPSocket -> IO Stack
forall b. BuiltinForeign b => Stack -> b -> IO Stack
writeForeignBuiltin

instance ForeignConvention ThreadId where
  readForeign :: [Int] -> Stack -> IO ([Int], ThreadId)
readForeign = [Int] -> Stack -> IO ([Int], ThreadId)
forall b. BuiltinForeign b => [Int] -> Stack -> IO ([Int], b)
readForeignBuiltin
  writeForeign :: Stack -> ThreadId -> IO Stack
writeForeign = Stack -> ThreadId -> IO Stack
forall b. BuiltinForeign b => Stack -> b -> IO Stack
writeForeignBuiltin

instance ForeignConvention Handle where
  readForeign :: [Int] -> Stack -> IO ([Int], Handle)
readForeign = [Int] -> Stack -> IO ([Int], Handle)
forall b. BuiltinForeign b => [Int] -> Stack -> IO ([Int], b)
readForeignBuiltin
  writeForeign :: Stack -> Handle -> IO Stack
writeForeign = Stack -> Handle -> IO Stack
forall b. BuiltinForeign b => Stack -> b -> IO Stack
writeForeignBuiltin

instance ForeignConvention POSIXTime where
  readForeign :: [Int] -> Stack -> IO ([Int], POSIXTime)
readForeign = (Int -> POSIXTime) -> [Int] -> Stack -> IO ([Int], POSIXTime)
forall a b.
ForeignConvention a =>
(a -> b) -> [Int] -> Stack -> IO ([Int], b)
readForeignAs (Int -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> POSIXTime)
  writeForeign :: Stack -> POSIXTime -> IO Stack
writeForeign = (POSIXTime -> Int) -> Stack -> POSIXTime -> IO Stack
forall b a.
ForeignConvention b =>
(a -> b) -> Stack -> a -> IO Stack
writeForeignAs (POSIXTime -> Int
forall b. Integral b => POSIXTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
round :: POSIXTime -> Int)

instance (ForeignConvention a) => ForeignConvention (Maybe a) where
  readForeign :: [Int] -> Stack -> IO ([Int], Maybe a)
readForeign (Int
i : [Int]
args) !Stack
stk =
    (() :: Constraint) => Stack -> Int -> IO Int
Stack -> Int -> IO Int
upeekOff Stack
stk Int
i IO Int -> (Int -> IO ([Int], Maybe a)) -> IO ([Int], Maybe a)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Int
0 -> ([Int], Maybe a) -> IO ([Int], Maybe a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Int]
args, Maybe a
forall a. Maybe a
Nothing)
      Int
1 -> (a -> Maybe a) -> ([Int], a) -> ([Int], Maybe a)
forall a b. (a -> b) -> ([Int], a) -> ([Int], b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (([Int], a) -> ([Int], Maybe a))
-> IO ([Int], a) -> IO ([Int], Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> Stack -> IO ([Int], a)
forall a. ForeignConvention a => [Int] -> Stack -> IO ([Int], a)
readForeign [Int]
args Stack
stk
      Int
_ -> String -> IO ([Int], Maybe a)
forall a. String -> IO a
foreignCCError String
"Maybe"
  readForeign [] !Stack
_ = String -> IO ([Int], Maybe a)
forall a. String -> IO a
foreignCCError String
"Maybe"

  writeForeign :: Stack -> Maybe a -> IO Stack
writeForeign !Stack
stk Maybe a
Nothing = do
    Stack
stk <- Stack -> IO Stack
bump Stack
stk
    Stack
stk Stack -> IO () -> IO Stack
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (() :: Constraint) => Stack -> Int -> IO ()
Stack -> Int -> IO ()
pokeTag Stack
stk Int
0
  writeForeign !Stack
stk (Just a
x) = do
    Stack
stk <- Stack -> a -> IO Stack
forall a. ForeignConvention a => Stack -> a -> IO Stack
writeForeign Stack
stk a
x
    Stack
stk <- Stack -> IO Stack
bump Stack
stk
    Stack
stk Stack -> IO () -> IO Stack
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (() :: Constraint) => Stack -> Int -> IO ()
Stack -> Int -> IO ()
pokeTag Stack
stk Int
1

instance
  (ForeignConvention a, ForeignConvention b) =>
  ForeignConvention (Either a b)
  where
  readForeign :: [Int] -> Stack -> IO ([Int], Either a b)
readForeign (Int
i : [Int]
args) !Stack
stk =
    (() :: Constraint) => Stack -> Int -> IO Int
Stack -> Int -> IO Int
peekTagOff Stack
stk Int
i IO Int -> (Int -> IO ([Int], Either a b)) -> IO ([Int], Either a b)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Int
0 -> (a -> Either a b) -> [Int] -> Stack -> IO ([Int], Either a b)
forall a b.
ForeignConvention a =>
(a -> b) -> [Int] -> Stack -> IO ([Int], b)
readForeignAs a -> Either a b
forall a b. a -> Either a b
Left [Int]
args Stack
stk
      Int
1 -> (b -> Either a b) -> [Int] -> Stack -> IO ([Int], Either a b)
forall a b.
ForeignConvention a =>
(a -> b) -> [Int] -> Stack -> IO ([Int], b)
readForeignAs b -> Either a b
forall a b. b -> Either a b
Right [Int]
args Stack
stk
      Int
_ -> String -> IO ([Int], Either a b)
forall a. String -> IO a
foreignCCError String
"Either"
  readForeign ![Int]
_ !Stack
_ = String -> IO ([Int], Either a b)
forall a. String -> IO a
foreignCCError String
"Either"

  writeForeign :: Stack -> Either a b -> IO Stack
writeForeign !Stack
stk !(Left a
a) = do
    Stack
stk <- Stack -> a -> IO Stack
forall a. ForeignConvention a => Stack -> a -> IO Stack
writeForeign Stack
stk a
a
    Stack
stk <- Stack -> IO Stack
bump Stack
stk
    Stack
stk Stack -> IO () -> IO Stack
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (() :: Constraint) => Stack -> Int -> IO ()
Stack -> Int -> IO ()
pokeTag Stack
stk Int
0
  writeForeign !Stack
stk !(Right b
b) = do
    Stack
stk <- Stack -> b -> IO Stack
forall a. ForeignConvention a => Stack -> a -> IO Stack
writeForeign Stack
stk b
b
    Stack
stk <- Stack -> IO Stack
bump Stack
stk
    Stack
stk Stack -> IO () -> IO Stack
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (() :: Constraint) => Stack -> Int -> IO ()
Stack -> Int -> IO ()
pokeTag Stack
stk Int
1

ioeDecode :: Int -> IOErrorType
ioeDecode :: Int -> IOErrorType
ioeDecode Int
0 = IOErrorType
AlreadyExists
ioeDecode Int
1 = IOErrorType
NoSuchThing
ioeDecode Int
2 = IOErrorType
ResourceBusy
ioeDecode Int
3 = IOErrorType
ResourceExhausted
ioeDecode Int
4 = IOErrorType
EOF
ioeDecode Int
5 = IOErrorType
IllegalOperation
ioeDecode Int
6 = IOErrorType
PermissionDenied
ioeDecode Int
7 = IOErrorType
UserError
ioeDecode Int
_ = String -> IOErrorType
forall a. HasCallStack => String -> a
internalBug String
"ioeDecode"

ioeEncode :: IOErrorType -> Int
ioeEncode :: IOErrorType -> Int
ioeEncode IOErrorType
AlreadyExists = Int
0
ioeEncode IOErrorType
NoSuchThing = Int
1
ioeEncode IOErrorType
ResourceBusy = Int
2
ioeEncode IOErrorType
ResourceExhausted = Int
3
ioeEncode IOErrorType
EOF = Int
4
ioeEncode IOErrorType
IllegalOperation = Int
5
ioeEncode IOErrorType
PermissionDenied = Int
6
ioeEncode IOErrorType
UserError = Int
7
ioeEncode IOErrorType
_ = String -> Int
forall a. HasCallStack => String -> a
internalBug String
"ioeDecode"

instance ForeignConvention IOException where
  readForeign :: [Int] -> Stack -> IO ([Int], IOException)
readForeign = (Int -> IOException) -> [Int] -> Stack -> IO ([Int], IOException)
forall a b.
ForeignConvention a =>
(a -> b) -> [Int] -> Stack -> IO ([Int], b)
readForeignAs (IOErrorType -> IOException
bld (IOErrorType -> IOException)
-> (Int -> IOErrorType) -> Int -> IOException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IOErrorType
ioeDecode)
    where
      bld :: IOErrorType -> IOException
bld IOErrorType
t = Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
t String
"" String
"" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing

  writeForeign :: Stack -> IOException -> IO Stack
writeForeign = (IOException -> Int) -> Stack -> IOException -> IO Stack
forall b a.
ForeignConvention b =>
(a -> b) -> Stack -> a -> IO Stack
writeForeignAs (IOErrorType -> Int
ioeEncode (IOErrorType -> Int)
-> (IOException -> IOErrorType) -> IOException -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOException -> IOErrorType
ioe_type)

readForeignAs ::
  (ForeignConvention a) =>
  (a -> b) ->
  [Int] ->
  Stack ->
  IO ([Int], b)
readForeignAs :: forall a b.
ForeignConvention a =>
(a -> b) -> [Int] -> Stack -> IO ([Int], b)
readForeignAs !a -> b
f ![Int]
args !Stack
stk = (a -> b) -> ([Int], a) -> ([Int], b)
forall a b. (a -> b) -> ([Int], a) -> ([Int], b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (([Int], a) -> ([Int], b)) -> IO ([Int], a) -> IO ([Int], b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> Stack -> IO ([Int], a)
forall a. ForeignConvention a => [Int] -> Stack -> IO ([Int], a)
readForeign [Int]
args Stack
stk

writeForeignAs ::
  (ForeignConvention b) =>
  (a -> b) ->
  Stack ->
  a ->
  IO Stack
writeForeignAs :: forall b a.
ForeignConvention b =>
(a -> b) -> Stack -> a -> IO Stack
writeForeignAs !a -> b
f !Stack
stk !a
x = Stack -> b -> IO Stack
forall a. ForeignConvention a => Stack -> a -> IO Stack
writeForeign Stack
stk (a -> b
f a
x)

readForeignEnum ::
  (Enum a) =>
  [Int] ->
  Stack ->
  IO ([Int], a)
readForeignEnum :: forall a. Enum a => [Int] -> Stack -> IO ([Int], a)
readForeignEnum = (Int -> a) -> [Int] -> Stack -> IO ([Int], a)
forall a b.
ForeignConvention a =>
(a -> b) -> [Int] -> Stack -> IO ([Int], b)
readForeignAs Int -> a
forall a. Enum a => Int -> a
toEnum

writeForeignEnum ::
  (Enum a) =>
  Stack ->
  a ->
  IO Stack
writeForeignEnum :: forall a. Enum a => Stack -> a -> IO Stack
writeForeignEnum = (a -> Int) -> Stack -> a -> IO Stack
forall b a.
ForeignConvention b =>
(a -> b) -> Stack -> a -> IO Stack
writeForeignAs a -> Int
forall a. Enum a => a -> Int
fromEnum

readForeignBuiltin ::
  (BuiltinForeign b) =>
  [Int] ->
  Stack ->
  IO ([Int], b)
readForeignBuiltin :: forall b. BuiltinForeign b => [Int] -> Stack -> IO ([Int], b)
readForeignBuiltin = (Closure -> b) -> [Int] -> Stack -> IO ([Int], b)
forall a b.
ForeignConvention a =>
(a -> b) -> [Int] -> Stack -> IO ([Int], b)
readForeignAs (Foreign -> b
forall f. BuiltinForeign f => Foreign -> f
unwrapBuiltin (Foreign -> b) -> (Closure -> Foreign) -> Closure -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Closure -> Foreign
Closure -> Foreign
marshalToForeign)

writeForeignBuiltin ::
  (BuiltinForeign b) =>
  Stack ->
  b ->
  IO Stack
writeForeignBuiltin :: forall b. BuiltinForeign b => Stack -> b -> IO Stack
writeForeignBuiltin = (b -> Closure) -> Stack -> b -> IO Stack
forall b a.
ForeignConvention b =>
(a -> b) -> Stack -> a -> IO Stack
writeForeignAs (Foreign -> Closure
Foreign (Foreign -> Closure) -> (b -> Foreign) -> b -> Closure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Foreign
forall f. BuiltinForeign f => f -> Foreign
wrapBuiltin)

writeTypeLink ::
  Stack ->
  Reference ->
  IO Stack
writeTypeLink :: Stack -> Reference -> IO Stack
writeTypeLink = (Reference -> Closure) -> Stack -> Reference -> IO Stack
forall b a.
ForeignConvention b =>
(a -> b) -> Stack -> a -> IO Stack
writeForeignAs (Foreign -> Closure
Foreign (Foreign -> Closure)
-> (Reference -> Foreign) -> Reference -> Closure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> Reference -> Foreign
forall e. Reference -> e -> Foreign
Wrap Reference
typeLinkRef)
{-# INLINE writeTypeLink #-}

readTypelink ::
  [Int] ->
  Stack ->
  IO ([Int], Reference)
readTypelink :: [Int] -> Stack -> IO ([Int], Reference)
readTypelink = (Closure -> Reference) -> [Int] -> Stack -> IO ([Int], Reference)
forall a b.
ForeignConvention a =>
(a -> b) -> [Int] -> Stack -> IO ([Int], b)
readForeignAs (Foreign -> Reference
forall a. Foreign -> a
unwrapForeign (Foreign -> Reference)
-> (Closure -> Foreign) -> Closure -> Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Closure -> Foreign
Closure -> Foreign
marshalToForeign)
{-# INLINE readTypelink #-}

instance ForeignConvention Double where
  readForeign :: [Int] -> Stack -> IO ([Int], Double)
readForeign (Int
i : [Int]
args) !Stack
stk = ([Int]
args,) (Double -> ([Int], Double)) -> IO Double -> IO ([Int], Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Stack -> Int -> IO Double
peekOffD Stack
stk Int
i
  readForeign ![Int]
_ !Stack
_ = String -> IO ([Int], Double)
forall a. String -> IO a
foreignCCError String
"Double"
  writeForeign :: Stack -> Double -> IO Stack
writeForeign !Stack
stk !Double
d =
    Stack -> IO Stack
bump Stack
stk IO Stack -> (Stack -> IO Stack) -> IO Stack
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(!Stack
stk) -> do
      Stack -> Double -> IO ()
pokeD Stack
stk Double
d
      pure Stack
stk

instance ForeignConvention Bool where
  readForeign :: [Int] -> Stack -> IO ([Int], Bool)
readForeign (Int
i : [Int]
args) !Stack
stk = do
    Bool
b <- Stack -> Int -> IO Bool
peekOffBool Stack
stk Int
i
    pure ([Int]
args, Bool
b)
  readForeign ![Int]
_ !Stack
_ = String -> IO ([Int], Bool)
forall a. String -> IO a
foreignCCError String
"Bool"
  writeForeign :: Stack -> Bool -> IO Stack
writeForeign !Stack
stk !Bool
b = do
    Stack
stk <- Stack -> IO Stack
bump Stack
stk
    (() :: Constraint) => Stack -> Bool -> IO ()
Stack -> Bool -> IO ()
pokeBool Stack
stk Bool
b
    pure Stack
stk

instance ForeignConvention String where
  readForeign :: [Int] -> Stack -> IO ([Int], String)
readForeign = (Text -> String) -> [Int] -> Stack -> IO ([Int], String)
forall a b.
ForeignConvention a =>
(a -> b) -> [Int] -> Stack -> IO ([Int], b)
readForeignAs Text -> String
unpack
  writeForeign :: Stack -> String -> IO Stack
writeForeign = (String -> Text) -> Stack -> String -> IO Stack
forall b a.
ForeignConvention b =>
(a -> b) -> Stack -> a -> IO Stack
writeForeignAs String -> Text
pack

instance ForeignConvention SeekMode where
  readForeign :: [Int] -> Stack -> IO ([Int], SeekMode)
readForeign = [Int] -> Stack -> IO ([Int], SeekMode)
forall a. Enum a => [Int] -> Stack -> IO ([Int], a)
readForeignEnum
  writeForeign :: Stack -> SeekMode -> IO Stack
writeForeign = Stack -> SeekMode -> IO Stack
forall a. Enum a => Stack -> a -> IO Stack
writeForeignEnum

instance ForeignConvention IOMode where
  readForeign :: [Int] -> Stack -> IO ([Int], IOMode)
readForeign = [Int] -> Stack -> IO ([Int], IOMode)
forall a. Enum a => [Int] -> Stack -> IO ([Int], a)
readForeignEnum
  writeForeign :: Stack -> IOMode -> IO Stack
writeForeign = Stack -> IOMode -> IO Stack
forall a. Enum a => Stack -> a -> IO Stack
writeForeignEnum

instance ForeignConvention () where
  readForeign :: [Int] -> Stack -> IO ([Int], ())
readForeign ![Int]
args !Stack
_ = ([Int], ()) -> IO ([Int], ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Int]
args, ())
  writeForeign :: Stack -> () -> IO Stack
writeForeign !Stack
stk !()
_ = Stack -> IO Stack
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Stack
stk

instance
  (ForeignConvention a, ForeignConvention b) =>
  ForeignConvention (a, b)
  where
  readForeign :: [Int] -> Stack -> IO ([Int], (a, b))
readForeign ![Int]
args !Stack
stk = do
    ([Int]
args, a
a) <- [Int] -> Stack -> IO ([Int], a)
forall a. ForeignConvention a => [Int] -> Stack -> IO ([Int], a)
readForeign [Int]
args Stack
stk
    ([Int]
args, b
b) <- [Int] -> Stack -> IO ([Int], b)
forall a. ForeignConvention a => [Int] -> Stack -> IO ([Int], a)
readForeign [Int]
args Stack
stk
    ([Int], (a, b)) -> IO ([Int], (a, b))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Int]
args, (a
a, b
b))

  writeForeign :: Stack -> (a, b) -> IO Stack
writeForeign !Stack
stk (a
x, b
y) = do
    Stack
stk <- Stack -> b -> IO Stack
forall a. ForeignConvention a => Stack -> a -> IO Stack
writeForeign Stack
stk b
y
    Stack -> a -> IO Stack
forall a. ForeignConvention a => Stack -> a -> IO Stack
writeForeign Stack
stk a
x

instance (ForeignConvention a) => ForeignConvention (F.Failure a) where
  readForeign :: [Int] -> Stack -> IO ([Int], Failure a)
readForeign ![Int]
args !Stack
stk = do
    ([Int]
args, Reference
typeref) <- [Int] -> Stack -> IO ([Int], Reference)
readTypelink [Int]
args Stack
stk
    ([Int]
args, Text
message) <- [Int] -> Stack -> IO ([Int], Text)
forall a. ForeignConvention a => [Int] -> Stack -> IO ([Int], a)
readForeign [Int]
args Stack
stk
    ([Int]
args, a
any) <- [Int] -> Stack -> IO ([Int], a)
forall a. ForeignConvention a => [Int] -> Stack -> IO ([Int], a)
readForeign [Int]
args Stack
stk
    ([Int], Failure a) -> IO ([Int], Failure a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Int]
args, Reference -> Text -> a -> Failure a
forall a. Reference -> Text -> a -> Failure a
F.Failure Reference
typeref Text
message a
any)

  writeForeign :: Stack -> Failure a -> IO Stack
writeForeign !Stack
stk (F.Failure Reference
typeref Text
message a
any) = do
    Stack
stk <- Stack -> a -> IO Stack
forall a. ForeignConvention a => Stack -> a -> IO Stack
writeForeign Stack
stk a
any
    Stack
stk <- Stack -> Text -> IO Stack
forall a. ForeignConvention a => Stack -> a -> IO Stack
writeForeign Stack
stk Text
message
    Stack -> Reference -> IO Stack
writeTypeLink Stack
stk Reference
typeref

instance
  ( ForeignConvention a,
    ForeignConvention b,
    ForeignConvention c
  ) =>
  ForeignConvention (a, b, c)
  where
  readForeign :: [Int] -> Stack -> IO ([Int], (a, b, c))
readForeign ![Int]
args !Stack
stk = do
    ([Int]
args, a
a) <- [Int] -> Stack -> IO ([Int], a)
forall a. ForeignConvention a => [Int] -> Stack -> IO ([Int], a)
readForeign [Int]
args Stack
stk
    ([Int]
args, b
b) <- [Int] -> Stack -> IO ([Int], b)
forall a. ForeignConvention a => [Int] -> Stack -> IO ([Int], a)
readForeign [Int]
args Stack
stk
    ([Int]
args, c
c) <- [Int] -> Stack -> IO ([Int], c)
forall a. ForeignConvention a => [Int] -> Stack -> IO ([Int], a)
readForeign [Int]
args Stack
stk
    ([Int], (a, b, c)) -> IO ([Int], (a, b, c))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Int]
args, (a
a, b
b, c
c))

  writeForeign :: Stack -> (a, b, c) -> IO Stack
writeForeign !Stack
stk (a
a, b
b, c
c) = do
    Stack
stk <- Stack -> c -> IO Stack
forall a. ForeignConvention a => Stack -> a -> IO Stack
writeForeign Stack
stk c
c
    Stack
stk <- Stack -> b -> IO Stack
forall a. ForeignConvention a => Stack -> a -> IO Stack
writeForeign Stack
stk b
b
    Stack -> a -> IO Stack
forall a. ForeignConvention a => Stack -> a -> IO Stack
writeForeign Stack
stk a
a

instance
  ( ForeignConvention a,
    ForeignConvention b,
    ForeignConvention c,
    ForeignConvention d
  ) =>
  ForeignConvention (a, b, c, d)
  where
  readForeign :: [Int] -> Stack -> IO ([Int], (a, b, c, d))
readForeign ![Int]
args !Stack
stk = do
    ([Int]
args, a
a) <- [Int] -> Stack -> IO ([Int], a)
forall a. ForeignConvention a => [Int] -> Stack -> IO ([Int], a)
readForeign [Int]
args Stack
stk
    ([Int]
args, b
b) <- [Int] -> Stack -> IO ([Int], b)
forall a. ForeignConvention a => [Int] -> Stack -> IO ([Int], a)
readForeign [Int]
args Stack
stk
    ([Int]
args, c
c) <- [Int] -> Stack -> IO ([Int], c)
forall a. ForeignConvention a => [Int] -> Stack -> IO ([Int], a)
readForeign [Int]
args Stack
stk
    ([Int]
args, d
d) <- [Int] -> Stack -> IO ([Int], d)
forall a. ForeignConvention a => [Int] -> Stack -> IO ([Int], a)
readForeign [Int]
args Stack
stk
    ([Int], (a, b, c, d)) -> IO ([Int], (a, b, c, d))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Int]
args, (a
a, b
b, c
c, d
d))

  writeForeign :: Stack -> (a, b, c, d) -> IO Stack
writeForeign !Stack
stk (a
a, b
b, c
c, d
d) = do
    Stack
stk <- Stack -> d -> IO Stack
forall a. ForeignConvention a => Stack -> a -> IO Stack
writeForeign Stack
stk d
d
    Stack
stk <- Stack -> c -> IO Stack
forall a. ForeignConvention a => Stack -> a -> IO Stack
writeForeign Stack
stk c
c
    Stack
stk <- Stack -> b -> IO Stack
forall a. ForeignConvention a => Stack -> a -> IO Stack
writeForeign Stack
stk b
b
    Stack -> a -> IO Stack
forall a. ForeignConvention a => Stack -> a -> IO Stack
writeForeign Stack
stk a
a

instance
  ( ForeignConvention a,
    ForeignConvention b,
    ForeignConvention c,
    ForeignConvention d,
    ForeignConvention e
  ) =>
  ForeignConvention (a, b, c, d, e)
  where
  readForeign :: [Int] -> Stack -> IO ([Int], (a, b, c, d, e))
readForeign ![Int]
args !Stack
stk = do
    ([Int]
args, a
a) <- [Int] -> Stack -> IO ([Int], a)
forall a. ForeignConvention a => [Int] -> Stack -> IO ([Int], a)
readForeign [Int]
args Stack
stk
    ([Int]
args, b
b) <- [Int] -> Stack -> IO ([Int], b)
forall a. ForeignConvention a => [Int] -> Stack -> IO ([Int], a)
readForeign [Int]
args Stack
stk
    ([Int]
args, c
c) <- [Int] -> Stack -> IO ([Int], c)
forall a. ForeignConvention a => [Int] -> Stack -> IO ([Int], a)
readForeign [Int]
args Stack
stk
    ([Int]
args, d
d) <- [Int] -> Stack -> IO ([Int], d)
forall a. ForeignConvention a => [Int] -> Stack -> IO ([Int], a)
readForeign [Int]
args Stack
stk
    ([Int]
args, e
e) <- [Int] -> Stack -> IO ([Int], e)
forall a. ForeignConvention a => [Int] -> Stack -> IO ([Int], a)
readForeign [Int]
args Stack
stk
    ([Int], (a, b, c, d, e)) -> IO ([Int], (a, b, c, d, e))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Int]
args, (a
a, b
b, c
c, d
d, e
e))

  writeForeign :: Stack -> (a, b, c, d, e) -> IO Stack
writeForeign !Stack
stk (a
a, b
b, c
c, d
d, e
e) = do
    Stack
stk <- Stack -> e -> IO Stack
forall a. ForeignConvention a => Stack -> a -> IO Stack
writeForeign Stack
stk e
e
    Stack
stk <- Stack -> d -> IO Stack
forall a. ForeignConvention a => Stack -> a -> IO Stack
writeForeign Stack
stk d
d
    Stack
stk <- Stack -> c -> IO Stack
forall a. ForeignConvention a => Stack -> a -> IO Stack
writeForeign Stack
stk c
c
    Stack
stk <- Stack -> b -> IO Stack
forall a. ForeignConvention a => Stack -> a -> IO Stack
writeForeign Stack
stk b
b
    Stack -> a -> IO Stack
forall a. ForeignConvention a => Stack -> a -> IO Stack
writeForeign Stack
stk a
a

no'buf, line'buf, block'buf, sblock'buf :: Word64
no'buf :: ConstructorId
no'buf = ConstructorId -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
Ty.bufferModeNoBufferingId
line'buf :: ConstructorId
line'buf = ConstructorId -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
Ty.bufferModeLineBufferingId
block'buf :: ConstructorId
block'buf = ConstructorId -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
Ty.bufferModeBlockBufferingId
sblock'buf :: ConstructorId
sblock'buf = ConstructorId -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
Ty.bufferModeSizedBlockBufferingId

instance ForeignConvention BufferMode where
  readForeign :: [Int] -> Stack -> IO ([Int], BufferMode)
readForeign (Int
i : [Int]
args) !Stack
stk =
    Stack -> Int -> IO ConstructorId
peekOffN Stack
stk Int
i IO ConstructorId
-> (ConstructorId -> IO ([Int], BufferMode))
-> IO ([Int], BufferMode)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      ConstructorId
t
        | ConstructorId
t ConstructorId -> ConstructorId -> Bool
forall a. Eq a => a -> a -> Bool
== ConstructorId
no'buf -> ([Int], BufferMode) -> IO ([Int], BufferMode)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Int]
args, BufferMode
NoBuffering)
        | ConstructorId
t ConstructorId -> ConstructorId -> Bool
forall a. Eq a => a -> a -> Bool
== ConstructorId
line'buf -> ([Int], BufferMode) -> IO ([Int], BufferMode)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Int]
args, BufferMode
LineBuffering)
        | ConstructorId
t ConstructorId -> ConstructorId -> Bool
forall a. Eq a => a -> a -> Bool
== ConstructorId
block'buf -> ([Int], BufferMode) -> IO ([Int], BufferMode)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Int]
args, Maybe Int -> BufferMode
BlockBuffering Maybe Int
forall a. Maybe a
Nothing)
        | ConstructorId
t ConstructorId -> ConstructorId -> Bool
forall a. Eq a => a -> a -> Bool
== ConstructorId
sblock'buf ->
            (Int -> BufferMode) -> ([Int], Int) -> ([Int], BufferMode)
forall a b. (a -> b) -> ([Int], a) -> ([Int], b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Int -> BufferMode
BlockBuffering (Maybe Int -> BufferMode)
-> (Int -> Maybe Int) -> Int -> BufferMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Int
forall a. a -> Maybe a
Just)
              (([Int], Int) -> ([Int], BufferMode))
-> IO ([Int], Int) -> IO ([Int], BufferMode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> Stack -> IO ([Int], Int)
forall a. ForeignConvention a => [Int] -> Stack -> IO ([Int], a)
readForeign [Int]
args Stack
stk
        | Bool
otherwise ->
            String -> IO ([Int], BufferMode)
forall a. String -> IO a
foreignCCError (String -> IO ([Int], BufferMode))
-> String -> IO ([Int], BufferMode)
forall a b. (a -> b) -> a -> b
$
              String
"BufferMode (unknown tag: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ConstructorId -> String
forall a. Show a => a -> String
show ConstructorId
t String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")"
  readForeign ![Int]
_ !Stack
_ = String -> IO ([Int], BufferMode)
forall a. String -> IO a
foreignCCError (String -> IO ([Int], BufferMode))
-> String -> IO ([Int], BufferMode)
forall a b. (a -> b) -> a -> b
$ String
"BufferMode (empty stack)"

  writeForeign :: Stack -> BufferMode -> IO Stack
writeForeign !Stack
stk !BufferMode
bm =
    Stack -> IO Stack
bump Stack
stk IO Stack -> (Stack -> IO Stack) -> IO Stack
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Stack
stk) ->
      case BufferMode
bm of
        BufferMode
NoBuffering -> Stack
stk Stack -> IO () -> IO Stack
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Stack -> ConstructorId -> IO ()
pokeN Stack
stk ConstructorId
no'buf
        BufferMode
LineBuffering -> Stack
stk Stack -> IO () -> IO Stack
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Stack -> ConstructorId -> IO ()
pokeN Stack
stk ConstructorId
line'buf
        BlockBuffering Maybe Int
Nothing -> Stack
stk Stack -> IO () -> IO Stack
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Stack -> ConstructorId -> IO ()
pokeN Stack
stk ConstructorId
block'buf
        BlockBuffering (Just Int
n) -> do
          Stack -> Int -> IO ()
pokeI Stack
stk Int
n
          Stack
stk <- Stack -> IO Stack
bump Stack
stk
          Stack
stk Stack -> IO () -> IO Stack
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Stack -> ConstructorId -> IO ()
pokeN Stack
stk ConstructorId
sblock'buf

-- In reality this fixes the type to be 'RClosure', but allows us to defer
-- the typechecker a bit and avoid a bunch of annoying type annotations.
instance {-# OVERLAPPING #-} ForeignConvention [Val] where
  readForeign :: [Int] -> Stack -> IO ([Int], [Val])
readForeign (Int
i : [Int]
args) !Stack
stk =
    ([Int]
args,) ([Val] -> ([Int], [Val]))
-> (Seq Val -> [Val]) -> Seq Val -> ([Int], [Val])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Val -> [Val]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq Val -> ([Int], [Val])) -> IO (Seq Val) -> IO ([Int], [Val])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Stack -> Int -> IO (Seq Val)
peekOffS Stack
stk Int
i
  readForeign ![Int]
_ !Stack
_ = String -> IO ([Int], [Val])
forall a. String -> IO a
foreignCCError String
"[Val]"
  writeForeign :: Stack -> [Val] -> IO Stack
writeForeign !Stack
stk ![Val]
l = do
    Stack
stk <- Stack -> IO Stack
bump Stack
stk
    Stack
stk Stack -> IO () -> IO Stack
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Stack -> Seq Val -> IO ()
pokeS Stack
stk ([Val] -> Seq Val
forall a. [a] -> Seq a
Sq.fromList [Val]
l)

-- In reality this fixes the type to be 'RClosure', but allows us to defer
-- the typechecker a bit and avoid a bunch of annoying type annotations.
instance {-# OVERLAPPING #-} ForeignConvention [Closure] where
  readForeign :: [Int] -> Stack -> IO ([Int], [Closure])
readForeign (Int
i : [Int]
args) !Stack
stk =
    ([Int]
args,) ([Closure] -> ([Int], [Closure]))
-> (Seq Val -> [Closure]) -> Seq Val -> ([Int], [Closure])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Val -> Closure) -> [Val] -> [Closure]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Val -> Closure
getBoxedVal ([Val] -> [Closure]) -> (Seq Val -> [Val]) -> Seq Val -> [Closure]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Val -> [Val]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq Val -> ([Int], [Closure]))
-> IO (Seq Val) -> IO ([Int], [Closure])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Stack -> Int -> IO (Seq Val)
peekOffS Stack
stk Int
i
  readForeign ![Int]
_ !Stack
_ = String -> IO ([Int], [Closure])
forall a. String -> IO a
foreignCCError String
"[Closure]"
  writeForeign :: Stack -> [Closure] -> IO Stack
writeForeign !Stack
stk ![Closure]
l = do
    Stack
stk <- Stack -> IO Stack
bump Stack
stk
    Stack
stk Stack -> IO () -> IO Stack
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Stack -> Seq Val -> IO ()
pokeS Stack
stk ([Val] -> Seq Val
forall a. [a] -> Seq a
Sq.fromList ([Val] -> Seq Val) -> ([Closure] -> [Val]) -> [Closure] -> Seq Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Closure -> Val) -> [Closure] -> [Val]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Closure -> Val
BoxedVal ([Closure] -> Seq Val) -> [Closure] -> Seq Val
forall a b. (a -> b) -> a -> b
$ [Closure]
l)

instance ForeignConvention [Foreign] where
  readForeign :: [Int] -> Stack -> IO ([Int], [Foreign])
readForeign = ([Closure] -> [Foreign]) -> [Int] -> Stack -> IO ([Int], [Foreign])
forall a b.
ForeignConvention a =>
(a -> b) -> [Int] -> Stack -> IO ([Int], b)
readForeignAs ((Closure -> Foreign) -> [Closure] -> [Foreign]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HasCallStack => Closure -> Foreign
Closure -> Foreign
marshalToForeign)
  writeForeign :: Stack -> [Foreign] -> IO Stack
writeForeign = ([Foreign] -> [Closure]) -> Stack -> [Foreign] -> IO Stack
forall b a.
ForeignConvention b =>
(a -> b) -> Stack -> a -> IO Stack
writeForeignAs ((Foreign -> Closure) -> [Foreign] -> [Closure]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Foreign -> Closure
Foreign)

instance ForeignConvention (MVar Val) where
  readForeign :: [Int] -> Stack -> IO ([Int], MVar Val)
readForeign = (Closure -> MVar Val) -> [Int] -> Stack -> IO ([Int], MVar Val)
forall a b.
ForeignConvention a =>
(a -> b) -> [Int] -> Stack -> IO ([Int], b)
readForeignAs (Foreign -> MVar Val
forall a. Foreign -> a
unwrapForeign (Foreign -> MVar Val)
-> (Closure -> Foreign) -> Closure -> MVar Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Closure -> Foreign
Closure -> Foreign
marshalToForeign)
  writeForeign :: Stack -> MVar Val -> IO Stack
writeForeign = (MVar Val -> Closure) -> Stack -> MVar Val -> IO Stack
forall b a.
ForeignConvention b =>
(a -> b) -> Stack -> a -> IO Stack
writeForeignAs (Foreign -> Closure
Foreign (Foreign -> Closure)
-> (MVar Val -> Foreign) -> MVar Val -> Closure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> MVar Val -> Foreign
forall e. Reference -> e -> Foreign
Wrap Reference
mvarRef)

instance ForeignConvention (TVar Val) where
  readForeign :: [Int] -> Stack -> IO ([Int], TVar Val)
readForeign = (Closure -> TVar Val) -> [Int] -> Stack -> IO ([Int], TVar Val)
forall a b.
ForeignConvention a =>
(a -> b) -> [Int] -> Stack -> IO ([Int], b)
readForeignAs (Foreign -> TVar Val
forall a. Foreign -> a
unwrapForeign (Foreign -> TVar Val)
-> (Closure -> Foreign) -> Closure -> TVar Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Closure -> Foreign
Closure -> Foreign
marshalToForeign)
  writeForeign :: Stack -> TVar Val -> IO Stack
writeForeign = (TVar Val -> Closure) -> Stack -> TVar Val -> IO Stack
forall b a.
ForeignConvention b =>
(a -> b) -> Stack -> a -> IO Stack
writeForeignAs (Foreign -> Closure
Foreign (Foreign -> Closure)
-> (TVar Val -> Foreign) -> TVar Val -> Closure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> TVar Val -> Foreign
forall e. Reference -> e -> Foreign
Wrap Reference
tvarRef)

instance ForeignConvention (IORef Val) where
  readForeign :: [Int] -> Stack -> IO ([Int], IORef Val)
readForeign = (Closure -> IORef Val) -> [Int] -> Stack -> IO ([Int], IORef Val)
forall a b.
ForeignConvention a =>
(a -> b) -> [Int] -> Stack -> IO ([Int], b)
readForeignAs (Foreign -> IORef Val
forall a. Foreign -> a
unwrapForeign (Foreign -> IORef Val)
-> (Closure -> Foreign) -> Closure -> IORef Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Closure -> Foreign
Closure -> Foreign
marshalToForeign)
  writeForeign :: Stack -> IORef Val -> IO Stack
writeForeign = (IORef Val -> Closure) -> Stack -> IORef Val -> IO Stack
forall b a.
ForeignConvention b =>
(a -> b) -> Stack -> a -> IO Stack
writeForeignAs (Foreign -> Closure
Foreign (Foreign -> Closure)
-> (IORef Val -> Foreign) -> IORef Val -> Closure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> IORef Val -> Foreign
forall e. Reference -> e -> Foreign
Wrap Reference
refRef)

instance ForeignConvention (Ticket Val) where
  readForeign :: [Int] -> Stack -> IO ([Int], Ticket Val)
readForeign = (Closure -> Ticket Val) -> [Int] -> Stack -> IO ([Int], Ticket Val)
forall a b.
ForeignConvention a =>
(a -> b) -> [Int] -> Stack -> IO ([Int], b)
readForeignAs (Foreign -> Ticket Val
forall a. Foreign -> a
unwrapForeign (Foreign -> Ticket Val)
-> (Closure -> Foreign) -> Closure -> Ticket Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Closure -> Foreign
Closure -> Foreign
marshalToForeign)
  writeForeign :: Stack -> Ticket Val -> IO Stack
writeForeign = (Ticket Val -> Closure) -> Stack -> Ticket Val -> IO Stack
forall b a.
ForeignConvention b =>
(a -> b) -> Stack -> a -> IO Stack
writeForeignAs (Foreign -> Closure
Foreign (Foreign -> Closure)
-> (Ticket Val -> Foreign) -> Ticket Val -> Closure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> Ticket Val -> Foreign
forall e. Reference -> e -> Foreign
Wrap Reference
ticketRef)

instance ForeignConvention (Promise Val) where
  readForeign :: [Int] -> Stack -> IO ([Int], Promise Val)
readForeign = (Closure -> Promise Val)
-> [Int] -> Stack -> IO ([Int], Promise Val)
forall a b.
ForeignConvention a =>
(a -> b) -> [Int] -> Stack -> IO ([Int], b)
readForeignAs (Foreign -> Promise Val
forall a. Foreign -> a
unwrapForeign (Foreign -> Promise Val)
-> (Closure -> Foreign) -> Closure -> Promise Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Closure -> Foreign
Closure -> Foreign
marshalToForeign)
  writeForeign :: Stack -> Promise Val -> IO Stack
writeForeign = (Promise Val -> Closure) -> Stack -> Promise Val -> IO Stack
forall b a.
ForeignConvention b =>
(a -> b) -> Stack -> a -> IO Stack
writeForeignAs (Foreign -> Closure
Foreign (Foreign -> Closure)
-> (Promise Val -> Foreign) -> Promise Val -> Closure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> Promise Val -> Foreign
forall e. Reference -> e -> Foreign
Wrap Reference
promiseRef)

instance ForeignConvention Code where
  readForeign :: [Int] -> Stack -> IO ([Int], Code)
readForeign = [Int] -> Stack -> IO ([Int], Code)
forall b. BuiltinForeign b => [Int] -> Stack -> IO ([Int], b)
readForeignBuiltin
  writeForeign :: Stack -> Code -> IO Stack
writeForeign = Stack -> Code -> IO Stack
forall b. BuiltinForeign b => Stack -> b -> IO Stack
writeForeignBuiltin

instance ForeignConvention Value where
  readForeign :: [Int] -> Stack -> IO ([Int], Value)
readForeign = [Int] -> Stack -> IO ([Int], Value)
forall b. BuiltinForeign b => [Int] -> Stack -> IO ([Int], b)
readForeignBuiltin
  writeForeign :: Stack -> Value -> IO Stack
writeForeign = Stack -> Value -> IO Stack
forall b. BuiltinForeign b => Stack -> b -> IO Stack
writeForeignBuiltin

instance ForeignConvention Foreign where
  readForeign :: [Int] -> Stack -> IO ([Int], Foreign)
readForeign = (Closure -> Foreign) -> [Int] -> Stack -> IO ([Int], Foreign)
forall a b.
ForeignConvention a =>
(a -> b) -> [Int] -> Stack -> IO ([Int], b)
readForeignAs HasCallStack => Closure -> Foreign
Closure -> Foreign
marshalToForeign
  writeForeign :: Stack -> Foreign -> IO Stack
writeForeign = (Foreign -> Closure) -> Stack -> Foreign -> IO Stack
forall b a.
ForeignConvention b =>
(a -> b) -> Stack -> a -> IO Stack
writeForeignAs Foreign -> Closure
Foreign

instance ForeignConvention (PA.MutableArray s Val) where
  readForeign :: [Int] -> Stack -> IO ([Int], MutableArray s Val)
readForeign = (Closure -> MutableArray s Val)
-> [Int] -> Stack -> IO ([Int], MutableArray s Val)
forall a b.
ForeignConvention a =>
(a -> b) -> [Int] -> Stack -> IO ([Int], b)
readForeignAs (Foreign -> MutableArray s Val
forall a. Foreign -> a
unwrapForeign (Foreign -> MutableArray s Val)
-> (Closure -> Foreign) -> Closure -> MutableArray s Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Closure -> Foreign
Closure -> Foreign
marshalToForeign)
  writeForeign :: Stack -> MutableArray s Val -> IO Stack
writeForeign = (MutableArray s Val -> Closure)
-> Stack -> MutableArray s Val -> IO Stack
forall b a.
ForeignConvention b =>
(a -> b) -> Stack -> a -> IO Stack
writeForeignAs (Foreign -> Closure
Foreign (Foreign -> Closure)
-> (MutableArray s Val -> Foreign) -> MutableArray s Val -> Closure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> MutableArray s Val -> Foreign
forall e. Reference -> e -> Foreign
Wrap Reference
marrayRef)

instance ForeignConvention (PA.MutableByteArray s) where
  readForeign :: [Int] -> Stack -> IO ([Int], MutableByteArray s)
readForeign = (Closure -> MutableByteArray s)
-> [Int] -> Stack -> IO ([Int], MutableByteArray s)
forall a b.
ForeignConvention a =>
(a -> b) -> [Int] -> Stack -> IO ([Int], b)
readForeignAs (Foreign -> MutableByteArray s
forall a. Foreign -> a
unwrapForeign (Foreign -> MutableByteArray s)
-> (Closure -> Foreign) -> Closure -> MutableByteArray s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Closure -> Foreign
Closure -> Foreign
marshalToForeign)
  writeForeign :: Stack -> MutableByteArray s -> IO Stack
writeForeign = (MutableByteArray s -> Closure)
-> Stack -> MutableByteArray s -> IO Stack
forall b a.
ForeignConvention b =>
(a -> b) -> Stack -> a -> IO Stack
writeForeignAs (Foreign -> Closure
Foreign (Foreign -> Closure)
-> (MutableByteArray s -> Foreign) -> MutableByteArray s -> Closure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> MutableByteArray s -> Foreign
forall e. Reference -> e -> Foreign
Wrap Reference
mbytearrayRef)

instance ForeignConvention (PA.Array Val) where
  readForeign :: [Int] -> Stack -> IO ([Int], Array Val)
readForeign = (Closure -> Array Val) -> [Int] -> Stack -> IO ([Int], Array Val)
forall a b.
ForeignConvention a =>
(a -> b) -> [Int] -> Stack -> IO ([Int], b)
readForeignAs (Foreign -> Array Val
forall a. Foreign -> a
unwrapForeign (Foreign -> Array Val)
-> (Closure -> Foreign) -> Closure -> Array Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Closure -> Foreign
Closure -> Foreign
marshalToForeign)
  writeForeign :: Stack -> Array Val -> IO Stack
writeForeign = (Array Val -> Closure) -> Stack -> Array Val -> IO Stack
forall b a.
ForeignConvention b =>
(a -> b) -> Stack -> a -> IO Stack
writeForeignAs (Foreign -> Closure
Foreign (Foreign -> Closure)
-> (Array Val -> Foreign) -> Array Val -> Closure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> Array Val -> Foreign
forall e. Reference -> e -> Foreign
Wrap Reference
iarrayRef)

instance ForeignConvention PA.ByteArray where
  readForeign :: [Int] -> Stack -> IO ([Int], ByteArray)
readForeign = (Closure -> ByteArray) -> [Int] -> Stack -> IO ([Int], ByteArray)
forall a b.
ForeignConvention a =>
(a -> b) -> [Int] -> Stack -> IO ([Int], b)
readForeignAs (Foreign -> ByteArray
forall a. Foreign -> a
unwrapForeign (Foreign -> ByteArray)
-> (Closure -> Foreign) -> Closure -> ByteArray
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Closure -> Foreign
Closure -> Foreign
marshalToForeign)
  writeForeign :: Stack -> ByteArray -> IO Stack
writeForeign = (ByteArray -> Closure) -> Stack -> ByteArray -> IO Stack
forall b a.
ForeignConvention b =>
(a -> b) -> Stack -> a -> IO Stack
writeForeignAs (Foreign -> Closure
Foreign (Foreign -> Closure)
-> (ByteArray -> Foreign) -> ByteArray -> Closure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> ByteArray -> Foreign
forall e. Reference -> e -> Foreign
Wrap Reference
ibytearrayRef)

instance {-# OVERLAPPABLE #-} (BuiltinForeign b) => ForeignConvention b where
  readForeign :: [Int] -> Stack -> IO ([Int], b)
readForeign = [Int] -> Stack -> IO ([Int], b)
forall b. BuiltinForeign b => [Int] -> Stack -> IO ([Int], b)
readForeignBuiltin
  writeForeign :: Stack -> b -> IO Stack
writeForeign = Stack -> b -> IO Stack
forall b. BuiltinForeign b => Stack -> b -> IO Stack
writeForeignBuiltin

fromUnisonPair :: (BuiltinForeign a, BuiltinForeign b) => Closure -> (a, b)
fromUnisonPair :: forall a b.
(BuiltinForeign a, BuiltinForeign b) =>
Closure -> (a, b)
fromUnisonPair (DataC Reference
_ PackedTag
_ [BoxedVal Closure
x, BoxedVal (DataC Reference
_ PackedTag
_ [BoxedVal Closure
y, BoxedVal Closure
_unit])]) =
  (Closure -> a
forall a. Closure -> a
unwrapForeignClosure Closure
x, Closure -> b
forall a. Closure -> a
unwrapForeignClosure Closure
y)
fromUnisonPair Closure
_ = String -> (a, b)
forall a. HasCallStack => String -> a
error String
"fromUnisonPair: invalid closure"

toUnisonPair ::
  (BuiltinForeign a, BuiltinForeign b) => (a, b) -> Closure
toUnisonPair :: forall a b.
(BuiltinForeign a, BuiltinForeign b) =>
(a, b) -> Closure
toUnisonPair (a
x, b
y) =
  Reference -> PackedTag -> [Val] -> Closure
DataC
    Reference
Ty.pairRef
    (ConstructorId -> PackedTag
PackedTag ConstructorId
0)
    [Closure -> Val
BoxedVal (Closure -> Val) -> Closure -> Val
forall a b. (a -> b) -> a -> b
$ a -> Closure
forall {f}. BuiltinForeign f => f -> Closure
wr a
x, Closure -> Val
BoxedVal (Closure -> Val) -> Closure -> Val
forall a b. (a -> b) -> a -> b
$ Reference -> PackedTag -> [Val] -> Closure
DataC Reference
Ty.pairRef (ConstructorId -> PackedTag
PackedTag ConstructorId
0) [Closure -> Val
BoxedVal (Closure -> Val) -> Closure -> Val
forall a b. (a -> b) -> a -> b
$ b -> Closure
forall {f}. BuiltinForeign f => f -> Closure
wr b
y, Closure -> Val
BoxedVal (Closure -> Val) -> Closure -> Val
forall a b. (a -> b) -> a -> b
$ Closure
un]]
  where
    un :: Closure
un = Reference -> PackedTag -> [Val] -> Closure
DataC Reference
Ty.unitRef (ConstructorId -> PackedTag
PackedTag ConstructorId
0) []
    wr :: f -> Closure
wr f
z = Foreign -> Closure
Foreign (Foreign -> Closure) -> Foreign -> Closure
forall a b. (a -> b) -> a -> b
$ f -> Foreign
forall f. BuiltinForeign f => f -> Foreign
wrapBuiltin f
z

unwrapForeignClosure :: Closure -> a
unwrapForeignClosure :: forall a. Closure -> a
unwrapForeignClosure = Foreign -> a
forall a. Foreign -> a
unwrapForeign (Foreign -> a) -> (Closure -> Foreign) -> Closure -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Closure -> Foreign
Closure -> Foreign
marshalToForeign

instance {-# OVERLAPPABLE #-} (BuiltinForeign a, BuiltinForeign b) => ForeignConvention [(a, b)] where
  readForeign :: [Int] -> Stack -> IO ([Int], [(a, b)])
readForeign (Int
i : [Int]
args) !Stack
stk =
    ([Int]
args,)
      ([(a, b)] -> ([Int], [(a, b)]))
-> (Seq Val -> [(a, b)]) -> Seq Val -> ([Int], [(a, b)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Val -> (a, b)) -> [Val] -> [(a, b)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Closure -> (a, b)
forall a b.
(BuiltinForeign a, BuiltinForeign b) =>
Closure -> (a, b)
fromUnisonPair (Closure -> (a, b)) -> (Val -> Closure) -> Val -> (a, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Val -> Closure
getBoxedVal)
      ([Val] -> [(a, b)]) -> (Seq Val -> [Val]) -> Seq Val -> [(a, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Val -> [Val]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
      (Seq Val -> ([Int], [(a, b)]))
-> IO (Seq Val) -> IO ([Int], [(a, b)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Stack -> Int -> IO (Seq Val)
peekOffS Stack
stk Int
i
  readForeign ![Int]
_ !Stack
_ = String -> IO ([Int], [(a, b)])
forall a. String -> IO a
foreignCCError String
"[(a,b)]"

  writeForeign :: Stack -> [(a, b)] -> IO Stack
writeForeign !Stack
stk ![(a, b)]
l = do
    Stack
stk <- Stack -> IO Stack
bump Stack
stk
    Stack
stk Stack -> IO () -> IO Stack
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Stack -> Seq Val -> IO ()
pokeS Stack
stk (Closure -> Val
boxedVal (Closure -> Val) -> ((a, b) -> Closure) -> (a, b) -> Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b) -> Closure
forall a b.
(BuiltinForeign a, BuiltinForeign b) =>
(a, b) -> Closure
toUnisonPair ((a, b) -> Val) -> Seq (a, b) -> Seq Val
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(a, b)] -> Seq (a, b)
forall a. [a] -> Seq a
Sq.fromList [(a, b)]
l)

instance {-# OVERLAPPABLE #-} (BuiltinForeign b) => ForeignConvention [b] where
  readForeign :: [Int] -> Stack -> IO ([Int], [b])
readForeign (Int
i : [Int]
args) !Stack
stk =
    ([Int]
args,)
      ([b] -> ([Int], [b]))
-> (Seq Val -> [b]) -> Seq Val -> ([Int], [b])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Val -> b) -> [Val] -> [b]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Closure -> b
forall a. Closure -> a
unwrapForeignClosure (Closure -> b) -> (Val -> Closure) -> Val -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Val -> Closure
getBoxedVal)
      ([Val] -> [b]) -> (Seq Val -> [Val]) -> Seq Val -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Val -> [Val]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
      (Seq Val -> ([Int], [b])) -> IO (Seq Val) -> IO ([Int], [b])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Stack -> Int -> IO (Seq Val)
peekOffS Stack
stk Int
i
  readForeign ![Int]
_ !Stack
_ = String -> IO ([Int], [b])
forall a. String -> IO a
foreignCCError String
"[b]"
  writeForeign :: Stack -> [b] -> IO Stack
writeForeign !Stack
stk ![b]
l = do
    Stack
stk <- Stack -> IO Stack
bump Stack
stk
    Stack
stk Stack -> IO () -> IO Stack
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Stack -> Seq Val -> IO ()
pokeS Stack
stk (Closure -> Val
boxedVal (Closure -> Val) -> (b -> Closure) -> b -> Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Foreign -> Closure
Foreign (Foreign -> Closure) -> (b -> Foreign) -> b -> Closure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Foreign
forall f. BuiltinForeign f => f -> Foreign
wrapBuiltin (b -> Val) -> Seq b -> Seq Val
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [b] -> Seq b
forall a. [a] -> Seq a
Sq.fromList [b]
l)

foreignCCError :: String -> IO a
foreignCCError :: forall a. String -> IO a
foreignCCError String
nm =
  String -> IO a
forall a. HasCallStack => String -> IO a
die (String -> IO a) -> String -> IO a
forall a b. (a -> b) -> a -> b
$ String
"mismatched foreign calling convention for `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
nm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"`"