/-
Copyright (c) 2022 Mac Malone. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mac Malone
-/
import Lean.Data.Lsp.Capabilities

open Lean Lsp

namespace Alloy

structure EmptyObject deriving ToJson, FromJson
instance : EmptyCollection EmptyObject := ⟨.mk⟩

def Union := Sum

def Union.inl (a : α) : Union α β := Sum.inl a
def Union.inr (b : β) : Union α β := Sum.inr b

instance : Coe α (Union α β) := ⟨.inl⟩
instance : Coe β (Union α β) := ⟨.inr⟩

instance [ToJson α] [ToJson β] : ToJson (Union α β) where
  toJson | .inl a => toJson a | .inr b => toJson b

instance [FromJson α] [FromJson β] : FromJson (Union α β) where
  fromJson? v :=
    match fromJson? v with
    | .ok a => .ok <| .inl a
    | .error _ => .inr <$> fromJson? v

abbrev BUnion (α) := Union Bool α
abbrev BOption (α) := Option (BUnion α)

structure WorkDoneProgressOptions where
  workDoneProgress? : Option Bool := none

deriving instance DecidableEq for SymbolKind

instance : FromJson SymbolKind where
 fromJson? v := do
    let i : Nat ← fromJson? v
    return SymbolKind.ofNat (i-1)

deriving instance DecidableEq for SymbolTag

instance : FromJson SymbolTag where
  fromJson? v := return .ofNat ((← fromJson? v)-1)

inductive CompletionItemTag where
| deprecated
deriving Inhabited, DecidableEq, Repr

instance : ToJson CompletionItemTag where
  toJson a := toJson <| a.toCtorIdx + 1

instance : FromJson CompletionItemTag where
  fromJson? v := return .ofNat ((← fromJson? v)-1)

inductive InsertTextMode where
| asIs | adjustIndentation
deriving Inhabited, DecidableEq, Repr

instance : ToJson InsertTextMode where
  toJson a := toJson <| a.toCtorIdx + 1

instance : FromJson InsertTextMode where
  fromJson? v := return .ofNat ((← fromJson? v)-1)

inductive PrepareSupportDefaultBehavior  where
| identifier
deriving Inhabited, DecidableEq, Repr

instance : ToJson PrepareSupportDefaultBehavior where
  toJson a := toJson <| a.toCtorIdx + 1

instance : FromJson PrepareSupportDefaultBehavior where
  fromJson? v := return .ofNat ((← fromJson? v)-1)

inductive DiagnosticTag  where
| unnecessary | deprecated
deriving Inhabited, DecidableEq, Repr

instance : ToJson DiagnosticTag where
  toJson a := toJson <| a.toCtorIdx + 1

instance : FromJson DiagnosticTag where
  fromJson? v := return .ofNat ((← fromJson? v)-1)

deriving instance FromJson for FoldingRangeKind

---

inductive ResourceOperationKind
| create | rename | delete
deriving ToJson, FromJson

inductive FailureHandlingKind
| abort | transactional | undo | textOnlyTransactional
deriving ToJson, FromJson

structure ChangeAnnotationSupportClientCapabilities where
  groupsOnLabel? : Option Bool := none
  deriving ToJson, FromJson

structure WorkspaceEditClientCapabilities where
  documentChanges? : Option Bool := none
  resourceOperations? : Option (Array ResourceOperationKind) := none
  failureHandling? : Option FailureHandlingKind := none
  normalizeLineEndings? : Option Bool := none
  changeAnnotationSupport? : Option ChangeAnnotationSupportClientCapabilities := none
  deriving ToJson, FromJson

structure DidChangeConfigurationClientCapabilities where
  dynamicRegistration? : Option Bool := none
  deriving ToJson, FromJson

structure DidChangeWatchedFilesClientCapabilities where
  dynamicRegistration? : Option Bool := none
  relativePatternSupport? : Option Bool := none
  deriving ToJson, FromJson

structure SymbolKindCapabilities where
  valueSet? : Option (Array SymbolKind) := none
  deriving ToJson, FromJson

structure SymbolTagSupportCapabilities where
  valueSet : Array SymbolTag
  deriving ToJson, FromJson

structure ResolveSupportCapabilities where
  properties : Array String
  deriving ToJson, FromJson

structure WorkspaceSymbolClientCapabilities where
  dynamicRegistration? : Option Bool := none
  symbolKind? : Option SymbolKindCapabilities := none
  tagSupport? : Option SymbolTagSupportCapabilities := none
  resolveSupport? : Option ResolveSupportCapabilities := none
  deriving ToJson, FromJson

structure ExecuteCommandClientCapabilities extends WorkDoneProgressOptions where
  commands : Array String
  deriving ToJson, FromJson

structure SemanticTokensWorkspaceClientCapabilities where
  refreshSupport? : Option Bool := none
  deriving ToJson, FromJson

structure CodeLensWorkspaceClientCapabilities where
  refreshSupport? : Option Bool := none
  deriving ToJson, FromJson

structure FileOperationsCapabilities where
  dynamicRegistration? : Option Bool := none
  didCreate? : Option Bool := none
  willCreate? : Option Bool := none
  didRename? : Option Bool := none
  willRename? : Option Bool := none
  didDelete? : Option Bool := none
  willDelete? : Option Bool := none
  deriving ToJson, FromJson

structure InlineValueWorkspaceClientCapabilities where
  refreshSupport? : Option Bool := none
  deriving ToJson, FromJson

structure InlayHintWorkspaceClientCapabilities where
  refreshSupport? : Option Bool := none
  deriving ToJson, FromJson

structure DiagnosticWorkspaceClientCapabilities where
  refreshSupport? : Option Bool := none
  deriving ToJson, FromJson

