Support type application syntax

src/PureScript/CST/Parser.purs

@@ -29,7 +29,7 @@ import PureScript.CST.Layout (currentIndent)
 import PureScript.CST.Parser.Monad (Parser, eof, lookAhead, many, optional, recover, take, try)
 import PureScript.CST.TokenStream (TokenStep(..), TokenStream, layoutStack)
 import PureScript.CST.TokenStream as TokenStream
-import PureScript.CST.Types (Binder(..), ClassFundep(..), DataCtor(..), DataMembers(..), Declaration(..), Delimited, DoStatement(..), Export(..), Expr(..), Fixity(..), FixityOp(..), Foreign(..), Guarded(..), GuardedExpr(..), Ident(..), Import(..), ImportDecl(..), Instance(..), InstanceBinding(..), IntValue(..), Label(..), Labeled(..), LetBinding(..), Module(..), ModuleBody(..), ModuleHeader(..), ModuleName(..), Name(..), OneOrDelimited(..), Operator(..), PatternGuard(..), Proper(..), QualifiedName(..), RecordLabeled(..), RecordUpdate(..), Role(..), Row(..), Separated(..), SourceToken, Token(..), Type(..), TypeVarBinding(..), Where(..), Wrapped(..))
+import PureScript.CST.Types (AppSpine(..), Binder(..), ClassFundep(..), DataCtor(..), DataMembers(..), Declaration(..), Delimited, DoStatement(..), Export(..), Expr(..), Fixity(..), FixityOp(..), Foreign(..), Guarded(..), GuardedExpr(..), Ident(..), Import(..), ImportDecl(..), Instance(..), InstanceBinding(..), IntValue(..), Label(..), Labeled(..), LetBinding(..), Module(..), ModuleBody(..), ModuleHeader(..), ModuleName(..), Name(..), OneOrDelimited(..), Operator(..), PatternGuard(..), Prefixed(..), Proper(..), QualifiedName(..), RecordLabeled(..), RecordUpdate(..), Role(..), Row(..), Separated(..), SourceToken, Token(..), Type(..), TypeVarBinding(..), Where(..), Wrapped(..))
 
 type Recovered :: (P.Type -> P.Type) -> P.Type
 type Recovered f = f RecoveredError
@@ -179,7 +179,7 @@ parseDeclData = do
 
 parseDeclData1 :: SourceToken -> Name Proper -> Parser (Recovered Declaration)
 parseDeclData1 keyword name = do
-  vars <- many parseTypeVarBinding
+  vars <- many parseTypeVarBindingPlain
   ctors <- optional (Tuple <$> tokEquals <*> separated tokPipe parseDataCtor)
   pure $ DeclData { keyword, name, vars } ctors
 
@@ -198,7 +198,7 @@ parseDeclNewtype = do
 
 parseDeclNewtype1 :: SourceToken -> Name Proper -> Parser (Recovered Declaration)
 parseDeclNewtype1 keyword name = do
-  vars <- many parseTypeVarBinding
+  vars <- many parseTypeVarBindingPlain
   tok <- tokEquals
   wrapper <- parseProper
   body <- parseTypeAtom
@@ -218,7 +218,7 @@ parseDeclType1 keyword = do
 
 parseDeclType2 :: SourceToken -> Name Proper -> Parser (Recovered Declaration)
 parseDeclType2 keyword name = do
-  vars <- many parseTypeVarBinding
+  vars <- many parseTypeVarBindingPlain
   tok <- tokEquals
   body <- parseType
   pure $ DeclType { keyword, name, vars } tok body
@@ -252,7 +252,7 @@ parseDeclClass1 :: SourceToken -> Parser (Recovered Declaration)
 parseDeclClass1 keyword = do
   super <- optional $ try $ Tuple <$> parseClassConstraints parseType5 <*> tokLeftFatArrow
   name <- parseProper
-  vars <- many parseTypeVarBinding
+  vars <- many parseTypeVarBindingPlain
   fundeps <- optional $ Tuple <$> tokPipe <*> separated tokComma parseFundep
   members <- optional $ Tuple <$> tokKeyword "where" <*> layoutNonEmpty parseClassMember
   pure $ DeclClass { keyword, super, name, vars, fundeps } members
@@ -525,18 +525,27 @@ parseForall :: Parser (Recovered Type)
 parseForall = defer \_ ->
   TypeForall
     <$> tokForall
-    <*> many1 parseTypeVarBinding
+    <*> many1 parseTypeVarBindingWithVisibility
     <*> tokDot
     <*> parseType1
 
