{-# OPTIONS_GHC -Wno-redundant-constraints #-}
{-# LANGUAGE DerivingVia, TypeFamilies #-}
{-# LANGUAGE FlexibleInstances, FlexibleContexts, DataKinds #-}
{-# LANGUAGE UndecidableInstances, DefaultSignatures #-}
{-# LANGUAGE ScopedTypeVariables, TypeOperators #-}
module Language.Souffle.Marshal
( MarshalT
, runMarshalT
, Marshal(..)
) where
import Control.Monad.Reader
import Control.Monad.Writer
import Control.Monad.State
import Control.Monad.Except
import Control.Monad.RWS
import GHC.Generics
import Foreign.Ptr
import Data.Int
import qualified Language.Souffle.Internal as Internal
import qualified Language.Souffle.Internal.Constraints as C
type Tuple = Ptr Internal.Tuple
newtype MarshalT m a = MarshalT (ReaderT Tuple m a)
deriving ( a -> MarshalT m b -> MarshalT m a
(a -> b) -> MarshalT m a -> MarshalT m b
(forall a b. (a -> b) -> MarshalT m a -> MarshalT m b)
-> (forall a b. a -> MarshalT m b -> MarshalT m a)
-> Functor (MarshalT m)
forall a b. a -> MarshalT m b -> MarshalT m a
forall a b. (a -> b) -> MarshalT m a -> MarshalT m b
forall (m :: * -> *) a b.
Functor m =>
a -> MarshalT m b -> MarshalT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> MarshalT m a -> MarshalT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> MarshalT m b -> MarshalT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> MarshalT m b -> MarshalT m a
fmap :: (a -> b) -> MarshalT m a -> MarshalT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> MarshalT m a -> MarshalT m b
Functor, Functor (MarshalT m)
a -> MarshalT m a
Functor (MarshalT m) =>
(forall a. a -> MarshalT m a)
-> (forall a b.
MarshalT m (a -> b) -> MarshalT m a -> MarshalT m b)
-> (forall a b c.
(a -> b -> c) -> MarshalT m a -> MarshalT m b -> MarshalT m c)
-> (forall a b. MarshalT m a -> MarshalT m b -> MarshalT m b)
-> (forall a b. MarshalT m a -> MarshalT m b -> MarshalT m a)
-> Applicative (MarshalT m)
MarshalT m a -> MarshalT m b -> MarshalT m b
MarshalT m a -> MarshalT m b -> MarshalT m a
MarshalT m (a -> b) -> MarshalT m a -> MarshalT m b
(a -> b -> c) -> MarshalT m a -> MarshalT m b -> MarshalT m c
forall a. a -> MarshalT m a
forall a b. MarshalT m a -> MarshalT m b -> MarshalT m a
forall a b. MarshalT m a -> MarshalT m b -> MarshalT m b
forall a b. MarshalT m (a -> b) -> MarshalT m a -> MarshalT m b
forall a b c.
(a -> b -> c) -> MarshalT m a -> MarshalT m b -> MarshalT m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *). Applicative m => Functor (MarshalT m)
forall (m :: * -> *) a. Applicative m => a -> MarshalT m a
forall (m :: * -> *) a b.
Applicative m =>
MarshalT m a -> MarshalT m b -> MarshalT m a
forall (m :: * -> *) a b.
Applicative m =>
MarshalT m a -> MarshalT m b -> MarshalT m b
forall (m :: * -> *) a b.
Applicative m =>
MarshalT m (a -> b) -> MarshalT m a -> MarshalT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> MarshalT m a -> MarshalT m b -> MarshalT m c
<* :: MarshalT m a -> MarshalT m b -> MarshalT m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
MarshalT m a -> MarshalT m b -> MarshalT m a
*> :: MarshalT m a -> MarshalT m b -> MarshalT m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
MarshalT m a -> MarshalT m b -> MarshalT m b
liftA2 :: (a -> b -> c) -> MarshalT m a -> MarshalT m b -> MarshalT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> MarshalT m a -> MarshalT m b -> MarshalT m c
<*> :: MarshalT m (a -> b) -> MarshalT m a -> MarshalT m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
MarshalT m (a -> b) -> MarshalT m a -> MarshalT m b
pure :: a -> MarshalT m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> MarshalT m a
$cp1Applicative :: forall (m :: * -> *). Applicative m => Functor (MarshalT m)
Applicative, Applicative (MarshalT m)
a -> MarshalT m a
Applicative (MarshalT m) =>
(forall a b. MarshalT m a -> (a -> MarshalT m b) -> MarshalT m b)
-> (forall a b. MarshalT m a -> MarshalT m b -> MarshalT m b)
-> (forall a. a -> MarshalT m a)
-> Monad (MarshalT m)
MarshalT m a -> (a -> MarshalT m b) -> MarshalT m b
MarshalT m a -> MarshalT m b -> MarshalT m b
forall a. a -> MarshalT m a
forall a b. MarshalT m a -> MarshalT m b -> MarshalT m b
forall a b. MarshalT m a -> (a -> MarshalT m b) -> MarshalT m b
forall (m :: * -> *). Monad m => Applicative (MarshalT m)
forall (m :: * -> *) a. Monad m => a -> MarshalT m a
forall (m :: * -> *) a b.
Monad m =>
MarshalT m a -> MarshalT m b -> MarshalT m b
forall (m :: * -> *) a b.
Monad m =>
MarshalT m a -> (a -> MarshalT m b) -> MarshalT m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> MarshalT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> MarshalT m a
>> :: MarshalT m a -> MarshalT m b -> MarshalT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
MarshalT m a -> MarshalT m b -> MarshalT m b
>>= :: MarshalT m a -> (a -> MarshalT m b) -> MarshalT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
MarshalT m a -> (a -> MarshalT m b) -> MarshalT m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (MarshalT m)
Monad
, Monad (MarshalT m)
Monad (MarshalT m) =>
(forall a. IO a -> MarshalT m a) -> MonadIO (MarshalT m)
IO a -> MarshalT m a
forall a. IO a -> MarshalT m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (MarshalT m)
forall (m :: * -> *) a. MonadIO m => IO a -> MarshalT m a
liftIO :: IO a -> MarshalT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> MarshalT m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (MarshalT m)
MonadIO, MonadReader Tuple, MonadWriter w
, MonadState s, MonadRWS Tuple w s, MonadError e )
via ( ReaderT Tuple m )
deriving m a -> MarshalT m a
(forall (m :: * -> *) a. Monad m => m a -> MarshalT m a)
-> MonadTrans MarshalT
forall (m :: * -> *) a. Monad m => m a -> MarshalT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> MarshalT m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> MarshalT m a
MonadTrans via (ReaderT Tuple)
runMarshalT :: MarshalT m a -> Tuple -> m a
runMarshalT :: MarshalT m a -> Tuple -> m a
runMarshalT (MarshalT m :: ReaderT Tuple m a
m) = ReaderT Tuple m a -> Tuple -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Tuple m a
m
{-# INLINABLE runMarshalT #-}
class Marshal a where
push :: MonadIO m => a -> MarshalT m ()
pop :: MonadIO m => MarshalT m a
default push :: (Generic a, C.SimpleProduct a (Rep a), GMarshal (Rep a), MonadIO m)
=> a -> MarshalT m ()
default pop :: (Generic a, C.SimpleProduct a (Rep a), GMarshal (Rep a), MonadIO m)
=> MarshalT m a
push a :: a
a = Rep a Any -> MarshalT m ()
forall (f :: * -> *) (m :: * -> *) a.
(GMarshal f, MonadIO m) =>
f a -> MarshalT m ()
gpush (a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from a
a)
{-# INLINABLE push #-}
pop = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to (Rep a Any -> a) -> MarshalT m (Rep a Any) -> MarshalT m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MarshalT m (Rep a Any)
forall (f :: * -> *) (m :: * -> *) a.
(GMarshal f, MonadIO m) =>
MarshalT m (f a)
gpop
{-# INLINABLE pop #-}
instance Marshal Int32 where
push :: Int32 -> MarshalT m ()
push int :: Int32
int = do
Tuple
tuple <- MarshalT m Tuple
forall r (m :: * -> *). MonadReader r m => m r
ask
IO () -> MarshalT m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MarshalT m ()) -> IO () -> MarshalT m ()
forall a b. (a -> b) -> a -> b
$ Tuple -> Int32 -> IO ()
Internal.tuplePushInt Tuple
tuple Int32
int
{-# INLINABLE push #-}
pop :: MarshalT m Int32
pop = do
Tuple
tuple <- MarshalT m Tuple
forall r (m :: * -> *). MonadReader r m => m r
ask
IO Int32 -> MarshalT m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> MarshalT m Int32) -> IO Int32 -> MarshalT m Int32
forall a b. (a -> b) -> a -> b
$ Tuple -> IO Int32
Internal.tuplePopInt Tuple
tuple
{-# INLINABLE pop #-}
instance Marshal String where
push :: String -> MarshalT m ()
push str :: String
str = do
Tuple
tuple <- MarshalT m Tuple
forall r (m :: * -> *). MonadReader r m => m r
ask
IO () -> MarshalT m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MarshalT m ()) -> IO () -> MarshalT m ()
forall a b. (a -> b) -> a -> b
$ Tuple -> String -> IO ()
Internal.tuplePushString Tuple
tuple String
str
{-# INLINABLE push #-}
pop :: MarshalT m String
pop = do
Tuple
tuple <- MarshalT m Tuple
forall r (m :: * -> *). MonadReader r m => m r
ask
IO String -> MarshalT m String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> MarshalT m String) -> IO String -> MarshalT m String
forall a b. (a -> b) -> a -> b
$ Tuple -> IO String
Internal.tuplePopString Tuple
tuple
{-# INLINABLE pop #-}
class GMarshal f where
gpush :: MonadIO m => f a -> MarshalT m ()
gpop :: MonadIO m => MarshalT m (f a)
instance Marshal a => GMarshal (K1 i a) where
gpush :: K1 i a a -> MarshalT m ()
gpush (K1 x :: a
x) = a -> MarshalT m ()
forall a (m :: * -> *).
(Marshal a, MonadIO m) =>
a -> MarshalT m ()
push a
x
{-# INLINABLE gpush #-}
gpop :: MarshalT m (K1 i a a)
gpop = a -> K1 i a a
forall k i c (p :: k). c -> K1 i c p
K1 (a -> K1 i a a) -> MarshalT m a -> MarshalT m (K1 i a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MarshalT m a
forall a (m :: * -> *). (Marshal a, MonadIO m) => MarshalT m a
pop
{-# INLINABLE gpop #-}
instance (GMarshal f, GMarshal g) => GMarshal (f :*: g) where
gpush :: (:*:) f g a -> MarshalT m ()
gpush (a :: f a
a :*: b :: g a
b) = do
f a -> MarshalT m ()
forall (f :: * -> *) (m :: * -> *) a.
(GMarshal f, MonadIO m) =>
f a -> MarshalT m ()
gpush f a
a
g a -> MarshalT m ()
forall (f :: * -> *) (m :: * -> *) a.
(GMarshal f, MonadIO m) =>
f a -> MarshalT m ()
gpush g a
b
{-# INLINABLE gpush #-}
gpop :: MarshalT m ((:*:) f g a)
gpop = f a -> g a -> (:*:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (f a -> g a -> (:*:) f g a)
-> MarshalT m (f a) -> MarshalT m (g a -> (:*:) f g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MarshalT m (f a)
forall (f :: * -> *) (m :: * -> *) a.
(GMarshal f, MonadIO m) =>
MarshalT m (f a)
gpop MarshalT m (g a -> (:*:) f g a)
-> MarshalT m (g a) -> MarshalT m ((:*:) f g a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MarshalT m (g a)
forall (f :: * -> *) (m :: * -> *) a.
(GMarshal f, MonadIO m) =>
MarshalT m (f a)
gpop
{-# INLINABLE gpop #-}
instance GMarshal a => GMarshal (M1 i c a) where
gpush :: M1 i c a a -> MarshalT m ()
gpush (M1 x :: a a
x) = a a -> MarshalT m ()
forall (f :: * -> *) (m :: * -> *) a.
(GMarshal f, MonadIO m) =>
f a -> MarshalT m ()
gpush a a
x
{-# INLINABLE gpush #-}
gpop :: MarshalT m (M1 i c a a)
gpop = a a -> M1 i c a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (a a -> M1 i c a a) -> MarshalT m (a a) -> MarshalT m (M1 i c a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MarshalT m (a a)
forall (f :: * -> *) (m :: * -> *) a.
(GMarshal f, MonadIO m) =>
MarshalT m (f a)
gpop
{-# INLINABLE gpop #-}