{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeSynonymInstances #-}

module FFICXX.Runtime.Cast where

import Data.ByteString.Char8 (ByteString,packCString, useAsCString)
import Data.Word
import Data.Int
import Foreign.C
import Foreign.Marshal.Array
import Foreign.Ptr


class IsRawType a

class Castable a b where
  cast   :: a -> (b -> IO r) -> IO r
  uncast :: b -> (a -> IO r) -> IO r

class FPtr a where
  type Raw a :: *
  get_fptr :: a -> Ptr (Raw a)
  cast_fptr_to_obj :: Ptr (Raw a) -> a


class FunPtrWrappable a where
  type FunPtrHsType a :: *
  type FunPtrType a :: *
  data FunPtrWrapped a :: *
  fptrWrap :: FunPtrWrapped a -> IO (FunPtr (FunPtrType a))
  wrap :: FunPtrHsType a -> FunPtrWrapped a


class IsCType a where

instance IsCType CBool
instance IsCType CChar
instance IsCType CClock
instance IsCType CDouble
instance IsCType CFile
instance IsCType CFloat
instance IsCType CFpos
instance IsCType CInt
instance IsCType CIntMax
instance IsCType CIntPtr
instance IsCType CJmpBuf
instance IsCType CLLong
instance IsCType CLong
instance IsCType CPtrdiff
instance IsCType CSChar
instance IsCType CSUSeconds
instance IsCType CShort
instance IsCType CSigAtomic
instance IsCType CSize
instance IsCType CTime
instance IsCType CUChar
instance IsCType CUInt
instance IsCType CUIntMax
instance IsCType CUIntPtr
instance IsCType CULLong
instance IsCType CULong
instance IsCType CUSeconds
instance IsCType CUShort
instance IsCType CWchar
instance IsCType CString
instance IsCType Int8
instance IsCType Int16
instance IsCType Int32
instance IsCType Int64
instance IsCType Word8
instance IsCType Word16
instance IsCType Word32
instance IsCType Word64


instance Castable () () where
  cast :: () -> (() -> IO r) -> IO r
cast ()
x () -> IO r
f = () -> IO r
f ()
x
  uncast :: () -> (() -> IO r) -> IO r
uncast ()
x () -> IO r
f = () -> IO r
f ()
x

instance Castable CBool CBool where
  cast :: CBool -> (CBool -> IO r) -> IO r
cast CBool
x CBool -> IO r
f = CBool -> IO r
f CBool
x
  uncast :: CBool -> (CBool -> IO r) -> IO r
uncast CBool
x CBool -> IO r
f = CBool -> IO r
f CBool
x

instance Castable CChar CChar where
  cast :: CChar -> (CChar -> IO r) -> IO r
cast CChar
x CChar -> IO r
f = CChar -> IO r
f CChar
x
  uncast :: CChar -> (CChar -> IO r) -> IO r
uncast CChar
x CChar -> IO r
f = CChar -> IO r
f CChar
x

instance Castable CClock CClock where
  cast :: CClock -> (CClock -> IO r) -> IO r
cast CClock
x CClock -> IO r
f = CClock -> IO r
f CClock
x
  uncast :: CClock -> (CClock -> IO r) -> IO r
uncast CClock
x CClock -> IO r
f = CClock -> IO r
f CClock
x

instance Castable CDouble CDouble where
  cast :: CDouble -> (CDouble -> IO r) -> IO r
cast CDouble
x CDouble -> IO r
f = CDouble -> IO r
f CDouble
x
  uncast :: CDouble -> (CDouble -> IO r) -> IO r
uncast CDouble
x CDouble -> IO r
f = CDouble -> IO r
f CDouble
x

instance Castable CFile CFile where
  cast :: CFile -> (CFile -> IO r) -> IO r
cast CFile
x CFile -> IO r
f = CFile -> IO r
f CFile
x
  uncast :: CFile -> (CFile -> IO r) -> IO r
uncast CFile
x CFile -> IO r
f = CFile -> IO r
f CFile
x

instance Castable CFloat CFloat where
  cast :: CFloat -> (CFloat -> IO r) -> IO r
cast CFloat
x CFloat -> IO r
f = CFloat -> IO r
f CFloat
x
  uncast :: CFloat -> (CFloat -> IO r) -> IO r
uncast CFloat
x CFloat -> IO r
f = CFloat -> IO r
f CFloat
x

instance Castable CFpos CFpos where
  cast :: CFpos -> (CFpos -> IO r) -> IO r
cast CFpos
x CFpos -> IO r
f = CFpos -> IO r
f CFpos
x
  uncast :: CFpos -> (CFpos -> IO r) -> IO r
uncast CFpos
x CFpos -> IO r
f = CFpos -> IO r
f CFpos
x

instance Castable CInt CInt where
  cast :: CInt -> (CInt -> IO r) -> IO r
cast CInt
x CInt -> IO r
f = CInt -> IO r
f CInt
x
  uncast :: CInt -> (CInt -> IO r) -> IO r
uncast CInt
x CInt -> IO r
f = CInt -> IO r
f CInt
x

instance Castable CIntMax CIntMax where
  cast :: CIntMax -> (CIntMax -> IO r) -> IO r
cast CIntMax
x CIntMax -> IO r
f = CIntMax -> IO r
f CIntMax
x
  uncast :: CIntMax -> (CIntMax -> IO r) -> IO r
uncast CIntMax
x CIntMax -> IO r
f = CIntMax -> IO r
f CIntMax
x

instance Castable CIntPtr CIntPtr where
  cast :: CIntPtr -> (CIntPtr -> IO r) -> IO r
cast CIntPtr
x CIntPtr -> IO r
f = CIntPtr -> IO r
f CIntPtr
x
  uncast :: CIntPtr -> (CIntPtr -> IO r) -> IO r
uncast CIntPtr
x CIntPtr -> IO r
f = CIntPtr -> IO r
f CIntPtr
x

instance Castable CJmpBuf CJmpBuf where
  cast :: CJmpBuf -> (CJmpBuf -> IO r) -> IO r
cast CJmpBuf
x CJmpBuf -> IO r
f = CJmpBuf -> IO r
f CJmpBuf
x
  uncast :: CJmpBuf -> (CJmpBuf -> IO r) -> IO r
uncast CJmpBuf
x CJmpBuf -> IO r
f = CJmpBuf -> IO r
f CJmpBuf
x

instance Castable CLLong CLLong where
  cast :: CLLong -> (CLLong -> IO r) -> IO r
cast CLLong
x CLLong -> IO r
f = CLLong -> IO r
f CLLong
x
  uncast :: CLLong -> (CLLong -> IO r) -> IO r
uncast CLLong
x CLLong -> IO r
f = CLLong -> IO r
f CLLong
x

instance Castable CLong CLong where
  cast :: CLong -> (CLong -> IO r) -> IO r
cast CLong
x CLong -> IO r
f = CLong -> IO r
f CLong
x
  uncast :: CLong -> (CLong -> IO r) -> IO r
uncast CLong
x CLong -> IO r
f = CLong -> IO r
f CLong
x

instance Castable CPtrdiff CPtrdiff where
  cast :: CPtrdiff -> (CPtrdiff -> IO r) -> IO r
cast CPtrdiff
x CPtrdiff -> IO r
f = CPtrdiff -> IO r
f CPtrdiff
x
  uncast :: CPtrdiff -> (CPtrdiff -> IO r) -> IO r
uncast CPtrdiff
x CPtrdiff -> IO r
f = CPtrdiff -> IO r
f CPtrdiff
x

instance Castable CSChar CSChar where
  cast :: CSChar -> (CSChar -> IO r) -> IO r
cast CSChar
x CSChar -> IO r
f = CSChar -> IO r
f CSChar
x
  uncast :: CSChar -> (CSChar -> IO r) -> IO r
uncast CSChar
x CSChar -> IO r
f = CSChar -> IO r
f CSChar
x

instance Castable CSUSeconds CSUSeconds where
  cast :: CSUSeconds -> (CSUSeconds -> IO r) -> IO r
cast CSUSeconds
x CSUSeconds -> IO r
f = CSUSeconds -> IO r
f CSUSeconds
x
  uncast :: CSUSeconds -> (CSUSeconds -> IO r) -> IO r
uncast CSUSeconds
x CSUSeconds -> IO r
f = CSUSeconds -> IO r
f CSUSeconds
x

instance Castable CShort CShort where
  cast :: CShort -> (CShort -> IO r) -> IO r
cast CShort
x CShort -> IO r
f = CShort -> IO r
f CShort
x
  uncast :: CShort -> (CShort -> IO r) -> IO r
uncast CShort
x CShort -> IO r
f = CShort -> IO r
f CShort
x

instance Castable CSigAtomic CSigAtomic where
  cast :: CSigAtomic -> (CSigAtomic -> IO r) -> IO r
cast CSigAtomic
x CSigAtomic -> IO r
f = CSigAtomic -> IO r
f CSigAtomic
x
  uncast :: CSigAtomic -> (CSigAtomic -> IO r) -> IO r
uncast CSigAtomic
x CSigAtomic -> IO r
f = CSigAtomic -> IO r
f CSigAtomic
x

instance Castable CSize CSize where
  cast :: CSize -> (CSize -> IO r) -> IO r
cast CSize
x CSize -> IO r
f = CSize -> IO r
f CSize
x
  uncast :: CSize -> (CSize -> IO r) -> IO r
uncast CSize
x CSize -> IO r
f = CSize -> IO r
f CSize
x

instance Castable CTime CTime where
  cast :: CTime -> (CTime -> IO r) -> IO r
cast CTime
x CTime -> IO r
f = CTime -> IO r
f CTime
x
  uncast :: CTime -> (CTime -> IO r) -> IO r
uncast CTime
x CTime -> IO r
f = CTime -> IO r
f CTime
x

instance Castable CUChar CUChar where
  cast :: CUChar -> (CUChar -> IO r) -> IO r
cast CUChar
x CUChar -> IO r
f = CUChar -> IO r
f CUChar
x
  uncast :: CUChar -> (CUChar -> IO r) -> IO r
uncast CUChar
x CUChar -> IO r
f = CUChar -> IO r
f CUChar
x

instance Castable CUInt CUInt where
  cast :: CUInt -> (CUInt -> IO r) -> IO r
cast CUInt
x CUInt -> IO r
f = CUInt -> IO r
f CUInt
x
  uncast :: CUInt -> (CUInt -> IO r) -> IO r
uncast CUInt
x CUInt -> IO r
f = CUInt -> IO r
f CUInt
x

instance Castable CUIntMax CUIntMax where
  cast :: CUIntMax -> (CUIntMax -> IO r) -> IO r
cast CUIntMax
x CUIntMax -> IO r
f = CUIntMax -> IO r
f CUIntMax
x
  uncast :: CUIntMax -> (CUIntMax -> IO r) -> IO r
uncast CUIntMax
x CUIntMax -> IO r
f = CUIntMax -> IO r
f CUIntMax
x

instance Castable CUIntPtr CUIntPtr where
  cast :: CUIntPtr -> (CUIntPtr -> IO r) -> IO r
cast CUIntPtr
x CUIntPtr -> IO r
f = CUIntPtr -> IO r
f CUIntPtr
x
  uncast :: CUIntPtr -> (CUIntPtr -> IO r) -> IO r
uncast CUIntPtr
x CUIntPtr -> IO r
f = CUIntPtr -> IO r
f CUIntPtr
x

instance Castable CULLong CULLong where
  cast :: CULLong -> (CULLong -> IO r) -> IO r
cast CULLong
x CULLong -> IO r
f = CULLong -> IO r
f CULLong
x
  uncast :: CULLong -> (CULLong -> IO r) -> IO r
uncast CULLong
x CULLong -> IO r
f = CULLong -> IO r
f CULLong
x

instance Castable CULong CULong where
  cast :: CULong -> (CULong -> IO r) -> IO r
cast CULong
x CULong -> IO r
f = CULong -> IO r
f CULong
x
  uncast :: CULong -> (CULong -> IO r) -> IO r
uncast CULong
x CULong -> IO r
f = CULong -> IO r
f CULong
x

instance Castable CUSeconds CUSeconds where
  cast :: CUSeconds -> (CUSeconds -> IO r) -> IO r
cast CUSeconds
x CUSeconds -> IO r
f = CUSeconds -> IO r
f CUSeconds
x
  uncast :: CUSeconds -> (CUSeconds -> IO r) -> IO r
uncast CUSeconds
x CUSeconds -> IO r
f = CUSeconds -> IO r
f CUSeconds
x

instance Castable CUShort CUShort where
  cast :: CUShort -> (CUShort -> IO r) -> IO r
cast CUShort
x CUShort -> IO r
f = CUShort -> IO r
f CUShort
x
  uncast :: CUShort -> (CUShort -> IO r) -> IO r
uncast CUShort
x CUShort -> IO r
f = CUShort -> IO r
f CUShort
x

instance Castable CWchar CWchar where
  cast :: CWchar -> (CWchar -> IO r) -> IO r
cast CWchar
x CWchar -> IO r
f = CWchar -> IO r
f CWchar
x
  uncast :: CWchar -> (CWchar -> IO r) -> IO r
uncast CWchar
x CWchar -> IO r
f = CWchar -> IO r
f CWchar
x

instance Castable Int8 Int8 where
  cast :: Int8 -> (Int8 -> IO r) -> IO r
cast Int8
x Int8 -> IO r
f = Int8 -> IO r
f Int8
x
  uncast :: Int8 -> (Int8 -> IO r) -> IO r
uncast Int8
x Int8 -> IO r
f = Int8 -> IO r
f Int8
x

instance Castable Int16 Int16 where
  cast :: Int16 -> (Int16 -> IO r) -> IO r
cast Int16
x Int16 -> IO r
f = Int16 -> IO r
f Int16
x
  uncast :: Int16 -> (Int16 -> IO r) -> IO r
uncast Int16
x Int16 -> IO r
f = Int16 -> IO r
f Int16
x

instance Castable Int32 Int32 where
  cast :: Int32 -> (Int32 -> IO r) -> IO r
cast Int32
x Int32 -> IO r
f = Int32 -> IO r
f Int32
x
  uncast :: Int32 -> (Int32 -> IO r) -> IO r
uncast Int32
x Int32 -> IO r
f = Int32 -> IO r
f Int32
x

instance Castable Int64 Int64 where
  cast :: Int64 -> (Int64 -> IO r) -> IO r
cast Int64
x Int64 -> IO r
f = Int64 -> IO r
f Int64
x
  uncast :: Int64 -> (Int64 -> IO r) -> IO r
uncast Int64
x Int64 -> IO r
f = Int64 -> IO r
f Int64
x

instance Castable Word8 Word8 where
  cast :: Word8 -> (Word8 -> IO r) -> IO r
cast Word8
x Word8 -> IO r
f = Word8 -> IO r
f Word8
x
  uncast :: Word8 -> (Word8 -> IO r) -> IO r
uncast Word8
x Word8 -> IO r
f = Word8 -> IO r
f Word8
x

instance Castable Word16 Word16 where
  cast :: Word16 -> (Word16 -> IO r) -> IO r
cast Word16
x Word16 -> IO r
f = Word16 -> IO r
f Word16
x
  uncast :: Word16 -> (Word16 -> IO r) -> IO r
uncast Word16
x Word16 -> IO r
f = Word16 -> IO r
f Word16
x

instance Castable Word32 Word32 where
  cast :: Word32 -> (Word32 -> IO r) -> IO r
cast Word32
x Word32 -> IO r
f = Word32 -> IO r
f Word32
x
  uncast :: Word32 -> (Word32 -> IO r) -> IO r
uncast Word32
x Word32 -> IO r
f = Word32 -> IO r
f Word32
x

instance Castable Word64 Word64 where
  cast :: Word64 -> (Word64 -> IO r) -> IO r
cast Word64
x Word64 -> IO r
f = Word64 -> IO r
f Word64
x
  uncast :: Word64 -> (Word64 -> IO r) -> IO r
uncast Word64
x Word64 -> IO r
f = Word64 -> IO r
f Word64
x

instance Castable (Ptr CInt) (Ptr CInt) where
  cast :: Ptr CInt -> (Ptr CInt -> IO r) -> IO r
cast Ptr CInt
x Ptr CInt -> IO r
f = Ptr CInt -> IO r
f Ptr CInt
x
  uncast :: Ptr CInt -> (Ptr CInt -> IO r) -> IO r
uncast Ptr CInt
x Ptr CInt -> IO r
f = Ptr CInt -> IO r
f Ptr CInt
x

instance Castable (Ptr CChar) (Ptr CChar) where
  cast :: CString -> (CString -> IO r) -> IO r
cast CString
x CString -> IO r
f = CString -> IO r
f CString
x
  uncast :: CString -> (CString -> IO r) -> IO r
uncast CString
x CString -> IO r
f = CString -> IO r
f CString
x

instance Castable (Ptr CUInt) (Ptr CUInt) where
  cast :: Ptr CUInt -> (Ptr CUInt -> IO r) -> IO r
cast Ptr CUInt
x Ptr CUInt -> IO r
f = Ptr CUInt -> IO r
f Ptr CUInt
x
  uncast :: Ptr CUInt -> (Ptr CUInt -> IO r) -> IO r
uncast Ptr CUInt
x Ptr CUInt -> IO r
f = Ptr CUInt -> IO r
f Ptr CUInt
x

instance Castable (Ptr CULong) (Ptr CULong) where
  cast :: Ptr CULong -> (Ptr CULong -> IO r) -> IO r
cast Ptr CULong
x Ptr CULong -> IO r
f = Ptr CULong -> IO r
f Ptr CULong
x
  uncast :: Ptr CULong -> (Ptr CULong -> IO r) -> IO r
uncast Ptr CULong
x Ptr CULong -> IO r
f = Ptr CULong -> IO r
f Ptr CULong
x

instance Castable (Ptr CLong) (Ptr CLong) where
  cast :: Ptr CLong -> (Ptr CLong -> IO r) -> IO r
cast Ptr CLong
x Ptr CLong -> IO r
f = Ptr CLong -> IO r
f Ptr CLong
x
  uncast :: Ptr CLong -> (Ptr CLong -> IO r) -> IO r
uncast Ptr CLong
x Ptr CLong -> IO r
f = Ptr CLong -> IO r
f Ptr CLong
x

instance Castable (Ptr CDouble) (Ptr CDouble) where
  cast :: Ptr CDouble -> (Ptr CDouble -> IO r) -> IO r
cast Ptr CDouble
x Ptr CDouble -> IO r
f = Ptr CDouble -> IO r
f Ptr CDouble
x
  uncast :: Ptr CDouble -> (Ptr CDouble -> IO r) -> IO r
uncast Ptr CDouble
x Ptr CDouble -> IO r
f = Ptr CDouble -> IO r
f Ptr CDouble
x

instance Castable (Ptr CString) (Ptr CString) where
  cast :: Ptr CString -> (Ptr CString -> IO r) -> IO r
cast Ptr CString
x Ptr CString -> IO r
f = Ptr CString -> IO r
f Ptr CString
x
  uncast :: Ptr CString -> (Ptr CString -> IO r) -> IO r
uncast Ptr CString
x Ptr CString -> IO r
f = Ptr CString -> IO r
f Ptr CString
x

instance Castable (Ptr ()) (Ptr ()) where
  cast :: Ptr () -> (Ptr () -> IO r) -> IO r
cast Ptr ()
x Ptr () -> IO r
f = Ptr () -> IO r
f Ptr ()
x
  uncast :: Ptr () -> (Ptr () -> IO r) -> IO r
uncast Ptr ()
x Ptr () -> IO r
f = Ptr () -> IO r
f Ptr ()
x


instance Castable Int CInt where
  cast :: Int -> (CInt -> IO r) -> IO r
cast Int
x CInt -> IO r
f = CInt -> IO r
f (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)
  uncast :: CInt -> (Int -> IO r) -> IO r
uncast CInt
x Int -> IO r
f = Int -> IO r
f (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
x)

instance Castable Int16 CShort where
  cast :: Int16 -> (CShort -> IO r) -> IO r
cast Int16
x CShort -> IO r
f = CShort -> IO r
f (Int16 -> CShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
x)
  uncast :: CShort -> (Int16 -> IO r) -> IO r
uncast CShort
x Int16 -> IO r
f = Int16 -> IO r
f (CShort -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral CShort
x)

instance Castable Int8 CChar where
  cast :: Int8 -> (CChar -> IO r) -> IO r
cast Int8
x CChar -> IO r
f = CChar -> IO r
f (Int8 -> CChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
x)
  uncast :: CChar -> (Int8 -> IO r) -> IO r
uncast CChar
x Int8 -> IO r
f = Int8 -> IO r
f (CChar -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral CChar
x)

instance Castable Word CUInt where
  cast :: Word -> (CUInt -> IO r) -> IO r
cast Word
x CUInt -> IO r
f = CUInt -> IO r
f (Word -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
x)
  uncast :: CUInt -> (Word -> IO r) -> IO r
uncast CUInt
x Word -> IO r
f = Word -> IO r
f (CUInt -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
x)

instance Castable Word8 CChar where
  cast :: Word8 -> (CChar -> IO r) -> IO r
cast Word8
x CChar -> IO r
f = CChar -> IO r
f (Word8 -> CChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x)
  uncast :: CChar -> (Word8 -> IO r) -> IO r
uncast CChar
x Word8 -> IO r
f = Word8 -> IO r
f (CChar -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral CChar
x)

instance Castable Double CDouble where
  cast :: Double -> (CDouble -> IO r) -> IO r
cast Double
x CDouble -> IO r
f = CDouble -> IO r
f (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
x)
  uncast :: CDouble -> (Double -> IO r) -> IO r
uncast CDouble
x Double -> IO r
f = Double -> IO r
f (CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
x)

-- TODO: remove this
instance Castable [Double] (Ptr CDouble) where
  cast :: [Double] -> (Ptr CDouble -> IO r) -> IO r
cast [Double]
xs Ptr CDouble -> IO r
f = [CDouble] -> IO (Ptr CDouble)
forall a. Storable a => [a] -> IO (Ptr a)
newArray ((Double -> CDouble) -> [Double] -> [CDouble]
forall a b. (a -> b) -> [a] -> [b]
map Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac [Double]
xs) IO (Ptr CDouble) -> (Ptr CDouble -> IO r) -> IO r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr CDouble -> IO r
f
  uncast :: Ptr CDouble -> ([Double] -> IO r) -> IO r
uncast Ptr CDouble
_ [Double] -> IO r
_ = IO r
forall a. HasCallStack => a
undefined

-- TODO: remove this
instance Castable [Int] (Ptr CInt) where
  cast :: [Int] -> (Ptr CInt -> IO r) -> IO r
cast [Int]
xs Ptr CInt -> IO r
f = [CInt] -> IO (Ptr CInt)
forall a. Storable a => [a] -> IO (Ptr a)
newArray ((Int -> CInt) -> [Int] -> [CInt]
forall a b. (a -> b) -> [a] -> [b]
map Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Int]
xs) IO (Ptr CInt) -> (Ptr CInt -> IO r) -> IO r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr CInt -> IO r
f
  uncast :: Ptr CInt -> ([Int] -> IO r) -> IO r