-parseTypeVarBinding :: Parser (Recovered TypeVarBinding)
-parseTypeVarBinding = defer \_ ->
-  parseTypeVarKinded
-    <|> TypeVarName <$> parseIdent
+parseTypeVarBindingWithVisibility :: Parser (Recovered (TypeVarBinding (Prefixed (Name Ident))))
+parseTypeVarBindingWithVisibility = defer \_ -> parseTypeVarBinding ado
+  prefix <- optional tokAt
+  value <- parseIdent
+  in Prefixed { prefix, value }
 
-parseTypeVarKinded :: Parser (Recovered TypeVarBinding)
-parseTypeVarKinded = TypeVarKinded <$> parens do
-  label <- parseIdent
+parseTypeVarBindingPlain :: Parser (Recovered (TypeVarBinding (Name Ident)))
+parseTypeVarBindingPlain = parseTypeVarBinding parseIdent
+
+parseTypeVarBinding :: forall a. Parser a -> Parser (Recovered (TypeVarBinding a))
+parseTypeVarBinding parseBindingName =
+  parseTypeVarKinded parseBindingName
+    <|> TypeVarName <$> parseBindingName
+
+parseTypeVarKinded :: forall a. Parser a -> Parser (Recovered (TypeVarBinding a))
+parseTypeVarKinded parseBindingName = TypeVarKinded <$> parens do
+  label <- parseBindingName
   separator <- tokDoubleColon
   value <- parseType
   pure $ Labeled { label, separator, value }
@@ -586,7 +595,7 @@ parseExpr3 = defer \_ -> do
 parseExpr4 :: Parser (Recovered Expr)
 parseExpr4 = defer \_ -> do
   expr <- parseExpr5
-  args <- many parseExpr5
+  args <- many parseExprAppSpine
   pure case NonEmptyArray.fromArray args of
     Nothing -> expr
     Just as -> ExprApp expr as
@@ -601,6 +610,11 @@ parseExpr5 = defer \_ ->
     <|> parseAdo
     <|> parseExpr6
 
+parseExprAppSpine :: Parser (Recovered (AppSpine Expr))
+parseExprAppSpine = defer \_ ->
+  AppType <$> tokAt <*> parseTypeAtom
+    <|> AppTerm <$> parseExpr5
+
 parseIf :: Parser (Recovered Expr)
 parseIf = do
   keyword <- tokKeyword "if"

src/PureScript/CST/Range.purs

@@ -6,6 +6,7 @@ module PureScript.CST.Range
   ) where
 
 import Prelude
+import Prim hiding (Row, Type)
 
 import Control.Lazy (defer)
 import Data.Array as Array
@@ -14,11 +15,10 @@ import Data.Array.NonEmpty as NonEmptyArray
 import Data.Foldable (foldMap)
 import Data.Maybe (Maybe(..), maybe)
 import Data.Tuple (Tuple(..), fst, snd)
-import Prim hiding (Row, Type)
 import PureScript.CST.Errors (RecoveredError(..))
 import PureScript.CST.Range.TokenList (TokenList, cons, singleton)
 import PureScript.CST.Range.TokenList as TokenList
-import PureScript.CST.Types (Binder(..), ClassFundep(..), DataCtor(..), DataMembers(..), Declaration(..), DoStatement(..), Export(..), Expr(..), FixityOp(..), Foreign(..), Guarded(..), GuardedExpr(..), Import(..), ImportDecl(..), Instance(..), InstanceBinding(..), Labeled(..), LetBinding(..), Module(..), ModuleBody(..), ModuleHeader(..), Name(..), OneOrDelimited(..), PatternGuard(..), QualifiedName(..), RecordLabeled(..), RecordUpdate(..), Row(..), Separated(..), SourceRange, Type(..), TypeVarBinding(..), Where(..), Wrapped(..))
+import PureScript.CST.Types (AppSpine(..), Binder(..), ClassFundep(..), DataCtor(..), DataMembers(..), Declaration(..), DoStatement(..), Export(..), Expr(..), FixityOp(..), Foreign(..), Guarded(..), GuardedExpr(..), Import(..), ImportDecl(..), Instance(..), InstanceBinding(..), Labeled(..), LetBinding(..), Module(..), ModuleBody(..), ModuleHeader(..), Name(..), OneOrDelimited(..), PatternGuard(..), Prefixed(..), QualifiedName(..), RecordLabeled(..), RecordUpdate(..), Row(..), Separated(..), SourceRange, Type(..), TypeVarBinding(..), Where(..), Wrapped(..))
 
 class RangeOf a where
   rangeOf :: a -> SourceRange
