{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
module Dovetail.FFI.Builder
(
FFIBuilder
, runFFIBuilder
, evalFFIBuilder
, foreignImport
, FunctionType
, string
, char
, boolean
, number
, int
, array
, (~>)
, ForAll
) where
import Control.Monad.Fix (MonadFix)
import Control.Monad.Writer.Class (MonadWriter(..))
import Control.Monad.Writer.Strict (Writer, runWriter)
import Data.Text (Text)
import Data.Vector (Vector)
import Dovetail.Evaluate (EvalT, Value)
import Dovetail.Evaluate qualified as Evaluate
import Dovetail.FFI (FFI(..), ForeignImport(..))
import Dovetail.FFI.Internal qualified as Internal
import Language.PureScript qualified as P
data TypeScheme m a where
Cons :: (FunctionType m (Value m) (EvalT m (Value m)) -> TypeScheme m a)
-> TypeScheme m a
Nil :: FunctionType m a r -> TypeScheme m a
data FunctionType m l r where
Function :: FunctionType m al ar
-> FunctionType m bl br
-> FunctionType m (al -> br) (al -> br)
Array :: FunctionType m l r
-> FunctionType m (Vector l) (EvalT m (Vector l))
MonoType :: MonoType m l -> FunctionType m l (EvalT m l)
data MonoType m a where
String :: MonoType m Text
Char :: MonoType m Char
Boolean :: MonoType m Bool
Number :: MonoType m Double
Int :: MonoType m Integer
Var :: P.SourceType -> MonoType m (Value m)
class ForAll m r a | a -> m r where
forAll :: a -> TypeScheme m r
instance ForAll m a (FunctionType m a r_) where
forAll :: FunctionType m a r_ -> TypeScheme m a
forAll = FunctionType m a r_ -> TypeScheme m a
forall (m :: * -> *) a r_. FunctionType m a r_ -> TypeScheme m a
Nil
instance (ForAll m r o, a ~ FunctionType m (Value m) (EvalT m (Value m))) => ForAll m r (a -> o) where
forAll :: (a -> o) -> TypeScheme m r
forAll a -> o
f = (FunctionType m (Value m) (EvalT m (Value m)) -> TypeScheme m r)
-> TypeScheme m r
forall (m :: * -> *) a.
(FunctionType m (Value m) (EvalT m (Value m)) -> TypeScheme m a)
-> TypeScheme m a
Cons (o -> TypeScheme m r
forall (m :: * -> *) r a. ForAll m r a => a -> TypeScheme m r
forAll (o -> TypeScheme m r) -> (a -> o) -> a -> TypeScheme m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> o
f)
infixr 0 ~>
(~>) :: FunctionType m al ar
-> FunctionType m bl br
-> FunctionType m (al -> br) (al -> br)
~> :: FunctionType m al ar
-> FunctionType m bl br -> FunctionType m (al -> br) (al -> br)
(~>) = FunctionType m al ar
-> FunctionType m bl br -> FunctionType m (al -> br) (al -> br)
forall (m :: * -> *) al ar bl br.
FunctionType m al ar
-> FunctionType m bl br -> FunctionType m (al -> br) (al -> br)
Function
string :: FunctionType m Text (EvalT m Text)
string :: FunctionType m Text (EvalT m Text)
string = MonoType m Text -> FunctionType m Text (EvalT m Text)
forall (m :: * -> *) l.
MonoType m l -> FunctionType m l (EvalT m l)
MonoType MonoType m Text
forall (m :: * -> *). MonoType m Text
String
char :: FunctionType m Char (EvalT m Char)
char :: FunctionType m Char (EvalT m Char)
char = MonoType m Char -> FunctionType m Char (EvalT m Char)
forall (m :: * -> *) l.
MonoType m l -> FunctionType m l (EvalT m l)
MonoType MonoType m Char
forall (m :: * -> *). MonoType m Char
Char
boolean :: FunctionType m Bool (EvalT m Bool)
boolean :: FunctionType m Bool (EvalT m Bool)
boolean = MonoType m Bool -> FunctionType m Bool (EvalT m Bool)
forall (m :: * -> *) l.
MonoType m l -> FunctionType m l (EvalT m l)
MonoType MonoType m Bool
forall (m :: * -> *). MonoType m Bool
Boolean
number :: FunctionType m Double (EvalT m Double)
number :: FunctionType m Double (EvalT m Double)
number = MonoType m Double -> FunctionType m Double (EvalT m Double)
forall (m :: * -> *) l.
MonoType m l -> FunctionType m l (EvalT m l)
MonoType MonoType m Double
forall (m :: * -> *). MonoType m Double
Number
int :: FunctionType m Integer (EvalT m Integer)
int :: FunctionType m Integer (EvalT m Integer)
int = MonoType m Integer -> FunctionType m Integer (EvalT m Integer)
forall (m :: * -> *) l.
MonoType m l -> FunctionType m l (EvalT m l)
MonoType MonoType m Integer
forall (m :: * -> *). MonoType m Integer
Int
array :: FunctionType m l r
-> FunctionType m (Vector l) (EvalT m (Vector l))
array :: FunctionType m l r
-> FunctionType m (Vector l) (EvalT m (Vector l))
array = FunctionType m l r
-> FunctionType m (Vector l) (EvalT m (Vector l))
forall (m :: * -> *) l r.
FunctionType m l r
-> FunctionType m (Vector l) (EvalT m (Vector l))
Array
data ForeignImports m = ForeignImports
{ ForeignImports m -> [ForeignImport m]
foreignImports_values :: [ForeignImport m]
}
instance Semigroup (ForeignImports m) where
ForeignImports m
x <> :: ForeignImports m -> ForeignImports m -> ForeignImports m
<> ForeignImports m
y = ForeignImports :: forall (m :: * -> *). [ForeignImport m] -> ForeignImports m
ForeignImports
{ foreignImports_values :: [ForeignImport m]
foreignImports_values = ForeignImports m -> [ForeignImport m]
forall (m :: * -> *). ForeignImports m -> [ForeignImport m]
foreignImports_values ForeignImports m
x [ForeignImport m] -> [ForeignImport m] -> [ForeignImport m]
forall a. Semigroup a => a -> a -> a
<> ForeignImports m -> [ForeignImport m]
forall (m :: * -> *). ForeignImports m -> [ForeignImport m]
foreignImports_values ForeignImports m
y
}
instance Monoid (ForeignImports m) where
mempty :: ForeignImports m
mempty = ForeignImports :: forall (m :: * -> *). [ForeignImport m] -> ForeignImports m
ForeignImports
{ foreignImports_values :: [ForeignImport m]
foreignImports_values = [ForeignImport m]
forall a. Monoid a => a
mempty
}
newtype FFIBuilder m a = FFIBuilder { FFIBuilder m a -> Writer (ForeignImports m) a
unFFIBuilder :: Writer (ForeignImports m) a }
deriving newtype (a -> FFIBuilder m b -> FFIBuilder m a
(a -> b) -> FFIBuilder m a -> FFIBuilder m b
(forall a b. (a -> b) -> FFIBuilder m a -> FFIBuilder m b)
-> (forall a b. a -> FFIBuilder m b -> FFIBuilder m a)
-> Functor (FFIBuilder m)
forall a b. a -> FFIBuilder m b -> FFIBuilder m a
forall a b. (a -> b) -> FFIBuilder m a -> FFIBuilder m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (m :: * -> *) a b. a -> FFIBuilder m b -> FFIBuilder m a
forall (m :: * -> *) a b.
(a -> b) -> FFIBuilder m a -> FFIBuilder m b
<$ :: a -> FFIBuilder m b -> FFIBuilder m a
$c<$ :: forall (m :: * -> *) a b. a -> FFIBuilder m b -> FFIBuilder m a
fmap :: (a -> b) -> FFIBuilder m a -> FFIBuilder m b
$cfmap :: forall (m :: * -> *) a b.
(a -> b) -> FFIBuilder m a -> FFIBuilder m b
Functor, Functor (FFIBuilder m)
a -> FFIBuilder m a
Functor (FFIBuilder m)
-> (forall a. a -> FFIBuilder m a)
-> (forall a b.
FFIBuilder m (a -> b) -> FFIBuilder m a -> FFIBuilder m b)
-> (forall a b c.
(a -> b -> c)
-> FFIBuilder m a -> FFIBuilder m b -> FFIBuilder m c)
-> (forall a b. FFIBuilder m a -> FFIBuilder m b -> FFIBuilder m b)
-> (forall a b. FFIBuilder m a -> FFIBuilder m b -> FFIBuilder m a)
-> Applicative (FFIBuilder m)
FFIBuilder m a -> FFIBuilder m b -> FFIBuilder m b
FFIBuilder m a -> FFIBuilder m b -> FFIBuilder m a
FFIBuilder m (a -> b) -> FFIBuilder m a -> FFIBuilder m b
(a -> b -> c) -> FFIBuilder m a -> FFIBuilder m b -> FFIBuilder m c
forall a. a -> FFIBuilder m a
forall a b. FFIBuilder m a -> FFIBuilder m b -> FFIBuilder m a
forall a b. FFIBuilder m a -> FFIBuilder m b -> FFIBuilder m b
forall a b.
FFIBuilder m (a -> b) -> FFIBuilder m a -> FFIBuilder m b
forall a b c.
(a -> b -> c) -> FFIBuilder m a -> FFIBuilder m b -> FFIBuilder m c
forall (m :: * -> *). Functor (FFIBuilder m)
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 :: * -> *) a. a -> FFIBuilder m a
forall (m :: * -> *) a b.
FFIBuilder m a -> FFIBuilder m b -> FFIBuilder m a
forall (m :: * -> *) a b.
FFIBuilder m a -> FFIBuilder m b -> FFIBuilder m b
forall (m :: * -> *) a b.
FFIBuilder m (a -> b) -> FFIBuilder m a -> FFIBuilder m b
forall (m :: * -> *) a b c.
(a -> b -> c) -> FFIBuilder m a -> FFIBuilder m b -> FFIBuilder m c
<* :: FFIBuilder m a -> FFIBuilder m b -> FFIBuilder m a
$c<* :: forall (m :: * -> *) a b.
FFIBuilder m a -> FFIBuilder m b -> FFIBuilder m a
*> :: FFIBuilder m a -> FFIBuilder m b -> FFIBuilder m b
$c*> :: forall (m :: * -> *) a b.
FFIBuilder m a -> FFIBuilder m b -> FFIBuilder m b
liftA2 :: (a -> b -> c) -> FFIBuilder m a -> FFIBuilder m b -> FFIBuilder m c
$cliftA2 :: forall (m :: * -> *) a b c.
(a -> b -> c) -> FFIBuilder m a -> FFIBuilder m b -> FFIBuilder m c
<*> :: FFIBuilder m (a -> b) -> FFIBuilder m a -> FFIBuilder m b
$c<*> :: forall (m :: * -> *) a b.
FFIBuilder m (a -> b) -> FFIBuilder m a -> FFIBuilder m b
pure :: a -> FFIBuilder m a
$cpure :: forall (m :: * -> *) a. a -> FFIBuilder m a
$cp1Applicative :: forall (m :: * -> *). Functor (FFIBuilder m)
Applicative, Applicative (FFIBuilder m)
a -> FFIBuilder m a
Applicative (FFIBuilder m)
-> (forall a b.
FFIBuilder m a -> (a -> FFIBuilder m b) -> FFIBuilder m b)
-> (forall a b. FFIBuilder m a -> FFIBuilder m b -> FFIBuilder m b)
-> (forall a. a -> FFIBuilder m a)
-> Monad (FFIBuilder m)
FFIBuilder m a -> (a -> FFIBuilder m b) -> FFIBuilder m b
FFIBuilder m a -> FFIBuilder m b -> FFIBuilder m b
forall a. a -> FFIBuilder m a
forall a b. FFIBuilder m a -> FFIBuilder m b -> FFIBuilder m b
forall a b.
FFIBuilder m a -> (a -> FFIBuilder m b) -> FFIBuilder m b
forall (m :: * -> *). Applicative (FFIBuilder m)
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
forall (m :: * -> *) a. a -> FFIBuilder m a
forall (m :: * -> *) a b.
FFIBuilder m a -> FFIBuilder m b -> FFIBuilder m b
forall (m :: * -> *) a b.
FFIBuilder m a -> (a -> FFIBuilder m b) -> FFIBuilder m b
return :: a -> FFIBuilder m a
$creturn :: forall (m :: * -> *) a. a -> FFIBuilder m a
>> :: FFIBuilder m a -> FFIBuilder m b -> FFIBuilder m b
$c>> :: forall (m :: * -> *) a b.
FFIBuilder m a -> FFIBuilder m b -> FFIBuilder m b
>>= :: FFIBuilder m a -> (a -> FFIBuilder m b) -> FFIBuilder m b
$c>>= :: forall (m :: * -> *) a b.
FFIBuilder m a -> (a -> FFIBuilder m b) -> FFIBuilder m b
$cp1Monad :: forall (m :: * -> *). Applicative (FFIBuilder m)
Monad, MonadWriter (ForeignImports m))
evalFFIBuilder :: P.ModuleName -> FFIBuilder m a -> FFI m
evalFFIBuilder :: ModuleName -> FFIBuilder m a -> FFI m
evalFFIBuilder ModuleName
mn = (a, FFI m) -> FFI m
forall a b. (a, b) -> b
snd ((a, FFI m) -> FFI m)
-> (FFIBuilder m a -> (a, FFI m)) -> FFIBuilder m a -> FFI m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> FFIBuilder m a -> (a, FFI m)
forall (m :: * -> *) a. ModuleName -> FFIBuilder m a -> (a, FFI m)
runFFIBuilder ModuleName
mn
runFFIBuilder :: P.ModuleName -> FFIBuilder m a -> (a, FFI m)
runFFIBuilder :: ModuleName -> FFIBuilder m a -> (a, FFI m)
runFFIBuilder ModuleName
mn = (ForeignImports m -> FFI m) -> (a, ForeignImports m) -> (a, FFI m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ForeignImports m -> FFI m
convert ((a, ForeignImports m) -> (a, FFI m))
-> (FFIBuilder m a -> (a, ForeignImports m))
-> FFIBuilder m a
-> (a, FFI m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Writer (ForeignImports m) a -> (a, ForeignImports m)
forall w a. Writer w a -> (a, w)
runWriter (Writer (ForeignImports m) a -> (a, ForeignImports m))
-> (FFIBuilder m a -> Writer (ForeignImports m) a)
-> FFIBuilder m a
-> (a, ForeignImports m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FFIBuilder m a -> Writer (ForeignImports m) a
forall (m :: * -> *) a.
FFIBuilder m a -> Writer (ForeignImports m) a
unFFIBuilder where
convert :: ForeignImports m -> FFI m
convert (ForeignImports [ForeignImport m]
values) = FFI :: forall (m :: * -> *). ModuleName -> [ForeignImport m] -> FFI m
FFI
{ ffi_moduleName :: ModuleName
ffi_moduleName = ModuleName
mn
, ffi_values :: [ForeignImport m]
ffi_values = [ForeignImport m]
values
}
foreignImport
:: (MonadFix m, Evaluate.ToValue m a, ForAll m a ty)
=> P.Ident
-> ty
-> a
-> FFIBuilder m ()
foreignImport :: Ident -> ty -> a -> FFIBuilder m ()
foreignImport =
\Ident
nm ty
ty a
impl -> ForeignImports m -> FFIBuilder m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (ForeignImports m -> FFIBuilder m ())
-> ForeignImports m -> FFIBuilder m ()
forall a b. (a -> b) -> a -> b
$ ForeignImports :: forall (m :: * -> *). [ForeignImport m] -> ForeignImports m
ForeignImports
{ foreignImports_values :: [ForeignImport m]
foreignImports_values =
[ ForeignImport :: forall (m :: * -> *).
Ident -> SourceType -> Value m -> ForeignImport m
ForeignImport
{ fv_name :: Ident
fv_name = Ident
nm
, fv_type :: SourceType
fv_type = TypeScheme m a -> SourceType
forall (m :: * -> *) a. MonadFix m => TypeScheme m a -> SourceType
typeSchemeToSourceType (ty -> TypeScheme m a
forall (m :: * -> *) r a. ForAll m r a => a -> TypeScheme m r
forAll ty
ty)
, fv_value :: Value m
fv_value = a -> Value m
forall (m :: * -> *) a. ToValue m a => a -> Value m
Evaluate.toValue a
impl
}
]
}
typeSchemeToSourceType :: MonadFix m => TypeScheme m a -> P.SourceType
typeSchemeToSourceType :: TypeScheme m a -> SourceType
typeSchemeToSourceType (Cons FunctionType m (Value m) (EvalT m (Value m)) -> TypeScheme m a
f) = (SourceType -> SourceType) -> SourceType
Internal.forAll \SourceType
a -> TypeScheme m a -> SourceType
forall (m :: * -> *) a. MonadFix m => TypeScheme m a -> SourceType
typeSchemeToSourceType (FunctionType m (Value m) (EvalT m (Value m)) -> TypeScheme m a
f (MonoType m (Value m)
-> FunctionType m (Value m) (EvalT m (Value m))
forall (m :: * -> *) l.
MonoType m l -> FunctionType m l (EvalT m l)
MonoType (SourceType -> MonoType m (Value m)
forall (m :: * -> *). SourceType -> MonoType m (Value m)
Var SourceType
a)))
typeSchemeToSourceType (Nil FunctionType m a r
t) = FunctionType m a r -> SourceType
forall (m :: * -> *) l r.
MonadFix m =>
FunctionType m l r -> SourceType
functionTypeToSourceType FunctionType m a r
t
functionTypeToSourceType :: MonadFix m => FunctionType m l r -> P.SourceType
functionTypeToSourceType :: FunctionType m l r -> SourceType
functionTypeToSourceType (Function FunctionType m al ar
ty1 FunctionType m bl br
ty2) =
SourceType -> SourceType -> SourceType
Internal.function
(FunctionType m al ar -> SourceType
forall (m :: * -> *) l r.
MonadFix m =>
FunctionType m l r -> SourceType
functionTypeToSourceType FunctionType m al ar
ty1)
(FunctionType m bl br -> SourceType
forall (m :: * -> *) l r.
MonadFix m =>
FunctionType m l r -> SourceType
functionTypeToSourceType FunctionType m bl br
ty2)
functionTypeToSourceType (Array FunctionType m l r
ty) =
SourceType -> SourceType
Internal.array
(FunctionType m l r -> SourceType
forall (m :: * -> *) l r.
MonadFix m =>
FunctionType m l r -> SourceType
functionTypeToSourceType FunctionType m l r
ty)
functionTypeToSourceType (MonoType MonoType m l
t) = MonoType m l -> SourceType
forall (m :: * -> *) a. MonadFix m => MonoType m a -> SourceType
monoTypeToSourceType MonoType m l
t
monoTypeToSourceType :: MonadFix m => MonoType m a -> P.SourceType
monoTypeToSourceType :: MonoType m a -> SourceType
monoTypeToSourceType MonoType m a
String = SourceType
P.tyString
monoTypeToSourceType MonoType m a
Char = SourceType
P.tyChar
monoTypeToSourceType MonoType m a
Boolean = SourceType
P.tyBoolean
monoTypeToSourceType MonoType m a
Number = SourceType
P.tyNumber
monoTypeToSourceType MonoType m a
Int = SourceType
P.tyInt
monoTypeToSourceType (Var SourceType
a) = SourceType
a