structure WorkspaceClientCapabilities where
  applyEdit? : Option Bool := none
  workspaceEdit? : Option WorkspaceEditClientCapabilities := none
  didChangeConfiguration? : Option DidChangeConfigurationClientCapabilities := none
  didChangeWatchedFiles? : Option DidChangeWatchedFilesClientCapabilities := none
  symbol? : Option WorkspaceSymbolClientCapabilities := none
  executeCommand? : Option ExecuteCommandClientCapabilities := none
  workspaceFolders? : Option Bool := none
  configuration? : Option Bool := none
  semanticTokens? : Option SemanticTokensWorkspaceClientCapabilities := none
  codeLens? : Option CodeLensWorkspaceClientCapabilities := none
  fileOperations? : Option FileOperationsCapabilities := none
  inlineValue? : Option InlineValueWorkspaceClientCapabilities := none
  inlayHint? : Option InlayHintWorkspaceClientCapabilities := none
  diagnostics? : Option DiagnosticWorkspaceClientCapabilities := none
  deriving ToJson, FromJson

structure TextDocumentSyncClientCapabilities where
  dynamicRegistration? : Option Bool := none
  willSave? : Option Bool := none
  willSaveWaitUntil? : Option Bool := none
  didSave? : Option Bool := none
  deriving ToJson, FromJson

structure CompletionItemTagSupportCapabilities where
  valueSet : Array CompletionItemTag
  deriving ToJson, FromJson

structure InsertTextModeSupportCapabilities where
  valueSet : Array InsertTextMode
  deriving ToJson, FromJson

structure CompletionItemCapabilities where
  snippetSupport? : Option Bool := none
  commitCharactersSupport? : Option Bool := none
  documentationFormat? : Option (Array MarkupKind) := none
  deprecatedSupport? : Option Bool := none
  preselectSupport? : Option Bool := none
  tagSupport? : Option CompletionItemTagSupportCapabilities := none
  insertReplaceSupport? : Option Bool := none
  insertTextModeSupport? : Option InsertTextModeSupportCapabilities := none
  resolveSupport? : Option ResolveSupportCapabilities := none
  labelDetailsSupport? : Option Bool := none
  deriving ToJson, FromJson

structure CompletionItemKindCapabilities where
  valueSet? : Option (Array CompletionItemKind) := none
  deriving ToJson, FromJson

structure CompletionListCapabilities where
  itemDefaults? : Option (Array String) := none
  deriving ToJson, FromJson

structure CompletionClientCapabilities where
  dynamicRegistration? : Option Bool := none
  completionItem? : Option CompletionItemCapabilities := none
  completionItemKind? : Option CompletionItemKindCapabilities := none
  contextSupport? : Option Bool := none
  insertTextMode? : Option InsertTextMode := none
  completionList? : Option CompletionListCapabilities := none
  deriving ToJson, FromJson

structure HoverClientCapabilities where
  dynamicRegistration? : Option Bool := none
  contentFormat? : Option (Array MarkupKind) := none
  deriving ToJson, FromJson

structure ParameterInformationCapabilities where
  labelOffsetSupport? : Option Bool := none
  deriving ToJson, FromJson

structure SignatureInformationCapabilities where
  documentationFormat? : Option (Array MarkupKind) := none
  parameterInformation? : Option ParameterInformationCapabilities := none
  activeParameterSupport : Option Bool := none
  deriving ToJson, FromJson

structure SignatureHelpClientCapabilities where
  dynamicRegistration? : Option Bool := none
  signatureInformation? : Option SignatureInformationCapabilities := none
  contentSupport? : Option Bool := none
  deriving ToJson, FromJson

structure DeclarationClientCapabilities where
  dynamicRegistration? : Option Bool := none
  linkSupport? : Option Bool := none
  deriving ToJson, FromJson

structure DefinitionClientCapabilities where
  dynamicRegistration? : Option Bool := none
  linkSupport? : Option Bool := none
  deriving ToJson, FromJson

structure TypeDefinitionClientCapabilities where
  dynamicRegistration? : Option Bool := none
  linkSupport? : Option Bool := none
  deriving ToJson, FromJson

structure ImplementationClientCapabilities where
  dynamicRegistration? : Option Bool := none
  linkSupport? : Option Bool := none
  deriving ToJson, FromJson

structure ReferenceClientCapabilities where
  dynamicRegistration? : Option Bool := none
  deriving ToJson, FromJson

structure DocumentHighlightClientCapabilities where
  dynamicRegistration? : Option Bool := none
  deriving ToJson, FromJson

structure DocumentSymbolClientCapabilities where
  dynamicRegistration? : Option Bool := none
  symbolKind? : Option SymbolKindCapabilities := none
  hierarchicalDocumentSymbolSupport? : Option Bool := none
  tagSupport? : Option SymbolTagSupportCapabilities := none
  labelSupport? : Option Bool := none
  deriving ToJson, FromJson

def CodeActionKind := Name

namespace CodeActionKind

def empty := Name.anonymous
def quickfix := `quickfix
def refactor := `refactor
def refactorExtract := `refactor.extract
def refactorInline := `refactor.inline
def refactorRewrite := `refactor.inline
def source := `refactor.inline
def sourceOrganizeImports := `source.organizeImports
def sourceFixAll := `source.fixAll

instance : ToJson CodeActionKind where
  toJson a := if a.isAnonymous then "" else a.toString false

instance : FromJson CodeActionKind where
  fromJson? v := v.getStr? <&> fun v => if v.isEmpty then empty else v.toName

end CodeActionKind

structure CodeActionKindCapabilities where
  valueSet : Array CodeActionKind
  deriving ToJson, FromJson

structure CodeActionLiteralSupportCapabilities where
  codeActionKind : CodeActionKindCapabilities
  deriving ToJson, FromJson

structure CodeActionClientCapabilities where
  dynamicRegistration? : Option Bool := none
  codeActionLiteralSupport? : Option CodeActionLiteralSupportCapabilities := none
  isPreferredSupport? : Option Bool := none
  disabledSupport? : Option Bool := none
  dataSupport? : Option Bool := none
  resolveSupport? : Option ResolveSupportCapabilities := none
  honorsChangeAnnotations? : Option Bool := none
  deriving ToJson, FromJson

structure CodeLensClientCapabilities where
  dynamicRegistration? : Option Bool := none
  deriving ToJson, FromJson

