{-# OPTIONS_GHC -Wno-redundant-constraints #-}
{-# LANGUAGE FlexibleInstances, FlexibleContexts, DeriveFunctor #-}
{-# LANGUAGE DefaultSignatures, TypeOperators, RankNTypes #-}
module Language.Souffle.Marshal
( Marshal(..)
, PushF(..)
, PopF(..)
, MarshalM
, interpret
) where
import GHC.Generics
import Data.Int
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Language.Souffle.Internal.Constraints as C
data PopF a
= PopInt (Int32 -> a)
| PopStr (String -> a)
deriving a -> PopF b -> PopF a
(a -> b) -> PopF a -> PopF b
(forall a b. (a -> b) -> PopF a -> PopF b)
-> (forall a b. a -> PopF b -> PopF a) -> Functor PopF
forall a b. a -> PopF b -> PopF a
forall a b. (a -> b) -> PopF a -> PopF b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> PopF b -> PopF a
$c<$ :: forall a b. a -> PopF b -> PopF a
fmap :: (a -> b) -> PopF a -> PopF b
$cfmap :: forall a b. (a -> b) -> PopF a -> PopF b
Functor
data PushF a
= PushInt Int32 a
| PushStr String a
deriving a -> PushF b -> PushF a
(a -> b) -> PushF a -> PushF b
(forall a b. (a -> b) -> PushF a -> PushF b)
-> (forall a b. a -> PushF b -> PushF a) -> Functor PushF
forall a b. a -> PushF b -> PushF a
forall a b. (a -> b) -> PushF a -> PushF b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> PushF b -> PushF a
$c<$ :: forall a b. a -> PushF b -> PushF a
fmap :: (a -> b) -> PushF a -> PushF b
$cfmap :: forall a b. (a -> b) -> PushF a -> PushF b
Functor
data MarshalM f a
= Pure a
| Free (f (MarshalM f a))
deriving a -> MarshalM f b -> MarshalM f a
(a -> b) -> MarshalM f a -> MarshalM f b
(forall a b. (a -> b) -> MarshalM f a -> MarshalM f b)
-> (forall a b. a -> MarshalM f b -> MarshalM f a)
-> Functor (MarshalM f)
forall a b. a -> MarshalM f b -> MarshalM f a
forall a b. (a -> b) -> MarshalM f a -> MarshalM f b
forall (f :: * -> *) a b.
Functor f =>
a -> MarshalM f b -> MarshalM f a
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> MarshalM f a -> MarshalM f b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> MarshalM f b -> MarshalM f a
$c<$ :: forall (f :: * -> *) a b.
Functor f =>
a -> MarshalM f b -> MarshalM f a
fmap :: (a -> b) -> MarshalM f a -> MarshalM f b
$cfmap :: forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> MarshalM f a -> MarshalM f b
Functor
instance Functor f => Applicative (MarshalM f) where
pure :: a -> MarshalM f a
pure = a -> MarshalM f a
forall (f :: * -> *) a. a -> MarshalM f a
Pure
{-# INLINABLE pure #-}
Pure f :: a -> b
f <*> :: MarshalM f (a -> b) -> MarshalM f a -> MarshalM f b
<*> Pure a :: a
a = b -> MarshalM f b
forall (f :: * -> *) a. a -> MarshalM f a
Pure (b -> MarshalM f b) -> b -> MarshalM f b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
a
Pure f :: a -> b
f <*> Free fa :: f (MarshalM f a)
fa = a -> b
f (a -> b) -> MarshalM f a -> MarshalM f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (MarshalM f a) -> MarshalM f a
forall (f :: * -> *) a. f (MarshalM f a) -> MarshalM f a
Free f (MarshalM f a)
fa
Free fa :: f (MarshalM f (a -> b))
fa <*> m :: MarshalM f a
m = f (MarshalM f b) -> MarshalM f b
forall (f :: * -> *) a. f (MarshalM f a) -> MarshalM f a
Free (f (MarshalM f b) -> MarshalM f b)
-> f (MarshalM f b) -> MarshalM f b
forall a b. (a -> b) -> a -> b
$ (MarshalM f (a -> b) -> MarshalM f b)
-> f (MarshalM f (a -> b)) -> f (MarshalM f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (MarshalM f (a -> b) -> MarshalM f a -> MarshalM f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MarshalM f a
m) f (MarshalM f (a -> b))
fa
{-# INLINABLE (<*>) #-}
instance Functor f => Monad (MarshalM f) where
Pure a :: a
a >>= :: MarshalM f a -> (a -> MarshalM f b) -> MarshalM f b
>>= f :: a -> MarshalM f b
f = a -> MarshalM f b
f a
a
Free fa :: f (MarshalM f a)
fa >>= f :: a -> MarshalM f b
f = f (MarshalM f b) -> MarshalM f b
forall (f :: * -> *) a. f (MarshalM f a) -> MarshalM f a
Free (f (MarshalM f b) -> MarshalM f b)
-> f (MarshalM f b) -> MarshalM f b
forall a b. (a -> b) -> a -> b
$ (MarshalM f a -> MarshalM f b)
-> f (MarshalM f a) -> f (MarshalM f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (MarshalM f a -> (a -> MarshalM f b) -> MarshalM f b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> MarshalM f b
f) f (MarshalM f a)
fa
{-# INLINABLE (>>=) #-}
liftF :: Functor f => f a -> MarshalM f a
liftF :: f a -> MarshalM f a
liftF action :: f a
action = f (MarshalM f a) -> MarshalM f a
forall (f :: * -> *) a. f (MarshalM f a) -> MarshalM f a
Free (f (MarshalM f a) -> MarshalM f a)
-> f (MarshalM f a) -> MarshalM f a
forall a b. (a -> b) -> a -> b
$ (a -> MarshalM f a) -> f a -> f (MarshalM f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> MarshalM f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure f a
action
{-# INLINABLE liftF #-}
interpret :: Monad m => (forall x. f x -> m x) -> MarshalM f a -> m a
interpret :: (forall x. f x -> m x) -> MarshalM f a -> m a
interpret f :: forall x. f x -> m x
f = \case
Pure a :: a
a -> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
Free fa :: f (MarshalM f a)
fa -> f (MarshalM f a) -> m (MarshalM f a)
forall x. f x -> m x
f f (MarshalM f a)
fa m (MarshalM f a) -> (MarshalM f a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall x. f x -> m x) -> MarshalM f a -> m a
forall (m :: * -> *) (f :: * -> *) a.
Monad m =>
(forall x. f x -> m x) -> MarshalM f a -> m a
interpret forall x. f x -> m x
f
{-# INLINABLE interpret #-}
class Marshal a where
push :: a -> MarshalM PushF ()
pop :: MarshalM PopF a
default push :: (Generic a, C.SimpleProduct a (Rep a), GMarshal (Rep a))
=> a -> MarshalM PushF ()
default pop :: (Generic a, C.SimpleProduct a (Rep a), GMarshal (Rep a))
=> MarshalM PopF a
push a :: a
a = Rep a Any -> MarshalM PushF ()
forall (f :: * -> *) a. GMarshal f => f a -> MarshalM PushF ()
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) -> MarshalM PopF (Rep a Any) -> MarshalM PopF a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MarshalM PopF (Rep a Any)
forall (f :: * -> *) a. GMarshal f => MarshalM PopF (f a)
gpop
{-# INLINABLE pop #-}
instance Marshal Int32 where
push :: Int32 -> MarshalM PushF ()
push int :: Int32
int = PushF () -> MarshalM PushF ()
forall (f :: * -> *) a. Functor f => f a -> MarshalM f a
liftF (Int32 -> () -> PushF ()
forall a. Int32 -> a -> PushF a
PushInt Int32
int ())
{-# INLINABLE push #-}
pop :: MarshalM PopF Int32
pop = PopF Int32 -> MarshalM PopF Int32
forall (f :: * -> *) a. Functor f => f a -> MarshalM f a
liftF ((Int32 -> Int32) -> PopF Int32
forall a. (Int32 -> a) -> PopF a
PopInt Int32 -> Int32
forall a. a -> a
id)
{-# INLINABLE pop #-}
instance Marshal String where
push :: String -> MarshalM PushF ()
push str :: String
str = PushF () -> MarshalM PushF ()
forall (f :: * -> *) a. Functor f => f a -> MarshalM f a
liftF (String -> () -> PushF ()
forall a. String -> a -> PushF a
PushStr String
str ())
{-# INLINABLE push #-}
pop :: MarshalM PopF String
pop = PopF String -> MarshalM PopF String
forall (f :: * -> *) a. Functor f => f a -> MarshalM f a
liftF ((String -> String) -> PopF String
forall a. (String -> a) -> PopF a
PopStr String -> String
forall a. a -> a
id)
{-# INLINABLE pop #-}
instance Marshal T.Text where
push :: Text -> MarshalM PushF ()
push = String -> MarshalM PushF ()
forall a. Marshal a => a -> MarshalM PushF ()
push (String -> MarshalM PushF ())
-> (Text -> String) -> Text -> MarshalM PushF ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
{-# INLINABLE push #-}
pop :: MarshalM PopF Text
pop = String -> Text
T.pack (String -> Text) -> MarshalM PopF String -> MarshalM PopF Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MarshalM PopF String
forall a. Marshal a => MarshalM PopF a
pop
{-# INLINABLE pop #-}
instance Marshal TL.Text where
push :: Text -> MarshalM PushF ()
push = String -> MarshalM PushF ()
forall a. Marshal a => a -> MarshalM PushF ()
push (String -> MarshalM PushF ())
-> (Text -> String) -> Text -> MarshalM PushF ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
TL.unpack
{-# INLINABLE push #-}
pop :: MarshalM PopF Text
pop = String -> Text
TL.pack (String -> Text) -> MarshalM PopF String -> MarshalM PopF Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MarshalM PopF String
forall a. Marshal a => MarshalM PopF a
pop
{-# INLINABLE pop #-}
class GMarshal f where
gpush :: f a -> MarshalM PushF ()
gpop :: MarshalM PopF (f a)
instance Marshal a => GMarshal (K1 i a) where
gpush :: K1 i a a -> MarshalM PushF ()
gpush (K1 x :: a
x) = a -> MarshalM PushF ()
forall a. Marshal a => a -> MarshalM PushF ()
push a
x
{-# INLINABLE gpush #-}
gpop :: MarshalM PopF (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) -> MarshalM PopF a -> MarshalM PopF (K1 i a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MarshalM PopF a
forall a. Marshal a => MarshalM PopF a
pop
{-# INLINABLE gpop #-}
instance (GMarshal f, GMarshal g) => GMarshal (f :*: g) where
gpush :: (:*:) f g a -> MarshalM PushF ()
gpush (a :: f a
a :*: b :: g a
b) = do
f a -> MarshalM PushF ()
forall (f :: * -> *) a. GMarshal f => f a -> MarshalM PushF ()
gpush f a
a
g a -> MarshalM PushF ()
forall (f :: * -> *) a. GMarshal f => f a -> MarshalM PushF ()
gpush g a
b
{-# INLINABLE gpush #-}
gpop :: MarshalM PopF ((:*:) 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)
-> MarshalM PopF (f a) -> MarshalM PopF (g a -> (:*:) f g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MarshalM PopF (f a)
forall (f :: * -> *) a. GMarshal f => MarshalM PopF (f a)
gpop MarshalM PopF (g a -> (:*:) f g a)
-> MarshalM PopF (g a) -> MarshalM PopF ((:*:) f g a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MarshalM PopF (g a)
forall (f :: * -> *) a. GMarshal f => MarshalM PopF (f a)
gpop
{-# INLINABLE gpop #-}
instance GMarshal a => GMarshal (M1 i c a) where
gpush :: M1 i c a a -> MarshalM PushF ()
gpush (M1 x :: a a
x) = a a -> MarshalM PushF ()
forall (f :: * -> *) a. GMarshal f => f a -> MarshalM PushF ()
gpush a a
x
{-# INLINABLE gpush #-}
gpop :: MarshalM PopF (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)
-> MarshalM PopF (a a) -> MarshalM PopF (M1 i c a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MarshalM PopF (a a)
forall (f :: * -> *) a. GMarshal f => MarshalM PopF (f a)
gpop
{-# INLINABLE gpop #-}