{-# LANGUAGE BlockArguments #-} {-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE OverloadedStrings #-} module Dovetail.FFI.Internal ( forAll , array , function ) where import Data.List ((\\), nub) import Data.Text (Text) import Data.Text qualified as T import Language.PureScript qualified as P forAll :: (P.SourceType -> P.SourceType) -> P.SourceType forAll :: (SourceType -> SourceType) -> SourceType forAll SourceType -> SourceType f = [(SourceAnn, (Text, Maybe SourceType))] -> SourceType -> SourceType forall a. [(a, (Text, Maybe (Type a)))] -> Type a -> Type a P.mkForAll [(SourceAnn P.nullSourceAnn, (Text name, (SourceType -> Maybe SourceType forall a. a -> Maybe a Just SourceType P.kindType)))] (SourceType -> SourceType f (SourceAnn -> Text -> SourceType forall a. a -> Text -> Type a P.TypeVar SourceAnn P.nullSourceAnn Text name)) where name :: Text name = [Text] -> Text forall a. [a] -> a head ([Text] typeVars [Text] -> [Text] -> [Text] forall a. Eq a => [a] -> [a] -> [a] \\ SourceType -> [Text] forall ann. Type ann -> [Text] boundTypeVars (SourceType -> SourceType f (SourceAnn -> Text -> SourceType forall a. a -> Text -> Type a P.TypeVar SourceAnn P.nullSourceAnn Text forall a. HasCallStack => a undefined))) typeVars :: [Text] typeVars :: [Text] typeVars = (Char -> Text) -> [Char] -> [Text] forall a b. (a -> b) -> [a] -> [b] map Char -> Text T.singleton [Char 'a'..Char 'z'] [Text] -> [Text] -> [Text] forall a. Semigroup a => a -> a -> a <> (Text -> Text) -> [Text] -> [Text] forall a b. (a -> b) -> [a] -> [b] map (Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "'") [Text] typeVars boundTypeVars :: P.Type ann -> [Text] boundTypeVars :: Type ann -> [Text] boundTypeVars = [Text] -> [Text] forall a. Eq a => [a] -> [a] nub ([Text] -> [Text]) -> (Type ann -> [Text]) -> Type ann -> [Text] forall b c a. (b -> c) -> (a -> b) -> a -> c . ([Text] -> [Text] -> [Text]) -> (Type ann -> [Text]) -> Type ann -> [Text] forall r a. (r -> r -> r) -> (Type a -> r) -> Type a -> r P.everythingOnTypes [Text] -> [Text] -> [Text] forall a. [a] -> [a] -> [a] (++) Type ann -> [Text] forall ann. Type ann -> [Text] go where go :: Type a -> [Text] go (P.ForAll a _ Text name Maybe (Type a) _ Type a _ Maybe SkolemScope _) = [Text name] go Type a _ = [] function :: P.SourceType -> P.SourceType -> P.SourceType function :: SourceType -> SourceType -> SourceType function SourceType a SourceType b = SourceAnn -> SourceType -> SourceType -> SourceType forall a. a -> Type a -> Type a -> Type a P.TypeApp SourceAnn P.nullSourceAnn (SourceAnn -> SourceType -> SourceType -> SourceType forall a. a -> Type a -> Type a -> Type a P.TypeApp SourceAnn P.nullSourceAnn SourceType P.tyFunction SourceType a) SourceType b array :: P.SourceType -> P.SourceType array :: SourceType -> SourceType array = SourceAnn -> SourceType -> SourceType -> SourceType forall a. a -> Type a -> Type a -> Type a P.TypeApp SourceAnn P.nullSourceAnn SourceType P.tyArray