structure DocumentLinkClientCapabilities where
  dynamicRegistration? : Option Bool := none
  tooltipSupport? : Option Bool := none
  deriving ToJson, FromJson

structure DocumentColorClientCapabilities where
  dynamicRegistration? : Option Bool := none
  deriving ToJson, FromJson

structure DocumentFormattingClientCapabilities where
  dynamicRegistration? : Option Bool := none
  deriving ToJson, FromJson

structure DocumentRangeFormattingClientCapabilities where
  dynamicRegistration? : Option Bool := none
  deriving ToJson, FromJson

structure DocumentOnTypeFormattingClientCapabilities where
  dynamicRegistration? : Option Bool := none
  deriving ToJson, FromJson

structure RenameClientCapabilities where
  dynamicRegistration? : Option Bool := none
  prepareSupport? : Option Bool := none
  prepareSupportDefaultBehavior? : Option PrepareSupportDefaultBehavior := none
  honorsChangeAnnotations? : Option Bool := none
  deriving ToJson, FromJson

structure DiagnosticTagSupportCapabilities where
  valueSet : Array DiagnosticTag
  deriving ToJson, FromJson

structure PublishDiagnosticsClientCapabilities where
  relatedInformation? : Option Bool := none
  tagSupport? : Option DiagnosticTagSupportCapabilities := none
  versionSupport? : Option PrepareSupportDefaultBehavior := none
  codeDescriptionSupport? : Option Bool := none
  dataSupport? : Option Bool := none
  deriving ToJson, FromJson

structure FoldingRangeKindCapabilities where
  valueSet? : Option (Array FoldingRangeKind) := none
  deriving ToJson, FromJson

structure FoldingRangeCapabilities where
  collapsedText? : Option Bool := none
  deriving ToJson, FromJson

structure FoldingRangeClientCapabilities where
  dynamicRegistration? : Option Bool := none
  rangeLimit? : Option Nat := none
  lineFoldingOnly? : Option Bool := none
  foldingRangeKind? : Option FoldingRangeKindCapabilities := none
  foldingRange? : Option FoldingRangeCapabilities := none
  deriving ToJson, FromJson

structure SelectionRangeClientCapabilities where
  dynamicRegistration? : Option Bool := none
  deriving ToJson, FromJson

structure LinkedEditingRangeClientCapabilities where
  dynamicRegistration? : Option Bool := none
  deriving ToJson, FromJson

structure CallHierarchyClientCapabilities where
  dynamicRegistration? : Option Bool := none
  deriving ToJson, FromJson

structure SemanticTokensFullCapabilities where
  delta? : Option Bool := none
  deriving ToJson, FromJson

structure SemanticTokensRequestsCapabilities where
  range? : BOption EmptyObject := none
  full? : BOption SemanticTokensFullCapabilities := none
  deriving ToJson, FromJson

inductive TokenFormat
| relative
deriving ToJson, FromJson

structure SemanticTokensClientCapabilities where
  dynamicRegistration? : Option Bool := none
  requests : SemanticTokensRequestsCapabilities
  tokenTypes : Array String
  tokenModifiers : Array String
  formats : Array TokenFormat
  overlappingTokenSupport? : Option Bool := none
  multilineTokenSupport? : Option Bool := none
  serverCancelSupport? : Option Bool := none
  augmentsSyntaxTokens : Option Bool := none
  deriving ToJson, FromJson

structure MonikerClientCapabilities where
  dynamicRegistration? : Option Bool := none
  deriving ToJson, FromJson

structure TypeHierarchyClientCapabilities where
  dynamicRegistration? : Option Bool := none
  deriving ToJson, FromJson

structure InlineValueClientCapabilities where
  dynamicRegistration? : Option Bool := none
  deriving ToJson, FromJson

structure InlayHintClientCapabilities where
  dynamicRegistration? : Option Bool := none
  resolveSupport? : Option ResolveSupportCapabilities := none
  deriving ToJson, FromJson

structure DiagnosticClientCapabilities where
  dynamicRegistration? : Option Bool := none
  relatedDocumentSupport? : Option Bool := none
  deriving ToJson, FromJson

structure TextDocumentClientCapabilities where
  synchronization? : Option TextDocumentSyncClientCapabilities := none
  completion? : Option CompletionClientCapabilities := none
  hover? : Option HoverClientCapabilities := none
  signatureHelp? : Option SignatureHelpClientCapabilities := none
  declaration? : Option DeclarationClientCapabilities := none
  definition? : Option DefinitionClientCapabilities := none
  typeDefinition? : Option TypeDefinitionClientCapabilities := none
  implementation? : Option ImplementationClientCapabilities := none
  references? : Option ReferenceClientCapabilities := none
  documentHighlight? : Option DocumentHighlightClientCapabilities := none
  documentSymbol? : Option DocumentSymbolClientCapabilities := none
  codeAction? : Option CodeActionClientCapabilities := none
  codeLens? : Option CodeLensClientCapabilities := none
  documentLink? : Option DocumentLinkClientCapabilities := none
  colorProvider? : Option DocumentColorClientCapabilities := none
  formatting? : Option DocumentFormattingClientCapabilities := none
  rangeFormatting? : Option DocumentRangeFormattingClientCapabilities := none
  onTypeFormatting? : Option DocumentOnTypeFormattingClientCapabilities := none
  rename? : Option RenameClientCapabilities := none
  publishDiagnostics? : Option PublishDiagnosticsClientCapabilities := none
  foldingRange? : Option FoldingRangeClientCapabilities := none
  selectionRange? : Option SelectionRangeClientCapabilities := none
  linkedEditingRange? : Option LinkedEditingRangeClientCapabilities := none
  callHierarchy? : Option CallHierarchyClientCapabilities := none
  semanticTokens? : Option SemanticTokensClientCapabilities := none
  moniker? : Option MonikerClientCapabilities := none
  typeHierarchy? : Option TypeHierarchyClientCapabilities := none
  inlineValue? : Option InlineValueClientCapabilities := none
  inlayHint? : Option InlayHintClientCapabilities := none
  diagnostic? : Option DiagnosticClientCapabilities := none
  deriving ToJson, FromJson

