{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
module Language.Rzk.VSCode.Tokenize where

import           Language.LSP.Protocol.Types (SemanticTokenAbsolute (..),
                                              SemanticTokenModifiers (..),
                                              SemanticTokenTypes (..))
import           Language.Rzk.Syntax
import           Language.Rzk.Syntax.Print

tokenizeModule :: Module -> [SemanticTokenAbsolute]
tokenizeModule :: Module -> [SemanticTokenAbsolute]
tokenizeModule (Module BNFC'Position
_loc LanguageDecl' BNFC'Position
langDecl [Command' BNFC'Position]
commands) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ LanguageDecl' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeLanguageDecl LanguageDecl' BNFC'Position
langDecl
  , forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Command' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeCommand [Command' BNFC'Position]
commands
  ]

tokenizeLanguageDecl :: LanguageDecl -> [SemanticTokenAbsolute]
tokenizeLanguageDecl :: LanguageDecl' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeLanguageDecl LanguageDecl' BNFC'Position
_ = []

tokenizeCommand :: Command -> [SemanticTokenAbsolute]
tokenizeCommand :: Command' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeCommand Command' BNFC'Position
command = case Command' BNFC'Position
command of
  CommandSetOption{}   -> []    -- NOTE: fallback to TextMate
  CommandUnsetOption{} -> []    -- NOTE: fallback to TextMate
  CommandCheck        BNFC'Position
_loc Term' BNFC'Position
term Term' BNFC'Position
type_ -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm [Term' BNFC'Position
term, Term' BNFC'Position
type_]
  CommandCompute      BNFC'Position
_loc Term' BNFC'Position
term -> Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm Term' BNFC'Position
term
  CommandComputeNF    BNFC'Position
_loc Term' BNFC'Position
term -> Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm Term' BNFC'Position
term
  CommandComputeWHNF  BNFC'Position
_loc Term' BNFC'Position
term -> Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm Term' BNFC'Position
term

  CommandPostulate BNFC'Position
_loc VarIdent' BNFC'Position
name DeclUsedVars' BNFC'Position
_declUsedVars [Param' BNFC'Position]
params Term' BNFC'Position
type_ -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken VarIdent' BNFC'Position
name SemanticTokenTypes
SemanticTokenTypes_Function [SemanticTokenModifiers
SemanticTokenModifiers_Declaration]
    , forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Param' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeParam [Param' BNFC'Position]
params
    , Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm Term' BNFC'Position
type_
    ]
  CommandDefine BNFC'Position
_loc VarIdent' BNFC'Position
name DeclUsedVars' BNFC'Position
_declUsedVars [Param' BNFC'Position]
params Term' BNFC'Position
type_ Term' BNFC'Position
term -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken VarIdent' BNFC'Position
name SemanticTokenTypes
SemanticTokenTypes_Function [SemanticTokenModifiers
SemanticTokenModifiers_Declaration]
    , forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Param' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeParam [Param' BNFC'Position]
params
    , forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm [Term' BNFC'Position
type_, Term' BNFC'Position
term]
    ]

  CommandAssume BNFC'Position
_loc [VarIdent' BNFC'Position]
vars Term' BNFC'Position
type_ -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\VarIdent' BNFC'Position
var -> forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken VarIdent' BNFC'Position
var SemanticTokenTypes
SemanticTokenTypes_Parameter [SemanticTokenModifiers
SemanticTokenModifiers_Declaration]) [VarIdent' BNFC'Position]
vars
    , Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm Term' BNFC'Position
type_
    ]
  CommandSection    BNFC'Position
_loc SectionName' BNFC'Position
_nameStart -> []
  CommandSectionEnd BNFC'Position
_loc SectionName' BNFC'Position
_nameEnd -> []

tokenizeParam :: Param -> [SemanticTokenAbsolute]
tokenizeParam :: Param' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeParam = \case
  ParamPattern BNFC'Position
_loc Pattern
pat -> Pattern -> [SemanticTokenAbsolute]
tokenizePattern Pattern
pat
  ParamPatternType BNFC'Position
_loc [Pattern]
pats Term' BNFC'Position
type_ -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Pattern -> [SemanticTokenAbsolute]
tokenizePattern [Pattern]
pats
    , Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm Term' BNFC'Position
