{-# OPTIONS_GHC -Wno-redundant-constraints #-}
{-# LANGUAGE FlexibleInstances, FlexibleContexts, DeriveFunctor #-}
{-# LANGUAGE DefaultSignatures, TypeOperators, RankNTypes #-}
module Language.Souffle.Marshal
( Marshal(..)
, PushF(..)
, PopF(..)
, MarshalM
, interpret
) where
import Control.Monad.Free
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
type MarshalM = Free
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 = (forall x. f x -> m x) -> MarshalM f a -> m a
forall (m :: * -> *) (f :: * -> *) a.
Monad m =>
(forall x. f x -> m x) -> Free f a -> m a
foldFree
{-# 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) -> Free PopF (Rep a Any) -> MarshalM PopF a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Free 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 :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m 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 :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m 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 :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m 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 :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m 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) -> Free PopF a -> MarshalM PopF (K1 i a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Free 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)
-> Free PopF (f a) -> Free PopF (g a -> (:*:) f g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Free PopF (f a)
forall (f :: * -> *) a. GMarshal f => MarshalM PopF (f a)
gpop Free PopF (g a -> (:*:) f g a)
-> Free PopF (g a) -> MarshalM PopF ((:*:) f g a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Free 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)
-> Free PopF (a a) -> MarshalM PopF (M1 i c a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Free PopF (a a)
forall (f :: * -> *) a. GMarshal f => MarshalM PopF (f a)
gpop
{-# INLINABLE gpop #-}