structure NotebookDocumentSyncClientCapabilities where
  dynamicRegistration? : Option Bool := none
  executionSummarySupport? : Option Bool := none
  deriving ToJson, FromJson

structure NotebookDocumentClientCapabilities where
  synchronization : NotebookDocumentSyncClientCapabilities
  deriving ToJson, FromJson

structure MessageActionItemCapabilities where
  additionalPropertiesSupport? : Option Bool := none
  deriving ToJson, FromJson

structure ShowMessageRequestClientCapabilities where
  messageActionItem? : Option MessageActionItemCapabilities := none
  deriving ToJson, FromJson

structure WindowClientCapabilities where
  workDoneProgress? : Option Bool := none
  showMessage? : Option ShowMessageRequestClientCapabilities := none
  showDocument? : Option ShowDocumentClientCapabilities := none
  deriving ToJson, FromJson

structure StaleRequestSupportCapabilities where
  cancel : Bool
  retryOnContentModified : Array String
  deriving ToJson, FromJson

structure RegularExpressionsClientCapabilities where
  engine : String
  version? : Option String := none
  deriving ToJson, FromJson

structure MarkdownClientCapabilities where
  parser : String
  version? : Option String := none
  allowedTags? : Option (Array String) := none
  deriving ToJson, FromJson

abbrev PositionEncodingKind := String
namespace PositionEncodingKind
def utf8 := "utf-8"
def utf16 := "utf-16"
def utf32 := "utf-32"
end PositionEncodingKind

structure GeneralClientCapabilities where
  staleRequestSupport? : Option StaleRequestSupportCapabilities := none
  regularExpressions? : Option RegularExpressionsClientCapabilities := none
  markdown? : Option MarkdownClientCapabilities := none
  positionEncodings? : Option (Array PositionEncodingKind) := none
  deriving ToJson, FromJson

structure ClientCapabilities (Experimental := Json) where
  workspace? : Option WorkspaceClientCapabilities := none
  textDocument? : Option TextDocumentClientCapabilities := none
  notebookDocument? : Option NotebookDocumentClientCapabilities := none
  window? : Option WindowClientCapabilities := none
  general? : Option GeneralClientCapabilities := none
  experimental? : Option Experimental := none
  deriving Inhabited, ToJson, FromJson

instance [ToJson Exp] : Coe (ClientCapabilities Exp) ClientCapabilities where
  coe caps := {caps with experimental? := caps.experimental?.map toJson}

---

structure TextDocumentSyncOptions where
  openClose? : Option Bool := none
  change? : Option TextDocumentSyncKind := none
  deriving ToJson, FromJson

/--
Permits parsing a `TextDocumentSyncOptions`
from a plain `TextDocumentSyncKind` (i.e., a number).
-/
instance : FromJson TextDocumentSyncOptions where
  fromJson? v := try return {change? := some <| ← fromJson? v} catch _ => fromJson? v

structure StaticRegistrationOptions where
  id? : Option String := none

structure TextDocumentRegistrationOptions where
  documentSelector : Option DocumentSelector := none

abbrev NotebookDocumentSyncRegistrationOptions := Json
abbrev CompletionOptions := Json
abbrev HoverOptions := Json
abbrev SignatureHelpOptions := Json
abbrev DeclarationRegistrationOptions := Json
abbrev DefinitionOptions := Json
abbrev TypeDefinitionRegistrationOptions := Json
abbrev ImplementationRegistrationOptions := Json
abbrev ReferenceOptions := Json
abbrev DocumentHighlightOptions := Json
abbrev DocumentSymbolOptions := Json
abbrev CodeActionOptions := Json
abbrev CodeLensOptions := Json
abbrev DocumentLinkOptions := Json
abbrev DocumentColorRegistrationOptions := Json
abbrev DocumentFormattingOptions := Json
abbrev DocumentRangeFormattingOptions := Json
abbrev DocumentOnTypeFormattingOptions := Json
abbrev RenameOptions := Json
abbrev FoldingRangeRegistrationOptions := Json
abbrev ExecuteCommandOptions := Json
abbrev SelectionRangeRegistrationOptions := Json
abbrev LinkedEditingRangeRegistrationOption := Json
abbrev CallHierarchyRegistrationOptions := Json

example : ToJson (BOption EmptyObject) := inferInstance
example : ToJson (BOption SemanticTokensFullCapabilities) := inferInstance

structure SemanticTokensOptions extends WorkDoneProgressOptions where
  legend : SemanticTokensLegend
  range? : BOption EmptyObject := none
  full? : BOption SemanticTokensFullCapabilities := none
  deriving ToJson, FromJson

structure SemanticTokensRegistrationOptions extends
  SemanticTokensOptions, TextDocumentRegistrationOptions, StaticRegistrationOptions
  deriving ToJson, FromJson

abbrev MonikerRegistrationOptions := Json
abbrev TypeHierarchyRegistrationOptions := Json
abbrev InlineValueRegistrationOptions := Json
abbrev InlayHintRegistrationOptions := Json
abbrev DiagnosticRegistrationOptions := Json
abbrev WorkspaceSymbolOptions := Json
abbrev WorkspaceServerCapabilities := Json