@@ -121,6 +121,24 @@ instance tokensOfLabeled :: (TokensOf a, TokensOf b) => TokensOf (Labeled a b) w
   tokensOf (Labeled { label, separator, value }) =
     tokensOf label <> singleton separator <> tokensOf value
 
+instance rangeOfPrefixed :: RangeOf a => RangeOf (Prefixed a) where
+  rangeOf (Prefixed { prefix, value }) =
+    case prefix of
+      Just tok ->
+        { start: tok.range.start
+        , end: (rangeOf value).end
+        }
+      Nothing ->
+        rangeOf value
+
+instance tokensOfPrefixed :: TokensOf a => TokensOf (Prefixed a) where
+  tokensOf (Prefixed { prefix, value }) =
+    case prefix of
+      Just tok ->
+        cons tok $ defer \_ -> tokensOf value
+      Nothing ->
+        tokensOf value
+
 instance rangeOfOneOrDelimited :: RangeOf a => RangeOf (OneOrDelimited a) where
   rangeOf = case _ of
     One a -> rangeOf a
@@ -240,14 +258,14 @@ instance tokensOfRow :: TokensOf e => TokensOf (Row e) where
     foldMap tokensOf labels
       <> foldMap (\(Tuple t ty) -> cons t $ tokensOf ty) tail
 
-instance rangeOfTypeVarBinding :: RangeOf (TypeVarBinding e) where
+instance rangeOfTypeVarBinding :: RangeOf a => RangeOf (TypeVarBinding a e) where
   rangeOf = case _ of
     TypeVarKinded w ->
       rangeOf w
     TypeVarName n ->
       rangeOf n
 
-instance tokensOfTypeVarBinding :: TokensOf e => TokensOf (TypeVarBinding e) where
+instance tokensOfTypeVarBinding :: (TokensOf a, TokensOf e) => TokensOf (TypeVarBinding a e) where
   tokensOf = case _ of
     TypeVarKinded w ->
       tokensOf w
@@ -825,6 +843,22 @@ instance tokensOfExpr :: TokensOf e => TokensOf (Expr e) where
     ExprError e ->
       tokensOf e
 
+instance rangeOfAppSpine :: (RangeOf e, RangeOf (f e)) => RangeOf (AppSpine f e) where
+  rangeOf = case _ of
+    AppType t a ->
+      { start: t.range.start
+      , end: (rangeOf a).end
+      }
+    AppTerm a ->
+      rangeOf a
+
+instance tokensOfAppSpine :: (TokensOf e, TokensOf (f e)) => TokensOf (AppSpine f e) where
+  tokensOf = case _ of
+    AppType t a ->
+      cons t $ defer \_ -> tokensOf a
+    AppTerm a ->
+      tokensOf a
+
 instance tokensOfRecordUpdate :: TokensOf e => TokensOf (RecordUpdate e) where
   tokensOf = case _ of
     RecordUpdateLeaf n t e ->

src/PureScript/CST/Traversal.purs

@@ -59,6 +59,7 @@ module PureScript.CST.Traversal
   , traverseRow
   , traverseTypeVarBinding
   , traverseExpr
+  , traverseExprAppSpine
   , traverseDelimited
   , traverseDelimitedNonEmpty
   , traverseSeparated
@@ -98,6 +99,7 @@ module PureScript.CST.Traversal
   ) where
 
 import Prelude
+import Prim hiding (Row, Type)
 
 import Control.Monad.Free (Free, runFree)
 import Control.Monad.Reader.Trans (ReaderT(..), runReaderT)
@@ -109,8 +111,7 @@ import Data.Newtype (un)
 import Data.Traversable (traverse)
 import Data.Tuple (Tuple(..), curry, uncurry)
 import Prim as P