type_ ]
  ParamPatternShape BNFC'Position
_loc [Pattern]
pats Term' BNFC'Position
cube Term' BNFC'Position
tope -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Pattern -> [SemanticTokenAbsolute]
tokenizePattern [Pattern]
pats
    , Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm Term' BNFC'Position
cube
    , Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTope Term' BNFC'Position
tope ]
  ParamPatternShapeDeprecated BNFC'Position
_loc Pattern
pat Term' BNFC'Position
cube Term' BNFC'Position
tope -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ Pattern -> [SemanticTokenAbsolute]
tokenizePattern Pattern
pat
    , Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm Term' BNFC'Position
cube
    , Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTope Term' BNFC'Position
tope ]

tokenizePattern :: Pattern -> [SemanticTokenAbsolute]
tokenizePattern :: Pattern -> [SemanticTokenAbsolute]
tokenizePattern = \case
  PatternVar BNFC'Position
_loc VarIdent' BNFC'Position
var    -> forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken VarIdent' BNFC'Position
var SemanticTokenTypes
SemanticTokenTypes_Parameter [SemanticTokenModifiers
SemanticTokenModifiers_Declaration]
  PatternPair BNFC'Position
_loc Pattern
l Pattern
r   -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Pattern -> [SemanticTokenAbsolute]
tokenizePattern [Pattern
l, Pattern
r]
  pat :: Pattern
pat@(PatternUnit BNFC'Position
_loc) -> forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Pattern
pat SemanticTokenTypes
SemanticTokenTypes_EnumMember [SemanticTokenModifiers
SemanticTokenModifiers_Declaration]

tokenizeTope :: Term -> [SemanticTokenAbsolute]
tokenizeTope :: Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTope = Maybe SemanticTokenTypes
-> Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm' (forall a. a -> Maybe a
Just SemanticTokenTypes
SemanticTokenTypes_String)

tokenizeTerm :: Term -> [SemanticTokenAbsolute]
tokenizeTerm :: Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm = Maybe SemanticTokenTypes
-> Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm' forall a. Maybe a
Nothing

tokenizeTerm' :: Maybe SemanticTokenTypes -> Term -> [SemanticTokenAbsolute]
tokenizeTerm' :: Maybe SemanticTokenTypes
-> Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm' Maybe SemanticTokenTypes
varTokenType = Term' BNFC'Position -> [SemanticTokenAbsolute]
go
  where
    go :: Term' BNFC'Position -> [SemanticTokenAbsolute]
go Term' BNFC'Position
term = case Term' BNFC'Position
term of
      Hole{} -> [] -- FIXME
      Var{} -> case Maybe SemanticTokenTypes
varTokenType of
                 Maybe SemanticTokenTypes
Nothing         -> []
                 Just SemanticTokenTypes
