{-# 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