-import Prim hiding (Row, Type)
-import PureScript.CST.Types (AdoBlock, Binder(..), CaseOf, ClassHead, DataCtor(..), DataHead, Declaration(..), Delimited, DelimitedNonEmpty, DoBlock, DoStatement(..), Expr(..), Foreign(..), Guarded(..), GuardedExpr(..), IfThenElse, Instance(..), InstanceBinding(..), InstanceHead, Labeled(..), Lambda, LetBinding(..), LetIn, Module(..), ModuleBody(..), OneOrDelimited(..), PatternGuard(..), RecordAccessor, RecordLabeled(..), RecordUpdate(..), Row(..), Separated(..), Type(..), TypeVarBinding(..), ValueBindingFields, Where(..), Wrapped(..))
+import PureScript.CST.Types (AdoBlock, AppSpine(..), Binder(..), CaseOf, ClassHead, DataCtor(..), DataHead, Declaration(..), Delimited, DelimitedNonEmpty, DoBlock, DoStatement(..), Expr(..), Foreign(..), Guarded(..), GuardedExpr(..), IfThenElse, Instance(..), InstanceBinding(..), InstanceHead, Labeled(..), Lambda, LetBinding(..), LetIn, Module(..), ModuleBody(..), OneOrDelimited(..), PatternGuard(..), RecordAccessor, RecordLabeled(..), RecordUpdate(..), Row(..), Separated(..), Type(..), TypeVarBinding(..), ValueBindingFields, Where(..), Wrapped(..))
 import Type.Row (type (+))
 
 type Rewrite e f (g :: P.Type -> P.Type) = g e -> f (g e)
@@ -312,10 +313,10 @@ traverseRow k (Row r) =
     <*> traverse (traverse k.onType) r.tail
 
 traverseTypeVarBinding
-  :: forall e f r
+  :: forall e f r a
    . Applicative f
   => { | OnType (Rewrite e f) + r }
-  -> Rewrite e f TypeVarBinding
+  -> Rewrite e f (TypeVarBinding a)
 traverseTypeVarBinding k = case _ of
   TypeVarKinded labeled -> TypeVarKinded <$> traverseWrapped (traverseLabeled k.onType) labeled
   TypeVarName name -> pure (TypeVarName name)
@@ -335,7 +336,7 @@ traverseExpr k = case _ of
   ExprNegate tok expr -> ExprNegate tok <$> k.onExpr expr
   ExprRecordAccessor recordAccessor -> ExprRecordAccessor <$> traverseRecordAccessor k recordAccessor
   ExprRecordUpdate expr recordUpdates -> ExprRecordUpdate <$> k.onExpr expr <*> traverseWrapped (traverseSeparated (traverseRecordUpdate k)) recordUpdates
-  ExprApp expr args -> ExprApp <$> k.onExpr expr <*> traverse k.onExpr args
+  ExprApp expr args -> ExprApp <$> k.onExpr expr <*> traverse (traverseExprAppSpine k) args
   ExprLambda lambda -> ExprLambda <$> traverseLambda k lambda
   ExprIf ifThenElse -> ExprIf <$> traverseIfThenElse k ifThenElse
   ExprCase caseOf -> ExprCase <$> traverseCaseOf k caseOf
@@ -344,6 +345,15 @@ traverseExpr k = case _ of
   ExprAdo adoBlock -> ExprAdo <$> traverseAdoBlock k adoBlock
   expr -> pure expr
 
+traverseExprAppSpine
+  :: forall e f r
+   . Applicative f
+  => { | OnBinder (Rewrite e f) + OnExpr (Rewrite e f) + OnType (Rewrite e f) + r }
+  -> Rewrite e f (AppSpine Expr)
+traverseExprAppSpine k = case _ of
+  AppType tok ty -> AppType tok <$> traverseType k ty
+  AppTerm expr -> AppTerm <$> traverseExpr k expr
+
 traverseDelimited
   :: forall f a
    . Applicative f

src/PureScript/CST/Types.purs

@@ -153,6 +153,13 @@ newtype Labeled a b = Labeled
 
 derive instance newtypeLabeled :: Newtype (Labeled a b) _
 
+newtype Prefixed a = Prefixed
+  { prefix :: Maybe SourceToken
+  , value :: a
+  }
+
+derive instance newtypePrefixed :: Newtype (Prefixed a) _
+
 type Delimited a = Wrapped (Maybe (Separated a))
 type DelimitedNonEmpty a = Wrapped (Separated a)
 
@@ -169,7 +176,7 @@ data Type e
   | TypeInt (Maybe SourceToken) SourceToken IntValue
   | TypeRow (Wrapped (Row e))
   | TypeRecord (Wrapped (Row e))
-  | TypeForall SourceToken (NonEmptyArray (TypeVarBinding e)) SourceToken (Type e)
+  | TypeForall SourceToken (NonEmptyArray (TypeVarBinding (Prefixed (Name Ident)) e)) SourceToken (Type e)
   | TypeKinded (Type e) SourceToken (Type e)
   | TypeApp (Type e) (NonEmptyArray (Type e))
   | TypeOp (Type e) (NonEmptyArray (Tuple (QualifiedName Operator) (Type e)))