token_type -> forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
token_type []

      Universe{}           -> forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_Class [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
      UniverseCube{}       -> forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_Class [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
      UniverseTope{}       -> forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_Class [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]

      CubeUnit{}           -> forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_Enum [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
      CubeUnitStar{}       -> forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_EnumMember [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
      ASCII_CubeUnitStar{} -> forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_EnumMember [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]

      Cube2{}              -> forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_Enum [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
      Cube2_0{}            -> forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_EnumMember [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
      ASCII_Cube2_0{}      -> forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_EnumMember [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
      Cube2_1{}            -> forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_EnumMember [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
      ASCII_Cube2_1{}      -> forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_EnumMember [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]

      CubeProduct BNFC'Position
_loc Term' BNFC'Position
l Term' BNFC'Position
r -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
go [Term' BNFC'Position
l, Term' BNFC'Position
r]

      TopeTop{}            -> forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_String [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
      ASCII_TopeTop{}            -> forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_String [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
      TopeBottom{}         -> forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_String [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
      ASCII_TopeBottom{}         -> forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_String [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
      TopeAnd BNFC'Position
_loc Term' BNFC'Position
l Term' BNFC'Position
r     -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTope [Term' BNFC'Position
l, Term' BNFC'Position
r]
      ASCII_TopeAnd BNFC'Position
_loc Term' BNFC'Position
l Term' BNFC'Position
r     -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTope [Term' BNFC'Position
l, Term' BNFC'Position
r]
      TopeOr  BNFC'Position
_loc Term' BNFC'Position
l Term' BNFC'Position
r     -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTope [Term' BNFC'Position
l, Term' BNFC'Position
r]
      ASCII_TopeOr  BNFC'Position
_loc Term' BNFC'Position
l Term' BNFC'Position
r     -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTope [Term' BNFC'Position
l, Term' BNFC'Position
r]
      TopeEQ  BNFC'Position
_loc Term' BNFC'Position
l Term' BNFC'Position
r     -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTope [Term' BNFC'Position
l, Term' BNFC'Position
r]
      ASCII_TopeEQ  BNFC'Position
_loc Term' BNFC'Position
l Term' BNFC'Position
r     -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTope [Term' BNFC'Position
l, Term' BNFC'Position
r]
      TopeLEQ BNFC'Position
_loc Term' BNFC'Position
l Term' BNFC'Position
r     -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTope [Term' BNFC'Position
l, Term' BNFC'Position
r]
      ASCII_TopeLEQ BNFC'Position
_loc Term' BNFC'Position
l Term' BNFC'Position
r     -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTope [Term' BNFC'Position
l, Term' BNFC'Position
r]

      RecBottom{}          -> forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_Function [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
      RecOr BNFC'Position
_loc [Restriction' BNFC'Position]
rs -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Restriction' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeRestriction [Restriction' BNFC'Position]
rs

      TypeFun BNFC'Position
_loc ParamDecl' BNFC'Position
paramDecl Term' BNFC'Position
ret -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ ParamDecl' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeParamDecl ParamDecl' BNFC'Position
paramDecl
        , Term' BNFC'Position -> [SemanticTokenAbsolute]
go Term' BNFC'Position
ret ]
      ASCII_TypeFun BNFC'Position
_loc ParamDecl' BNFC'Position
paramDecl Term' BNFC'Position
ret -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ ParamDecl' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeParamDecl ParamDecl' BNFC'Position
paramDecl
        , Term' BNFC'Position -> [SemanticTokenAbsolute]
go Term' BNFC'Position
ret ]
      TypeSigma BNFC'Position
loc Pattern
pat Term' BNFC'Position
a Term' BNFC'Position
b -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken (forall a. a -> VarIdentToken -> VarIdent' a
VarIdent BNFC'Position
loc VarIdentToken
"∑") SemanticTokenTypes
SemanticTokenTypes_Class [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
        , Pattern -> [SemanticTokenAbsolute]
tokenizePattern Pattern
pat
        , forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
go [Term' BNFC'Position
a, Term' BNFC'Position
b] ]
      ASCII_TypeSigma BNFC'Position
loc Pattern
pat Term' BNFC'Position
a Term' BNFC'Position
b -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken (forall a. a -> VarIdentToken -> VarIdent' a
VarIdent BNFC'Position
loc VarIdentToken
"Sigma") SemanticTokenTypes
SemanticTokenTypes_Class [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
        , Pattern -> [SemanticTokenAbsolute]
tokenizePattern Pattern
pat
        , forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
go [Term' BNFC'Position
a, Term' BNFC'Position
b] ]
      TypeId BNFC'Position
_loc Term' BNFC'Position
x Term' BNFC'Position
a Term' BNFC'Position
y -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
go [Term' BNFC'Position
x, Term' BNFC'Position
a, Term' BNFC'Position
y]
      TypeIdSimple BNFC'Position
_loc Term' BNFC'Position
x Term' BNFC'Position
y -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
go [Term' BNFC'Position
x, Term' BNFC'Position
y]

      TypeRestricted BNFC'Position
_loc Term' BNFC'Position
type_ [Restriction' BNFC'Position]
rs -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ Term' BNFC'Position -> [SemanticTokenAbsolute]
go Term' BNFC'Position
type_
        , forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Restriction' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeRestriction [Restriction' BNFC'Position]
rs ]

      App BNFC'Position
_loc Term' BNFC'Position
f Term' BNFC'Position
x -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
go [Term' BNFC'Position
f, Term' BNFC'Position
x]
      Lambda BNFC'Position
_loc [Param' BNFC'Position]
params Term' BNFC'Position
body -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Param' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeParam [Param' BNFC'Position]
params
        , Term' BNFC'Position -> [SemanticTokenAbsolute]
go Term' BNFC'Position
body ]
      ASCII_Lambda BNFC'Position
loc [Param' BNFC'Position]
params Term' BNFC'Position
body -> Term' BNFC'Position -> [SemanticTokenAbsolute]
go (forall a. a -> [Param' a] -> Term' a -> Term' a
Lambda BNFC'Position
loc [Param' BNFC'Position]
params Term' BNFC'Position
body)

      Pair BNFC'Position
_loc Term' BNFC'Position
l Term' BNFC'Position
r -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
go [Term' BNFC'Position
l, Term' BNFC'Position
r]
      First BNFC'Position
loc Term' BNFC'Position
t -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken (forall a. a -> VarIdentToken -> VarIdent' a
VarIdent BNFC'Position
loc VarIdentToken
"π₁") SemanticTokenTypes
SemanticTokenTypes_Function [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
        , Term' BNFC'Position -> [SemanticTokenAbsolute]
go Term' BNFC'Position
t ]
      ASCII_First BNFC'Position
loc Term' BNFC'Position
t -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken (forall a. a -> VarIdentToken -> VarIdent' a
VarIdent BNFC'Position
loc VarIdentToken
"first") SemanticTokenTypes
SemanticTokenTypes_Function [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
        , Term' BNFC'Position -> [SemanticTokenAbsolute]
go Term' BNFC'Position
t ]
      Second BNFC'Position
loc Term' BNFC'Position
t -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken (forall a. a -> VarIdentToken -> VarIdent' a
VarIdent BNFC'Position
loc VarIdentToken
"π₂") SemanticTokenTypes
SemanticTokenTypes_Function [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
        , Term' BNFC'Position -> [SemanticTokenAbsolute]
go Term' BNFC'Position
t ]
      ASCII_Second BNFC'Position
loc Term' BNFC'Position
t -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken (forall a. a -> VarIdentToken -> VarIdent' a
VarIdent BNFC'Position
loc VarIdentToken
"second") SemanticTokenTypes
SemanticTokenTypes_Function [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
        , Term' BNFC'Position -> [SemanticTokenAbsolute]
go Term' BNFC'Position
t ]

      TypeUnit BNFC'Position
_loc -> forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_Enum [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
      Unit BNFC'Position
_loc -> forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_EnumMember [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]

      Refl{} -> forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_Function [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
      ReflTerm BNFC'Position
loc Term' BNFC'Position
x -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken (forall a. a -> VarIdentToken -> VarIdent' a
VarIdent BNFC'Position
loc VarIdentToken
"refl") SemanticTokenTypes
SemanticTokenTypes_Function [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
        , Term' BNFC'Position -> [SemanticTokenAbsolute]
go Term' BNFC'Position
x ]
      ReflTermType BNFC'Position
loc Term' BNFC'Position
x Term' BNFC'Position
a -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken (forall a. a -> VarIdentToken -> VarIdent' a
VarIdent BNFC'Position
loc VarIdentToken
"refl") SemanticTokenTypes
SemanticTokenTypes_Function [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
        , forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
go [Term' BNFC'Position
x, Term' BNFC'Position
a] ]

      IdJ BNFC'Position
loc Term' BNFC'Position
a Term' BNFC'Position
b Term' BNFC'Position
c Term' BNFC'Position
d Term' BNFC'Position
e Term' BNFC'Position
f -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken (forall a. a -> VarIdentToken -> VarIdent' a
VarIdent BNFC'Position
loc VarIdentToken
"J") SemanticTokenTypes
SemanticTokenTypes_Function [SemanticTokenModifiers
SemanticTokenModifiers_DefaultLibrary]
        , forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
go [Term' BNFC'Position
a, Term' BNFC'Position
b, Term' BNFC'Position
c, Term' BNFC'Position
d, Term' BNFC'Position
e, Term' BNFC'Position
f] ]

      TypeAsc BNFC'Position
_loc Term' BNFC'Position
t Term' BNFC'Position
type_ -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Term' BNFC'Position -> [SemanticTokenAbsolute]
go [Term' BNFC'Position
t, Term' BNFC'Position
type_]

      RecOrDeprecated{} -> forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_Regexp [SemanticTokenModifiers
SemanticTokenModifiers_Deprecated]
      TypeExtensionDeprecated{} -> forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_Regexp [SemanticTokenModifiers
SemanticTokenModifiers_Deprecated]
      ASCII_TypeExtensionDeprecated{} -> forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken Term' BNFC'Position
term SemanticTokenTypes
SemanticTokenTypes_Regexp [SemanticTokenModifiers
SemanticTokenModifiers_Deprecated]

tokenizeRestriction :: Restriction -> [SemanticTokenAbsolute]
tokenizeRestriction :: Restriction' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeRestriction (Restriction BNFC'Position
_loc Term' BNFC'Position
tope Term' BNFC'Position
term) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTope Term' BNFC'Position
tope
  , Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm Term' BNFC'Position
term ]
tokenizeRestriction (ASCII_Restriction BNFC'Position
_loc Term' BNFC'Position
tope Term' BNFC'Position
term) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTope Term' BNFC'Position
tope
  , Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm Term' BNFC'Position
term ]

tokenizeParamDecl :: ParamDecl -> [SemanticTokenAbsolute]
tokenizeParamDecl :: ParamDecl' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeParamDecl = \case
  ParamType BNFC'Position
_loc Term' BNFC'Position
type_ -> Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm Term' BNFC'Position
type_
  ParamTermType BNFC'Position
_loc Term' BNFC'Position
pat Term' BNFC'Position
type_ -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm Term' BNFC'Position
pat
    , Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm Term' BNFC'Position
type_ ]
  ParamTermShape BNFC'Position
_loc Term' BNFC'Position
pat Term' BNFC'Position
cube Term' BNFC'Position
tope -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm Term' BNFC'Position
pat
    , Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm Term' BNFC'Position
cube
    , Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTope Term' BNFC'Position
tope
    ]
  ParamTermTypeDeprecated BNFC'Position
_loc Pattern
pat Term' BNFC'Position
type_ -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ Pattern -> [SemanticTokenAbsolute]
tokenizePattern Pattern
pat
    , Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm Term' BNFC'Position
type_ ]
  ParamVarShapeDeprecated BNFC'Position
_loc Pattern
pat Term' BNFC'Position
cube Term' BNFC'Position
tope -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ Pattern -> [SemanticTokenAbsolute]
tokenizePattern Pattern
pat
    , Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTerm Term' BNFC'Position
cube
    , Term' BNFC'Position -> [SemanticTokenAbsolute]
tokenizeTope Term' BNFC'Position
tope
    ]

mkToken :: (HasPosition a, Print a) => a -> SemanticTokenTypes -> [SemanticTokenModifiers] -> [SemanticTokenAbsolute]
mkToken :: forall a.
(HasPosition a, Print a) =>
a
-> SemanticTokenTypes
-> [SemanticTokenModifiers]
-> [SemanticTokenAbsolute]
mkToken a
x SemanticTokenTypes
tokenType [SemanticTokenModifiers]
tokenModifiers =
  case forall a. HasPosition a => a -> BNFC'Position
hasPosition a
x of
    BNFC'Position
Nothing -> []
    Just (Int
line, Int
col) -> do
      [ SemanticTokenAbsolute
        { $sel:_tokenType:SemanticTokenAbsolute :: SemanticTokenTypes
_tokenType = SemanticTokenTypes
tokenType
        , $sel:_tokenModifiers:SemanticTokenAbsolute :: [SemanticTokenModifiers]
_tokenModifiers = [SemanticTokenModifiers]
tokenModifiers
        , $sel:_startChar:SemanticTokenAbsolute :: UInt
_startChar = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
col forall a. Num a => a -> a -> a
- UInt
1    -- NOTE: 0-indexed output for VS Code
        ,  $sel:_line:SemanticTokenAbsolute :: UInt
_line = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
line forall a. Num a => a -> a -> a
- UInt
1             -- NOTE: 0-indexed output for VS Code
        ,  $sel:_length:SemanticTokenAbsolute :: UInt
_length = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length (forall a. Print a => a -> String
printTree a
x)
        }
        ]