structure ServerCapabilities (Experimental := Json) where
  positionEncoding? : Option PositionEncodingKind := none
  textDocumentSync? : Option TextDocumentSyncOptions := none
  notebookDocumentSync? : Option NotebookDocumentSyncRegistrationOptions := none
  completionProvider? : Option CompletionOptions := none
  hoverProvider? : BOption HoverOptions := none
  signatureHelpProvider? : Option SignatureHelpOptions := none
  declarationProvider? : BOption DeclarationRegistrationOptions := none
  definitionProvider? : BOption DefinitionOptions := none
  typeDefinitionProvider? : BOption TypeDefinitionRegistrationOptions := none
  implementationProvider? : BOption ImplementationRegistrationOptions := none
  referencesProvider? : BOption ReferenceOptions := none
  documentHighlightProvider? : BOption DocumentHighlightOptions := none
  documentSymbolProvider? : BOption DocumentSymbolOptions := none
  codeActionProvider? : BOption CodeActionOptions := none
  codeLensProvider? : Option CodeLensOptions := none
  documentLinkProver? : Option DocumentLinkOptions := none
  colorProvider? : BOption DocumentColorRegistrationOptions := none
  documentFormattingProvider? : BOption DocumentFormattingOptions := none
  documentRangeFormattingProvider? : BOption DocumentRangeFormattingOptions := none
  documentOnTypeFormattingProvider? : Option DocumentOnTypeFormattingOptions := none
  renameProvider? : BOption RenameOptions := none
  foldingRangeProvider? : BOption FoldingRangeRegistrationOptions := none
  executeCommandProvider? : Option ExecuteCommandOptions := none
  selectionRangeProvider? : BOption SelectionRangeRegistrationOptions := none
  linkedEditingRangeProvider? : BOption LinkedEditingRangeRegistrationOption := none
  callHierarchyProvider? : BOption CallHierarchyRegistrationOptions := none
  semanticTokensProvider? : Option SemanticTokensRegistrationOptions := none
  monikerProvider? : BOption MonikerRegistrationOptions := none
  typeHierarchyProvider? : BOption TypeHierarchyRegistrationOptions := none
  inlineValueProvider? : BOption InlineValueRegistrationOptions := none
  inlayHintProvider? : BOption InlayHintRegistrationOptions := none
  diagnosticProvider? : Option DiagnosticRegistrationOptions := none
  workspaceSymbolProvider? : BOption WorkspaceSymbolOptions := none
  workspace? : Option WorkspaceServerCapabilities := none
  experimental? : Option Experimental := none
  deriving Inhabited, ToJson, FromJson

instance [ToJson Exp] : Coe (ServerCapabilities Exp) ServerCapabilities where
  coe caps := {caps with experimental? := caps.experimental?.map toJson}


import init.Lean.Message init.Lean.Parser.Syntax init.Lean.Parser.Trie init.Lean.Parser.basic
import init.Lean.Parser.token

namespace Lean
namespace flatParser
open String
open Parser (Syntax Syntax.missing Syntax.atom Syntax.ident Syntax.rawNode number stringLit)
open Parser (Trie TokenMap)
def maxPrec : Nat := 1024

abbrev pos := String.utf8Pos

/-- A precomputed cache for quickly mapping Char offsets to positions. -/
structure FileMap :=
(offsets : Array Nat)
(lines   : Array Nat)

namespace FileMap
private def fromStringAux (s : String) : Nat → Nat → Nat → pos → Array Nat → Array Nat → FileMap
| 0     offset line i offsets lines := ⟨offsets.push offset, lines.push line⟩
| (k+1) offset line i offsets lines :=
  if s.utf8AtEnd i then ⟨offsets.push offset, lines.push line⟩
  else let c := s.utf8Get i in
       let i := s.utf8Next i in
       let offset := offset + 1 in
       if c = '\n'
       then fromStringAux k offset (line+1) i (offsets.push offset) (lines.push (line+1))
       else fromStringAux k offset line i offsets lines

def fromString (s : String) : FileMap :=
fromStringAux s s.length 0 1 0 (Array.nil.push 0) (Array.nil.push 1)

/- Remark: `offset is in [(offsets.get b), (offsets.get e)]` and `b < e` -/
private def toPositionAux (offsets : Array Nat) (lines : Array Nat) (offset : Nat) : Nat → Nat → Nat → Position
| 0     b e := ⟨offset, 1⟩ -- unreachable
| (k+1) b e :=
  let offsetB := offsets.read' b in
  if e = b + 1 then ⟨offset - offsetB, lines.read' b⟩
  else let m := (b + e) / 2 in
       let offsetM := offsets.read' m in
       if offset = offsetM then ⟨0, lines.read' m⟩
       else if offset > offsetM then toPositionAux k m e
       else toPositionAux k b m

def toPosition : FileMap → Nat → Position
| ⟨offsets, lines⟩ offset := toPositionAux offsets lines offset offsets.size 0 (offsets.size-1)
end FileMap

structure TokenConfig :=
(«prefix» : String)
(lbp : Nat := 0)

structure FrontendConfig :=
(filename : String)
(input    : String)
(FileMap : FileMap)

/- Remark: if we have a Node in the Trie with `some TokenConfig`, the String induced by the path is equal to the `TokenConfig.prefix`. -/
structure ParserConfig extends FrontendConfig :=
(tokens      : Trie TokenConfig)

-- Backtrackable State
structure ParserState :=
(messages : MessageLog)

structure TokenCacheEntry :=
(startPos stopPos : pos)
(tk : Syntax)

-- Non-backtrackable State
structure ParserCache :=
(tokenCache : Option TokenCacheEntry := none)

inductive Result (α : Type)
| ok       (a : α)        (i : pos) (cache : ParserCache) (State : ParserState) (eps : Bool) : Result
| error {} (msg : String) (i : pos) (cache : ParserCache) (stx : Syntax)         (eps : Bool) : Result

inductive Result.IsOk {α : Type} : Result α → Prop
| mk (a : α) (i : pos) (cache : ParserCache) (State : ParserState) (eps : Bool) : Result.IsOk (Result.ok a i cache State eps)

theorem errorIsNotOk {α : Type} {msg : String} {i : pos} {cache : ParserCache} {stx : Syntax} {eps : Bool}
                        (h : Result.IsOk (@Result.error α msg i cache stx eps)) : False :=
match h with end

@[inline] def unreachableError {α β : Type} {msg : String} {i : pos} {cache : ParserCache} {stx : Syntax} {eps : Bool}
                                (h : Result.IsOk (@Result.error α msg i cache stx eps)) : β :=
False.elim (errorIsNotOk h)