uncast Ptr CInt
_ [Int] -> IO r
_ = IO r
forall a. HasCallStack => a
undefined

instance Castable ByteString CString where
  cast :: ByteString -> (CString -> IO r) -> IO r
cast ByteString
x CString -> IO r
f = ByteString -> (CString -> IO r) -> IO r
forall r. ByteString -> (CString -> IO r) -> IO r
useAsCString ByteString
x CString -> IO r
f
  uncast :: CString -> (ByteString -> IO r) -> IO r
uncast CString
x ByteString -> IO r
f = CString -> IO ByteString
packCString CString
x IO ByteString -> (ByteString -> IO r) -> IO r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> IO r
f

-- TODO: remove this
instance Castable [ByteString] (Ptr CString) where
  cast :: [ByteString] -> (Ptr CString -> IO r) -> IO r
cast [ByteString]
xs Ptr CString -> IO r
f = do [CString]
ys <- (ByteString -> IO CString) -> [ByteString] -> IO [CString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\ByteString
x -> ByteString -> (CString -> IO CString) -> IO CString
forall r. ByteString -> (CString -> IO r) -> IO r
useAsCString ByteString
x CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return) [ByteString]
xs
                 [CString] -> (Ptr CString -> IO r) -> IO r
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [CString]
ys ((Ptr CString -> IO r) -> IO r) -> (Ptr CString -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \Ptr CString
cptr -> Ptr CString -> IO r
f Ptr CString
cptr
  uncast :: Ptr CString -> ([ByteString] -> IO r) -> IO r
uncast Ptr CString
_ [ByteString] -> IO r
_ = IO r
forall a. HasCallStack => a
undefined

{-
instance Castable String CString where
  cast x = unsafePerformIO (newCString x)
  uncast x = unsafePerformIO (peekCString x)


instance (Castable a a', Castable b b') => Castable (a->b) (a'->b') where
  cast f = cast . f . uncast
  uncast f = uncast . f . cast
-}

xformnull :: (Castable a ca) => (IO ca) -> IO a
xformnull :: IO ca -> IO a
xformnull IO ca
f = IO ca
f IO ca -> (ca -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ca
ca -> ca -> (a -> IO a) -> IO a
forall a b r. Castable a b => b -> (a -> IO r) -> IO r
uncast ca
ca a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return

xform0 :: (Castable a ca, Castable y cy)
       => (ca -> IO cy) -> a -> IO y
xform0 :: (ca -> IO cy) -> a -> IO y
xform0 ca -> IO cy
f a
a = a -> (ca -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast a
a ((ca -> IO y) -> IO y) -> (ca -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \ca
ca -> ca -> IO cy
f ca
ca IO cy -> (cy -> IO y) -> IO y
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \cy
cy -> cy -> (y -> IO y) -> IO y
forall a b r. Castable a b => b -> (a -> IO r) -> IO r
uncast cy
cy y -> IO y
forall (m :: * -> *) a. Monad m => a -> m a
return

xform1 :: (Castable a ca, Castable x1 cx1, Castable y cy)
       => (ca -> cx1 -> IO cy) -> a -> x1 -> IO y
xform1 :: (ca -> cx1 -> IO cy) -> a -> x1 -> IO y
xform1 ca -> cx1 -> IO cy
f a
a x1
x1 = a -> (ca -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast a
a ((ca -> IO y) -> IO y) -> (ca -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \ca
ca ->
                  x1 -> (cx1 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x1
x1 ((cx1 -> IO y) -> IO y) -> (cx1 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx1
cx1 ->
                    ca -> cx1 -> IO cy
f ca
ca cx1
cx1 IO cy -> (cy -> IO y) -> IO y
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \cy
cy -> cy -> (y -> IO y) -> IO y
forall a b r. Castable a b => b -> (a -> IO r) -> IO r
uncast cy
cy y -> IO y
forall (m :: * -> *) a. Monad m => a -> m a
return

xform2 :: (Castable a ca, Castable x1 cx1, Castable x2 cx2, Castable y cy)
       => (ca -> cx1 -> cx2 -> IO cy) -> a -> x1 -> x2-> IO y
xform2 :: (ca -> cx1 -> cx2 -> IO cy) -> a -> x1 -> x2 -> IO y
xform2 ca -> cx1 -> cx2 -> IO cy
f a
a x1
x1 x2
x2 = a -> (ca -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast a
a ((ca -> IO y) -> IO y) -> (ca -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \ca
ca ->
                     x1 -> (cx1 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x1
x1 ((cx1 -> IO y) -> IO y) -> (cx1 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx1
cx1 ->
                       x2 -> (cx2 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x2
x2 ((cx2 -> IO y) -> IO y) -> (cx2 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx2
cx2 ->
                         ca -> cx1 -> cx2 -> IO cy
f ca
ca cx1
cx1 cx2
cx2 IO cy -> (cy -> IO y) -> IO y
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \cy
cy -> cy -> (y -> IO y) -> IO y
forall a b r. Castable a b => b -> (a -> IO r) -> IO r
uncast cy
cy y -> IO y
forall (m :: * -> *) a. Monad m => a -> m a
return

xform3 :: (Castable a ca, Castable x1 cx1, Castable x2 cx2, Castable x3 cx3, Castable y cy)
       => (ca -> cx1 -> cx2 -> cx3 -> IO cy) -> a -> x1 -> x2 -> x3 -> IO y
xform3 :: (ca -> cx1 -> cx2 -> cx3 -> IO cy) -> a -> x1 -> x2 -> x3 -> IO y
xform3 ca -> cx1 -> cx2 -> cx3 -> IO cy
f a
a x1
x1 x2
x2 x3
x3 = a -> (ca -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast a
a ((ca -> IO y) -> IO y) -> (ca -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \ca
ca ->
                        x1 -> (cx1 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x1
x1 ((cx1 -> IO y) -> IO y) -> (cx1 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx1
cx1 ->
                          x2 -> (cx2 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x2
x2 ((cx2 -> IO y) -> IO y) -> (cx2 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx2
cx2 ->
                            x3 -> (cx3 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x3
x3 ((cx3 -> IO y) -> IO y) -> (cx3 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx3
cx3 ->
                              ca -> cx1 -> cx2 -> cx3 -> IO cy
f ca
ca cx1
cx1 cx2
cx2 cx3
cx3 IO cy -> (cy -> IO y) -> IO y
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \cy
cy -> cy -> (y -> IO y) -> IO y
forall a b r. Castable a b => b -> (a -> IO r) -> IO r
uncast cy
cy y -> IO y
forall (m :: * -> *) a. Monad m => a -> m a
return

xform4 :: (Castable a ca, Castable x1 cx1, Castable x2 cx2, Castable x3 cx3, Castable x4 cx4, Castable y cy)
       => (ca -> cx1 -> cx2 -> cx3 -> cx4 -> IO cy) -> a -> x1 -> x2 -> x3 -> x4 -> IO y
xform4 :: (ca -> cx1 -> cx2 -> cx3 -> cx4 -> IO cy)
-> a -> x1 -> x2 -> x3 -> x4 -> IO y
xform4 ca -> cx1 -> cx2 -> cx3 -> cx4 -> IO cy
f a
a x1
x1 x2
x2 x3
x3 x4
x4 =
  a -> (ca -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast a
a ((ca -> IO y) -> IO y) -> (ca -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \ca
ca ->
    x1 -> (cx1 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x1
x1 ((cx1 -> IO y) -> IO y) -> (cx1 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx1
cx1 ->
      x2 -> (cx2 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x2
x2 ((cx2 -> IO y) -> IO y) -> (cx2 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx2
cx2 ->
        x3 -> (cx3 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x3
x3 ((cx3 -> IO y) -> IO y) -> (cx3 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx3
cx3 ->
          x4 -> (cx4 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x4
x4 ((cx4 -> IO y) -> IO y) -> (cx4 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx4
cx4 ->
            ca -> cx1 -> cx2 -> cx3 -> cx4 -> IO cy
f ca
ca cx1
cx1 cx2
cx2 cx3
cx3 cx4
cx4 IO cy -> (cy -> IO y) -> IO y
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \cy
cy -> cy -> (y -> IO y) -> IO y
forall a b r. Castable a b => b -> (a -> IO r) -> IO r
uncast cy
cy y -> IO y
forall (m :: * -> *) a. Monad m => a -> m a
return


xform5 :: (Castable a ca, Castable x1 cx1, Castable x2 cx2, Castable x3 cx3, Castable x4 cx4,
           Castable x5 cx5, Castable y cy)
       => (ca -> cx1 -> cx2 -> cx3 -> cx4 -> cx5 -> IO cy) -> a -> x1 -> x2 -> x3 -> x4 -> x5 -> IO y
xform5 :: (ca -> cx1 -> cx2 -> cx3 -> cx4 -> cx5 -> IO cy)
-> a -> x1 -> x2 -> x3 -> x4 -> x5 -> IO y
xform5 ca -> cx1 -> cx2 -> cx3 -> cx4 -> cx5 -> IO cy
f a
a x1
x1 x2
x2 x3
x3 x4
x4 x5
x5 =
  a -> (ca -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast a
a ((ca -> IO y) -> IO y) -> (ca -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \ca
ca ->
    x1 -> (cx1 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x1
x1 ((cx1 -> IO y) -> IO y) -> (cx1 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx1
cx1 ->
      x2 -> (cx2 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x2
x2 ((cx2 -> IO y) -> IO y) -> (cx2 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx2
cx2 ->
        x3 -> (cx3 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x3
x3 ((cx3 -> IO y) -> IO y) -> (cx3 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx3
cx3 ->
          x4 -> (cx4 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x4
x4 ((cx4 -> IO y) -> IO y) -> (cx4 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx4
cx4 ->
            x5 -> (cx5 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x5
x5 ((cx5 -> IO y) -> IO y) -> (cx5 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx5
cx5 ->
              ca -> cx1 -> cx2 -> cx3 -> cx4 -> cx5 -> IO cy
f ca
ca cx1
cx1 cx2
cx2 cx3
cx3 cx4
cx4 cx5
cx5 IO cy -> (cy -> IO y) -> IO y
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \cy
cy -> cy -> (y -> IO y) -> IO y
forall a b r. Castable a b => b -> (a -> IO r) -> IO r
uncast cy
cy y -> IO y
forall (m :: * -> *) a. Monad m => a -> m a
return

xform6 :: (Castable a ca, Castable x1 cx1, Castable x2 cx2, Castable x3 cx3, Castable x4 cx4,
           Castable x5 cx5, Castable x6 cx6, Castable y cy)
       => (ca -> cx1 -> cx2 -> cx3 -> cx4 -> cx5 -> cx6 -> IO cy)
          -> a -> x1 -> x2 -> x3 -> x4 -> x5 -> x6 -> IO y
xform6 :: (ca -> cx1 -> cx2 -> cx3 -> cx4 -> cx5 -> cx6 -> IO cy)
-> a -> x1 -> x2 -> x3 -> x4 -> x5 -> x6 -> IO y
xform6 ca -> cx1 -> cx2 -> cx3 -> cx4 -> cx5 -> cx6 -> IO cy
f a
a x1
x1 x2
x2 x3
x3 x4
x4 x5
x5 x6
x6 =
  a -> (ca -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast a
a ((ca -> IO y) -> IO y) -> (ca -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \ca
ca ->
    x1 -> (cx1 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x1
x1 ((cx1 -> IO y) -> IO y) -> (cx1 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx1
cx1 ->
      x2 -> (cx2 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x2
x2 ((cx2 -> IO y) -> IO y) -> (cx2 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx2
cx2 ->
        x3 -> (cx3 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x3
x3 ((cx3 -> IO y) -> IO y) -> (cx3 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx3
cx3 ->
          x4 -> (cx4 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x4
x4 ((cx4 -> IO y) -> IO y) -> (cx4 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx4
cx4 ->
            x5 -> (cx5 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x5
x5 ((cx5 -> IO y) -> IO y) -> (cx5 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx5
cx5 ->
              x6 -> (cx6 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x6
x6 ((cx6 -> IO y) -> IO y) -> (cx6 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx6
cx6 ->
                ca -> cx1 -> cx2 -> cx3 -> cx4 -> cx5 -> cx6 -> IO cy
f ca
ca cx1
cx1 cx2
cx2 cx3
cx3 cx4
cx4 cx5
cx5 cx6
cx6 IO cy -> (cy -> IO y) -> IO y
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \cy
cy -> cy -> (y -> IO y) -> IO y
forall a b r. Castable a b => b -> (a -> IO r) -> IO r
uncast cy
cy y -> IO y
forall (m :: * -> *) a. Monad m => a -> m a
return

xform7 :: (Castable a ca, Castable x1 cx1, Castable x2 cx2, Castable x3 cx3, Castable x4 cx4,
           Castable x5 cx5, Castable x6 cx6, Castable x7 cx7, Castable y cy)
       => (ca -> cx1 -> cx2 -> cx3 -> cx4 -> cx5 -> cx6 -> cx7 -> IO cy)
          -> a -> x1 -> x2 -> x3 -> x4 -> x5 -> x6 -> x7 -> IO y
xform7 :: (ca -> cx1 -> cx2 -> cx3 -> cx4 -> cx5 -> cx6 -> cx7 -> IO cy)
-> a -> x1 -> x2 -> x3 -> x4 -> x5 -> x6 -> x7 -> IO y
xform7 ca -> cx1 -> cx2 -> cx3 -> cx4 -> cx5 -> cx6 -> cx7 -> IO cy
f a
a x1
x1 x2
x2 x3
x3 x4
x4 x5
x5 x6
x6 x7
x7 =
  a -> (ca -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast a
a ((ca -> IO y) -> IO y) -> (ca -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \ca
ca ->
    x1 -> (cx1 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x1
x1 ((cx1 -> IO y) -> IO y) -> (cx1 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx1
cx1 ->
      x2 -> (cx2 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x2
x2 ((cx2 -> IO y) -> IO y) -> (cx2 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx2
cx2 ->
        x3 -> (cx3 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x3
x3 ((cx3 -> IO y) -> IO y) -> (cx3 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx3
cx3 ->
          x4 -> (cx4 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x4
x4 ((cx4 -> IO y) -> IO y) -> (cx4 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx4
cx4 ->
            x5 -> (cx5 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x5
x5 ((cx5 -> IO y) -> IO y) -> (cx5 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx5
cx5 ->
              x6 -> (cx6 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x6
x6 ((cx6 -> IO y) -> IO y) -> (cx6 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx6
cx6 ->
                x7 -> (cx7 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x7
x7 ((cx7 -> IO y) -> IO y) -> (cx7 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx7
cx7 ->
                  ca -> cx1 -> cx2 -> cx3 -> cx4 -> cx5 -> cx6 -> cx7 -> IO cy
f ca
ca cx1
cx1 cx2
cx2 cx3
cx3 cx4
cx4 cx5
cx5 cx6
cx6 cx7
cx7 IO cy -> (cy -> IO y) -> IO y
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \cy
cy -> cy -> (y -> IO y) -> IO y
forall a b r. Castable a b => b -> (a -> IO r) -> IO r
uncast cy
cy y -> IO y
forall (m :: * -> *) a. Monad m => a -> m a
return


xform8 :: (Castable a ca, Castable x1 cx1, Castable x2 cx2, Castable x3 cx3, Castable x4 cx4,
           Castable x5 cx5, Castable x6 cx6, Castable x7 cx7, Castable x8 cx8, Castable y cy)
       => (ca -> cx1 -> cx2 -> cx3 -> cx4 -> cx5 -> cx6 -> cx7 -> cx8 -> IO cy)
          -> a -> x1 -> x2 -> x3 -> x4 -> x5 -> x6 -> x7 -> x8 -> IO y
xform8 :: (ca
 -> cx1 -> cx2 -> cx3 -> cx4 -> cx5 -> cx6 -> cx7 -> cx8 -> IO cy)
-> a -> x1 -> x2 -> x3 -> x4 -> x5 -> x6 -> x7 -> x8 -> IO y
xform8 ca -> cx1 -> cx2 -> cx3 -> cx4 -> cx5 -> cx6 -> cx7 -> cx8 -> IO cy
f a
a x1
x1 x2
x2 x3
x3 x4
x4 x5
x5 x6
x6 x7
x7 x8
x8 =
  a -> (ca -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast a
a ((ca -> IO y) -> IO y) -> (ca -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \ca
ca ->
    x1 -> (cx1 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x1
x1 ((cx1 -> IO y) -> IO y) -> (cx1 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx1
cx1 ->
      x2 -> (cx2 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x2
x2 ((cx2 -> IO y) -> IO y) -> (cx2 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx2
cx2 ->
        x3 -> (cx3 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x3
x3 ((cx3 -> IO y) -> IO y) -> (cx3 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx3
cx3 ->
          x4 -> (cx4 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x4
x4 ((cx4 -> IO y) -> IO y) -> (cx4 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx4
cx4 ->
            x5 -> (cx5 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x5
x5 ((cx5 -> IO y) -> IO y) -> (cx5 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx5
cx5 ->
              x6 -> (cx6 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x6
x6 ((cx6 -> IO y) -> IO y) -> (cx6 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx6
cx6 ->
                x7 -> (cx7 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x7
x7 ((cx7 -> IO y) -> IO y) -> (cx7 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx7
cx7 ->
                  x8 -> (cx8 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x8
x8 ((cx8 -> IO y) -> IO y) -> (cx8 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx8
cx8 ->
                    ca -> cx1 -> cx2 -> cx3 -> cx4 -> cx5 -> cx6 -> cx7 -> cx8 -> IO cy
f ca
ca cx1
cx1 cx2
cx2 cx3
cx3 cx4
cx4 cx5
cx5 cx6
cx6 cx7
cx7 cx8
cx8 IO cy -> (cy -> IO y) -> IO y
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \cy
cy -> cy -> (y -> IO y) -> IO y
forall a b r. Castable a b => b -> (a -> IO r) -> IO r
uncast cy
cy y -> IO y
forall (m :: * -> *) a. Monad m => a -> m a
return

xform9 :: (Castable a ca, Castable x1 cx1, Castable x2 cx2, Castable x3 cx3, Castable x4 cx4,
           Castable x5 cx5, Castable x6 cx6, Castable x7 cx7, Castable x8 cx8, Castable x9 cx9,
           Castable y cy)
       => (ca -> cx1 -> cx2 -> cx3 -> cx4 -> cx5 -> cx6 -> cx7 -> cx8 -> cx9 -> IO cy)
          -> a -> x1 -> x2 -> x3 -> x4 -> x5 -> x6 -> x7 -> x8 -> x9 -> IO y
xform9 :: (ca
 -> cx1
 -> cx2
 -> cx3
 -> cx4
 -> cx5
 -> cx6
 -> cx7
 -> cx8
 -> cx9
 -> IO cy)
-> a -> x1 -> x2 -> x3 -> x4 -> x5 -> x6 -> x7 -> x8 -> x9 -> IO y
xform9 ca
-> cx1
-> cx2
-> cx3
-> cx4
-> cx5
-> cx6
-> cx7
-> cx8
-> cx9
-> IO cy
f a
a x1
x1 x2
x2 x3
x3 x4
x4 x5
x5 x6
x6 x7
x7 x8
x8 x9
x9 =
  a -> (ca -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast a
a ((ca -> IO y) -> IO y) -> (ca -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \ca
ca ->
    x1 -> (cx1 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x1
x1 ((cx1 -> IO y) -> IO y) -> (cx1 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx1
cx1 ->
      x2 -> (cx2 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x2
x2 ((cx2 -> IO y) -> IO y) -> (cx2 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx2
cx2 ->
        x3 -> (cx3 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x3
x3 ((cx3 -> IO y) -> IO y) -> (cx3 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx3
cx3 ->
          x4 -> (cx4 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x4
x4 ((cx4 -> IO y) -> IO y) -> (cx4 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx4
cx4 ->
            x5 -> (cx5 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x5
x5 ((cx5 -> IO y) -> IO y) -> (cx5 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx5
cx5 ->
              x6 -> (cx6 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x6
x6 ((cx6 -> IO y) -> IO y) -> (cx6 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx6
cx6 ->
                x7 -> (cx7 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x7
x7 ((cx7 -> IO y) -> IO y) -> (cx7 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx7
cx7 ->
                  x8 -> (cx8 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x8
x8 ((cx8 -> IO y) -> IO y) -> (cx8 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx8
cx8 ->
                    x9 -> (cx9 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x9
x9 ((cx9 -> IO y) -> IO y) -> (cx9 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx9
cx9 ->
                      ca
-> cx1
-> cx2
-> cx3
-> cx4
-> cx5
-> cx6
-> cx7
-> cx8
-> cx9
-> IO cy
f ca
ca cx1
cx1 cx2
cx2 cx3
cx3 cx4
cx4 cx5
cx5 cx6
cx6 cx7
cx7 cx8
cx8 cx9
cx9 IO cy -> (cy -> IO y) -> IO y
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \cy
cy -> cy -> (y -> IO y) -> IO y
forall a b r. Castable a b => b -> (a -> IO r) -> IO r
uncast cy
cy y -> IO y
forall (m :: * -> *) a. Monad m => a -> m a
return

xform10 :: (Castable a ca, Castable x1 cx1, Castable x2 cx2, Castable x3 cx3, Castable x4 cx4,
            Castable x5 cx5, Castable x6 cx6, Castable x7 cx7, Castable x8 cx8, Castable x9 cx9,
            Castable x10 cx10, Castable y cy)
       => (ca -> cx1 -> cx2 -> cx3 -> cx4 -> cx5 -> cx6 -> cx7 -> cx8 -> cx9 -> cx10 -> IO cy)
          -> a -> x1 -> x2 -> x3 -> x4 -> x5 -> x6 -> x7 -> x8 -> x9 -> x10 -> IO y
xform10 :: (ca
 -> cx1
 -> cx2
 -> cx3
 -> cx4
 -> cx5
 -> cx6
 -> cx7
 -> cx8
 -> cx9
 -> cx10
 -> IO cy)
-> a
-> x1
-> x2
-> x3
-> x4
-> x5
-> x6
-> x7
-> x8
-> x9
-> x10
-> IO y
xform10 ca
-> cx1
-> cx2
-> cx3
-> cx4
-> cx5
-> cx6
-> cx7
-> cx8
-> cx9
-> cx10
-> IO cy
f a
a x1
x1 x2
x2 x3
x3 x4
x4 x5
x5 x6
x6 x7
x7 x8
x8 x9
x9 x10
x10 =
  a -> (ca -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast a
a ((ca -> IO y) -> IO y) -> (ca -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \ca
ca ->
    x1 -> (cx1 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x1
x1 ((cx1 -> IO y) -> IO y) -> (cx1 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx1
cx1 ->
      x2 -> (cx2 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x2
x2 ((cx2 -> IO y) -> IO y) -> (cx2 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx2
cx2 ->
        x3 -> (cx3 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x3
x3 ((cx3 -> IO y) -> IO y) -> (cx3 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx3
cx3 ->
          x4 -> (cx4 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x4
x4 ((cx4 -> IO y) -> IO y) -> (cx4 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx4
cx4 ->
            x5 -> (cx5 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x5
x5 ((cx5 -> IO y) -> IO y) -> (cx5 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx5
cx5 ->
              x6 -> (cx6 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x6
x6 ((cx6 -> IO y) -> IO y) -> (cx6 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx6
cx6 ->
                x7 -> (cx7 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x7
x7 ((cx7 -> IO y) -> IO y) -> (cx7 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx7
cx7 ->
                  x8 -> (cx8 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x8
x8 ((cx8 -> IO y) -> IO y) -> (cx8 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx8
cx8 ->
                    x9 -> (cx9 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x9
x9 ((cx9 -> IO y) -> IO y) -> (cx9 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx9
cx9 ->
                      x10 -> (cx10 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x10
x10 ((cx10 -> IO y) -> IO y) -> (cx10 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx10
cx10 ->
                        ca
-> cx1
-> cx2
-> cx3
-> cx4
-> cx5
-> cx6
-> cx7
-> cx8
-> cx9
-> cx10
-> IO cy
f ca
ca cx1
cx1 cx2
cx2 cx3
cx3 cx4
cx4 cx5
cx5 cx6
cx6 cx7
cx7 cx8
cx8 cx9
cx9 cx10
cx10 IO cy -> (cy -> IO y) -> IO y
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \cy
cy -> cy -> (y -> IO y) -> IO y
forall a b r. Castable a b => b -> (a -> IO r) -> IO r
uncast cy
cy y -> IO y
forall (m :: * -> *) a. Monad m => a -> m a
return

xform11 :: (Castable a ca, Castable x1 cx1, Castable x2 cx2, Castable x3 cx3, Castable x4 cx4,
            Castable x5 cx5, Castable x6 cx6, Castable x7 cx7, Castable x8 cx8, Castable x9 cx9,
            Castable x10 cx10, Castable x11 cx11, Castable y cy)
       => (ca -> cx1 -> cx2 -> cx3 -> cx4 -> cx5 -> cx6 -> cx7 -> cx8 -> cx9 -> cx10 -> cx11 -> IO cy)
          -> a -> x1 -> x2 -> x3 -> x4 -> x5 -> x6 -> x7 -> x8 -> x9 -> x10 -> x11 -> IO y
xform11 :: (ca
 -> cx1
 -> cx2
 -> cx3
 -> cx4
 -> cx5
 -> cx6
 -> cx7
 -> cx8
 -> cx9
 -> cx10
 -> cx11
 -> IO cy)
-> a
-> x1
-> x2
-> x3
-> x4
-> x5
-> x6
-> x7
-> x8
-> x9
-> x10
-> x11
-> IO y
xform11 ca
-> cx1
-> cx2
-> cx3
-> cx4
-> cx5
-> cx6
-> cx7
-> cx8
-> cx9
-> cx10
-> cx11
-> IO cy
f a
a x1
x1 x2
x2 x3
x3 x4
x4 x5
x5 x6
x6 x7
x7 x8
x8 x9
x9 x10
x10 x11
x11 =
  a -> (ca -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast a
a ((ca -> IO y) -> IO y) -> (ca -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \ca
ca ->
    x1 -> (cx1 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x1
x1 ((cx1 -> IO y) -> IO y) -> (cx1 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx1
cx1 ->
      x2 -> (cx2 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x2
x2 ((cx2 -> IO y) -> IO y) -> (cx2 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx2
cx2 ->
        x3 -> (cx3 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x3
x3 ((cx3 -> IO y) -> IO y) -> (cx3 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx3
cx3 ->
          x4 -> (cx4 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x4
x4 ((cx4 -> IO y) -> IO y) -> (cx4 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx4
cx4 ->
            x5 -> (cx5 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x5
x5 ((cx5 -> IO y) -> IO y) -> (cx5 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx5
cx5 ->
              x6 -> (cx6 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x6
x6 ((cx6 -> IO y) -> IO y) -> (cx6 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx6
cx6 ->
                x7 -> (cx7 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x7
x7 ((cx7 -> IO y) -> IO y) -> (cx7 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx7
cx7 ->
                  x8 -> (cx8 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x8
x8 ((cx8 -> IO y) -> IO y) -> (cx8 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx8
cx8 ->
                    x9 -> (cx9 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x9
x9 ((cx9 -> IO y) -> IO y) -> (cx9 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx9
cx9 ->
                      x10 -> (cx10 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x10
x10 ((cx10 -> IO y) -> IO y) -> (cx10 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx10
cx10 ->
                        x11 -> (cx11 -> IO y) -> IO y
forall a b r. Castable a b => a -> (b -> IO r) -> IO r
cast x11
x11 ((cx11 -> IO y) -> IO y) -> (cx11 -> IO y) -> IO y
forall a b. (a -> b) -> a -> b
$ \cx11
cx11 ->
                         ca
-> cx1
-> cx2
-> cx3
-> cx4
-> cx5
-> cx6
-> cx7
-> cx8
-> cx9
-> cx10
-> cx11
-> IO cy
f ca
ca cx1
cx1 cx2
cx2 cx3
cx3 cx4
cx4 cx5
cx5 cx6
cx6 cx7
cx7 cx8
cx8 cx9
cx9 cx10
cx10 cx11
cx11 IO cy -> (cy -> IO y) -> IO y
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \cy
cy -> cy -> (y -> IO y) -> IO y
forall a b r. Castable a b => b -> (a -> IO r) -> IO r
uncast cy
cy y -> IO y
forall (m :: * -> *) a. Monad m => a -> m a
return