@@ -180,9 +187,9 @@ data Type e
   | TypeParens (Wrapped (Type e))
   | TypeError e
 
-data TypeVarBinding e
-  = TypeVarKinded (Wrapped (Labeled (Name Ident) (Type e)))
-  | TypeVarName (Name Ident)
+data TypeVarBinding a e
+  = TypeVarKinded (Wrapped (Labeled a (Type e)))
+  | TypeVarName a
 
 newtype Row e = Row
   { labels :: Maybe (Separated (Labeled (Name Label) (Type e)))
@@ -275,7 +282,7 @@ data Import e
 type DataHead e =
   { keyword :: SourceToken
   , name :: Name Proper
-  , vars :: Array (TypeVarBinding e)
+  , vars :: Array (TypeVarBinding (Name Ident) e)
   }
 
 newtype DataCtor e = DataCtor
@@ -289,7 +296,7 @@ type ClassHead e =
   { keyword :: SourceToken
   , super :: Maybe (Tuple (OneOrDelimited (Type e)) SourceToken)
   , name :: Name Proper
-  , vars :: Array (TypeVarBinding e)
+  , vars :: Array (TypeVarBinding (Name Ident) e)
   , fundeps :: Maybe (Tuple SourceToken (Separated ClassFundep))
   }
 
@@ -376,7 +383,7 @@ data Expr e
   | ExprNegate SourceToken (Expr e)
   | ExprRecordAccessor (RecordAccessor e)
   | ExprRecordUpdate (Expr e) (DelimitedNonEmpty (RecordUpdate e))
-  | ExprApp (Expr e) (NonEmptyArray (Expr e))
+  | ExprApp (Expr e) (NonEmptyArray (AppSpine Expr e))
   | ExprLambda (Lambda e)
   | ExprIf (IfThenElse e)
   | ExprCase (CaseOf e)
@@ -385,6 +392,10 @@ data Expr e
   | ExprAdo (AdoBlock e)
   | ExprError e
 
+data AppSpine f e
+  = AppType SourceToken (Type e)
+  | AppTerm (f e)
+
 data RecordLabeled a
   = RecordPun (Name Ident)
   | RecordField (Name Label) SourceToken a

test/Main.purs

@@ -13,7 +13,7 @@ import Effect (Effect)
 import Effect.Class.Console as Console
 import Node.Process as Process
 import PureScript.CST (RecoveredParserResult(..), parseBinder, parseDecl, parseExpr, parseModule, parseType)
-import PureScript.CST.Types (Binder, Declaration(..), DoStatement(..), Expr(..), Label(..), LetBinding(..), Module(..), ModuleBody(..), Name(..), RecordLabeled(..), Separated(..), Token(..), Type, Wrapped(..))
+import PureScript.CST.Types (AppSpine(..), Binder, Declaration(..), DoStatement(..), Expr(..), Label(..), Labeled(..), LetBinding(..), Module(..), ModuleBody(..), Name(..), Prefixed(..), RecordLabeled(..), Separated(..), Token(..), Type(..), TypeVarBinding(..), Wrapped(..))
 
 class ParseFor f where
   parseFor :: String -> RecoveredParserResult f
@@ -252,3 +252,42 @@ main = do
         true
       _ ->
         false
+
+  assertParse "Type applications"
+    """
+    foo @Bar bar @(Baz 42) 42
+    """
+    case _ of
+      (ParseSucceeded (ExprApp _ apps))
+        | [ AppType _ _
+          , AppTerm _
+          , AppType _ _
+          , AppTerm _
+          ] <- NonEmptyArray.toArray apps ->
+            true
+      _ ->
+        false
+
+  assertParse "Forall visibility"
+    """
+    forall @a (@b :: Type) c. a -> c
+    """
+    case _ of
+      ParseSucceeded (TypeForall _ binders _ _)
+        | [ TypeVarName (Prefixed { prefix: Just _ })
+          , TypeVarKinded (Wrapped { value: Labeled { label: Prefixed { prefix: Just _ } } })
+          , TypeVarName (Prefixed { prefix: Nothing })
+          ] <- NonEmptyArray.toArray binders ->
+            true
+      _ ->
+        false
+
+  assertParse "Kind applications not supported"
+    """
+    Foo @Bar
+    """
+    case _ of
+      ParseSucceeded (TypeConstructor _) ->
+        true
+      _ ->
+        false