ligo/tools/lsp/squirrel/src/AST/Parser.hs

module AST.Parser where

import Data.Text (Text)

import AST.Types

import Parser
import Range

import Debug.Trace

name :: Parser (Name Range)
name = do
  (raw, info) <- range (token "Name")
  return Name {info, raw}

contract :: Parser (Contract Range)
contract = subtree "contract" do
  (decls, info) <- range do
    many "declaration" declaration
  return (Contract info decls)

declaration :: Parser (Declaration Range)
declaration =
  stubbed "declaration" do
    field "declaration" do
      (b, info) <- range binding
      return (ValueDecl info b)

par x = do
  consume "("
  a <- x
  consume ")"
  return a

binding :: Parser (Binding Range)
binding = do
  info <- getRange
  "fun_decl" `subtree` do
    recur <- optional do
      field "recursive" do
        token "recursive"
    consume "function"
    name <- stubbed "name" do
      field "name" do
        name
    params <-
      field "parameters" do
        subtree "parameters" do
          par do
            many "param" do
              notFollowedBy do
                consumeOrDie ")"

              stubbed "parameters" do
                paramDecl
    consume ":"
    ty <-
      stubbed "type" do
        field "type" type_
    consume "is"
    exp <- stubbed "body" do
      field "expr" expr
    return (Function info (recur == Just "recursive") name params ty exp)

expr :: Parser (Expr Range)
expr = do
  fallback "expr"

paramDecl :: Parser (VarDecl Range)
paramDecl = do
  info <- getRange
  "parameter" `field` do
    subtree "param_decl" do
      info' <- getRange
      mutable <- do
        traceM "paramDecl"
        stubbed "access" do
          "access" `subtree` do
            traceM "paramDecl"
            select
              [ consume "var"   >> return (Mutable info')
              , consume "const" >> return (Immutable info')
              ]
      name <-
        stubbed "name" do
          field "name" name
      consume ":"
      ty <-
        stubbed "type" do
          field "type" type_
      return (Decl info mutable name ty)

newtype_ = do
  type_

type_ :: Parser (Type Range)
type_ =
    fun_type
  where
    fun_type :: Parser (Type Range)
    fun_type = do
      stubbed "type" do
        subtree "fun_type" do
          info <- getRange
          domain <- stubbed "domain" do
            field "domain" cartesian
          codomain <- optional do
            consume "->"
            fun_type
          return case codomain of
            Just co -> TArrow info domain co
            Nothing -> domain

    cartesian = do
      stubbed "cartesian" do
        subtree "cartesian" do
          info <- getRange
          Product info <$> some "corety" do
            field "element" do
              core_type

    core_type = do
      info <- getRange
      select
        [ TVar info <$> typename
        ]

    typename = name

tuple :: Text -> Parser a -> Parser [a]
tuple msg = par . some msg

example = "../../../src/test/contracts/address.ligo"