def resultOk := {r : Result Unit // r.IsOk}

@[inline] def mkResultOk (i : pos) (cache : ParserCache) (State : ParserState) (eps := tt) : resultOk :=
⟨Result.ok () i cache State eps, Result.IsOk.mk _ _ _ _ _⟩

def mkError {α : Type} (r : resultOk) (msg : String) (stx : Syntax := Syntax.missing) (eps := tt) : Result α :=
match r with
| ⟨Result.ok _ i c s _, _⟩    := Result.error msg i c stx eps
| ⟨Result.error _ _ _ _ _, h⟩ := unreachableError h

def parserCoreM (α : Type) :=
resultOk → Result α
abbrev parserCore := parserCoreM Syntax

@[inline] def parserCoreM.pure {α : Type} (a : α) : parserCoreM α :=
λ r,
  match r with
  | ⟨Result.ok _ it c s _, h⟩   := Result.ok a it c s tt
  | ⟨Result.error _ _ _ _ _, h⟩ := unreachableError h

@[inline_if_reduce] def strictOr  (b₁ b₂ : Bool) := b₁ || b₂
@[inline_if_reduce] def strictAnd (b₁ b₂ : Bool) := b₁ && b₂

@[inline] def parserCoreM.bind {α β : Type} (x : parserCoreM α) (f : α → parserCoreM β) : parserCoreM β :=
λ r,
  match x r with
  | Result.ok a i c s e₁ :=
    (match f a (mkResultOk i c s) with
     | Result.ok b i c s e₂        := Result.ok b i c s (strictAnd e₁ e₂)
     | Result.error msg i c stx e₂ := Result.error msg i c stx (strictAnd e₁ e₂))
  | Result.error msg i c stx e  := Result.error msg i c stx e

instance : Monad parserCoreM :=
{bind := @parserCoreM.bind, pure := @parserCoreM.pure}

instance : Inhabited parserCore :=
⟨λ r, mkError r "error"⟩

@[inline] def parserCoreM.error {α : Type} (msg : String) : parserCoreM α :=
λ r, mkError r msg

@[inline] def error {α : Type} {m : Type → Type} [HasMonadLiftT parserCoreM m] (msg : String) : m α :=
monadLift $ parserCoreM.error msg

abbrev BasicParserM : Type → Type              := ReaderT ParserConfig parserCoreM
abbrev basicParser : Type                       := BasicParserM Syntax
abbrev CommandParserM (ρ : Type) : Type → Type := ReaderT ρ (ReaderT parserCore parserCoreM)
abbrev TermParserM : Type → Type               := ReaderT (Nat → parserCore) (CommandParserM ParserConfig)
abbrev termParser : Type                        := TermParserM Syntax
abbrev trailingTermParser : Type               := Syntax → termParser

structure CommandParserConfig extends ParserConfig :=
(leadingTermParsers  : TokenMap termParser)
(trailingTermParsers : TokenMap trailingTermParser)

abbrev commandParser : Type      := CommandParserM CommandParserConfig Syntax
abbrev commandParserCore : Type := CommandParserM ParserConfig Syntax

@[inline] def termParserOfBasicParser {α : Type} (p : BasicParserM α) : TermParserM α :=
λ _ cfg _, p cfg

@[inline] def commandParserOfBasicParser {α : Type} (p : BasicParserM α) : CommandParserM CommandParserConfig α :=
λ cfg _, p cfg.toParserConfig

instance basic2termP    : HasMonadLift BasicParserM TermParserM                            := ⟨@termParserOfBasicParser⟩
instance basic2commandP : HasMonadLift BasicParserM (CommandParserM CommandParserConfig) := ⟨@commandParserOfBasicParser⟩

@[inline] def Term.Parser (rbp := 0) : termParser := λ p _ _, p rbp
@[inline] def command.Parser : commandParser      := λ _ p, p

@[inline] def readCfg : TermParserM ParserConfig :=
λ _ cfg _, pure cfg

def peekToken : BasicParserM Syntax :=
error "TODO"

def currLbp : TermParserM Nat :=
do tk ← monadLift peekToken,
   match tk with
   | Syntax.atom ⟨_, sym⟩ := do
     cfg ← readCfg,
     (match cfg.tokens.matchPrefix sym.mkIterator with
      | some ⟨_, tkCfg⟩ := pure tkCfg.lbp
      | _                := error "currLbp: unreachable")
   | Syntax.rawNode {kind := @number, ..}     := pure maxPrec
   | Syntax.rawNode {kind := @stringLit, ..} := pure maxPrec
   | Syntax.ident _                            := pure maxPrec
   | _                                         := error "currLbp: unknown token kind"

#exit

   match tk with
   | Syntax.atom ⟨_, sym⟩ := do
     cfg ← read,
     -- some ⟨_, tkCfg⟩ ← pure (cfg.tokens.matchPrefix sym.mkIterator) | error "currLbp: unreachable",
     pure 0
   | Syntax.ident _ := pure maxPrec
   | Syntax.rawNode {kind := @number, ..} := pure maxPrec
   | Syntax.rawNode {kind := @stringLit, ..} := pure maxPrec
   | _ := error "currLbp: unknown token kind"

private def trailing (cfg : CommandParserConfig) : trailingTermParser :=
λ _ p _ _ r, p 0 r -- TODO(Leo)

private def leading (cfg : CommandParserConfig) : termParser :=
λ p _ _ r, p 0 r -- TODO(Leo)

def dummy : Nat → parserCore :=
λ _ r, mkError r "dummy"

def pratt (leadingP : termParser) (trailingP : trailingTermParser) (p : termParser) : commandParserCore :=
p dummy

def commandParserOfTermParser (p : termParser) : commandParser :=
λ cfg rec r,
  let leadingP  : termParser          := leading cfg in
  let trailingP : trailingTermParser := trailing cfg in
  let cfg        : ParserConfig        := cfg.toParserConfig in
  let p          : commandParserCore  := pratt leadingP trailingP p in
  p cfg rec r

#exit

def prattParser (cfg : CommandParserConfig) : termParser :=
leading

@[inline] def toParserCore (termP : Nat → Parser) (cmdP : parserCore) : Nat → parserCore :=
fix (λ recF rbp cfg r, termP rbp cmdP recF cfg r)

@[inline] def Parser.run (x : Parser) (termP : Nat → Parser) (cmdP : parserCore) : parserCore :=
x cmdP (toParserCore termP cmdP)

-- STOPPED HERE
#exit

def parserCore.run (cmdP : parserCore) (termP : parserCore) : parserCore :=

def aux (f : Nat → parserCore) : Nat → parserCore

structure CommandParserConfig extends recParserConfig :=
(leadingTermParsers  : TokenMap Parser)
(trailingTermParsers : TokenMap trailingParser)

abbrev CommandParserM (α : Type) : Type := parserCoreM CommandParserConfig α
abbrev commandParser := CommandParserM Syntax

#exit
-- abbrev

-- def parserM (α : Type) := recParsers → parserCoreM α
abbreviation Parser := parserM Syntax
abbreviation trailingParser := Syntax → Parser

@[inline] def command.Parser : Parser := λ cfg, cfg.cmdParser cfg

@[inline] def Term.Parser (rbp : Nat := 0) : Parser  := λ ps, ps.termParser rbp

instance : Monad parserM :=
{pure := @parserM.pure, bind := @parserM.bind}

@[inline] protected def orelse {α : Type} (p q : parserM α) : parserM α :=
λ ps cfg r,
  match r with
  | ⟨Result.ok _ i₁ _ s₁ _, _⟩ :=
    (match p ps cfg r with
     | Result.error msg₁ i₂ c₂ stx₁ tt := q ps cfg (mkResultOk i₁ c₂ s₁)
     | other                           := other)
  | ⟨Result.error _ _ _ _ _, h⟩ := unreachableError h

@[inline] protected def failure {α : Type} : parserM α :=
λ _ _ r,
  match r with
  | ⟨Result.ok _ i c s _, h⟩    := Result.error "failure" i c Syntax.missing tt
  | ⟨Result.error _ _ _ _ _, h⟩ := unreachableError h

instance : Alternative parserM :=
{ orelse         := @flatParser.orelse,
  failure        := @flatParser.failure,
  ..flatParser.Monad }

def setSilentError {α : Type} : Result α → Result α
| (Result.error i c msg stx _) := Result.error i c msg stx tt
| other                        := other

/--
`try p` behaves like `p`, but it pretends `p` hasn't
consumed any input when `p` fails.
-/
@[inline] def try {α : Type} (p : parserM α) : parserM α :=
λ ps cfg r, setSilentError (p ps cfg r)

@[inline] def atEnd (cfg : ParserConfig) (i : pos) : Bool :=
cfg.input.utf8AtEnd i

@[inline] def curr (cfg : ParserConfig) (i : pos) : Char :=
cfg.input.utf8Get i

@[inline] def next (cfg : ParserConfig) (i : pos) : pos :=
cfg.input.utf8Next i

@[inline] def inputSize (cfg : ParserConfig) : Nat :=
cfg.input.length

@[inline] def currPos : resultOk → pos
| ⟨Result.ok _ i _ _ _, _⟩    := i
| ⟨Result.error _ _ _ _ _, h⟩ := unreachableError h

@[inline] def currState : resultOk → ParserState
| ⟨Result.ok _ _ _ s _, _⟩    := s
| ⟨Result.error _ _ _ _ _, h⟩ := unreachableError h

@[inline] def satisfy (p : Char → Bool) : parserM Char :=
λ _ cfg r,
  match r with
  | ⟨Result.ok _ i ch st e, _⟩ :=
    if atEnd cfg i then mkError r "end of input"
    else let c := curr cfg i in
         if p c then Result.ok c (next cfg i) ch st ff
         else mkError r "unexpected character"
  | ⟨Result.error _ _ _ _ _, h⟩ := unreachableError h

def any : parserM Char :=
satisfy (λ _, tt)

@[specialize] def takeUntilAux (p : Char → Bool) (cfg : ParserConfig) : Nat → resultOk → Result Unit
| 0     r := r.val
| (n+1) r :=
  match r with
  | ⟨Result.ok _ i ch st e, _⟩ :=
    if atEnd cfg i then r.val
    else let c := curr cfg i in
         if p c then r.val
         else takeUntilAux n (mkResultOk (next cfg i) ch st tt)
  | ⟨Result.error _ _ _ _ _, h⟩ := unreachableError h

@[specialize] def takeUntil (p : Char → Bool) : parserM Unit :=
λ ps cfg r, takeUntilAux p cfg (inputSize cfg) r

def takeUntilNewLine : parserM Unit :=
takeUntil (= '\n')

def whitespace : parserM Unit :=
takeUntil (λ c, !c.isWhitespace)

-- setOption Trace.Compiler.boxed True
--- setOption pp.implicit True

def strAux (cfg : ParserConfig) (str : String) (error : String) : Nat → resultOk → pos → Result Unit
| 0     r j := mkError r error
| (n+1) r j :=
  if str.utf8AtEnd j then r.val
  else
    match r with
    | ⟨Result.ok _ i ch st e, _⟩ :=
      if atEnd cfg i then Result.error error i ch Syntax.missing tt
      else if curr cfg i = str.utf8Get j then strAux n (mkResultOk (next cfg i) ch st tt) (str.utf8Next j)
      else Result.error error i ch Syntax.missing tt
    | ⟨Result.error _ _ _ _ _, h⟩ := unreachableError h

-- #exit

@[inline] def str (s : String) : parserM Unit :=
λ ps cfg r, strAux cfg s ("expected " ++ repr s) (inputSize cfg) r 0

@[specialize] def manyAux (p : parserM Unit) : Nat → Bool → parserM Unit
| 0     fst := pure ()
| (k+1) fst := λ ps cfg r,
  let i₀ := currPos r in
  let s₀ := currState r in
  match p ps cfg r with
  | Result.ok a i c s _    := manyAux k ff ps cfg (mkResultOk i c s)
  | Result.error _ _ c _ _ := Result.ok () i₀ c s₀ fst

@[inline] def many (p : parserM Unit) : parserM Unit  :=
λ ps cfg r, manyAux p (inputSize cfg) tt ps cfg r

@[inline] def many1 (p : parserM Unit) : parserM Unit  :=
p *> many p

def dummyParserCore : parserCore :=
λ cfg r, mkError r "dummy"

def testParser {α : Type} (x : parserM α) (input : String) : String :=
let r :=
  x { cmdParser := dummyParserCore, termParser := λ _, dummyParserCore }
    { filename := "test", input := input, FileMap := FileMap.fromString input, tokens := Lean.Parser.Trie.mk }
    (mkResultOk 0 {} {messages := MessageLog.Empty}) in
match r with
| Result.ok _ i _ _ _      := "Ok at " ++ toString i
| Result.error msg i _ _ _ := "Error at " ++ toString i ++ ": " ++ msg

/-
mutual def recCmd, recTerm (parseCmd : Parser) (parseTerm : Nat → Parser) (parseLvl : Nat → parserCore)
with recCmd  : Nat → parserCore
| 0     cfg r := mkError r "Parser: no progress"
| (n+1) cfg r := parseCmd ⟨recCmd n, parseLvl, recTerm n⟩ cfg r
with recTerm : Nat → Nat → parserCore
| 0     rbp cfg r := mkError r "Parser: no progress"
| (n+1) rbp cfg r := parseTerm rbp ⟨recCmd n, parseLvl, recTerm n⟩ cfg r
-/

/-
def runParser (x : Parser) (parseCmd : Parser) (parseLvl : Nat → Parser) (parseTerm : Nat → Parser)
               (input : Iterator) (cfg : ParserConfig) : Result Syntax :=
let it := input in
let n  := it.remaining in
let r  := mkResultOk it {} {messages := MessageLog.Empty} in
let pl := recLvl (parseLvl) n in
let ps : recParsers := { cmdParser  := recCmd parseCmd parseTerm pl n,
                          lvlParser  := pl,
                          termParser := recTerm parseCmd parseTerm pl n } in
x ps cfg r
-/

structure parsingTables :=
(leadingTermParsers : TokenMap Parser)
(trailingTermParsers : TokenMap trailingParser)

abbreviation CommandParserM (α : Type) :=
parsingTables → parserM α

end flatParser
end Lean

def mkBigString : Nat → String → String
| 0     s := s
| (n+1) s := mkBigString n (s ++ "-- new comment\n")

section
open Lean.flatParser

def flatP : parserM Unit :=
many1 (str "--" *> takeUntil (= '\n') *> any *> pure ())

end

section
open Lean.Parser
open Lean.Parser.MonadParsec

@[reducible] def Parser (α : Type) : Type :=  ReaderT Lean.flatParser.recParsers (ReaderT Lean.flatParser.ParserConfig (ParsecT Syntax (StateT ParserCache id))) α

def testParsec (p : Parser Unit) (input : String) : String :=
let ps : Lean.flatParser.recParsers := { cmdParser := Lean.flatParser.dummyParserCore, termParser := λ _, Lean.flatParser.dummyParserCore } in
let cfg : Lean.flatParser.ParserConfig := { filename := "test", input := input, FileMap := Lean.flatParser.FileMap.fromString input, tokens := Lean.Parser.Trie.mk } in
let r := p ps cfg input.mkIterator {} in
match r with
| (Parsec.Result.ok _ it _, _)   := "OK at " ++ toString it.offset
| (Parsec.Result.error msg _, _) := "Error " ++ msg.toString

def parsecP : Parser Unit :=
many1' (str "--" *> takeUntil (λ c, c = '\n') *> any *> pure ())
end

@[noinline] def testFlatP (s : String) : IO Unit :=
IO.println (Lean.flatParser.testParser flatP s)

@[noinline] def testParsecP (s : String) : IO Unit :=
IO.println (testParsec parsecP s)

def prof {α : Type} (msg : String) (p : IO α) : IO α :=
let msg₁ := "Time for '" ++ msg ++ "':" in
let msg₂ := "Memory usage for '" ++ msg ++ "':" in
allocprof msg₂ (timeit msg₁ p)

def main (xs : List String) : IO UInt32 :=
let s₁ := mkBigString xs.head.toNat "" in
let s₂ := s₁ ++ "bad" ++ mkBigString 20 "" in
prof "flat Parser 1" (testFlatP s₁) *>
prof "flat Parser 2" (testFlatP s₂) *>
-- prof "Parsec 1" (testParsecP s₁) *>
-- prof "Parsec 2" (testParsecP s₂) *>
pure 0


/-
Copyright (c) 2020 Sebastian Ullrich. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sebastian Ullrich
-/
import Lean.InternalExceptionId
import Lean.KeyedDeclsAttribute

namespace Lean
namespace PrettyPrinter

/- Auxiliary internal exception for backtracking the pretty printer.
   See `orelse.parenthesizer` for example -/
builtin_initialize backtrackExceptionId : InternalExceptionId ← registerInternalExceptionId `backtrackFormatter

unsafe def runForNodeKind {α} (attr : KeyedDeclsAttribute α) (k : SyntaxNodeKind) (interp : ParserDescr → CoreM α) : CoreM α := do
  match attr.getValues (← getEnv) k with
  | p::_ => pure p
  | _ =>
    -- assume `k` is from a `ParserDescr`, in which case we assume it's also the declaration name
    let info ← getConstInfo k
    if info.type.isConstOf ``ParserDescr || info.type.isConstOf ``TrailingParserDescr then
      let d ← evalConst ParserDescr k
      interp d
    else
      throwError "no declaration of attribute [{attr.defn.name}] found for '{k}'"

end PrettyPrinter
end Lean


import Lean.Elab.Tactic

open Lean Elab Tactic in
elab "print!" : tactic => do
  logInfo "foo"
  throwError "error"

example : True := by
  print!
  admit