Completion Chapter

completion/JsonRpc.roc

@@ -0,0 +1,110 @@
+interface JsonRpc
+    exposes [messageLoop,sendMessage, readMessage]
+    imports [pf.Stdout, pf.Stdin, pf.Task, Core, LspTypes.{ requestMessage,RequestMessage, ResponseMessage },Types.Option]
+
+##====JSONRPC Implimentation====##
+
+##Converts a result to a task then awaits it
+awaitResult = \res, next -> res |> Task.fromResult |> Task.await next
+
+
+sendMessage = \messageBytes ->
+    len = messageBytes |> List.len
+    messageStr <- messageBytes |> Str.fromUtf8 |> awaitResult
+    msg = "Content-Type: $(len |> Num.toStr)\r\n\r\n$(messageStr)"
+    Stdout.write msg
+
+## Continueously handle incoming messages 
+messageLoop : (List U8 -> Task.Task [Continue, Exit] _) -> _
+messageLoop = \messageHandler ->
+    Task.loop [] \leftOver ->
+        { content, leftOver: nextLeftOver } <- readMessage leftOver |> Task.await
+        continue <- messageHandler content |> Task.map
+        when continue is
+            Exit -> Done []
+            Continue -> Step nextLeftOver
+
+readMessage = \partialMessage ->
+    # This is slow, we don't need to check the whole thing, just the new message with 3 chars from the previous message appended at the start, so the last 256+3 (259)
+
+    # reads the message untill we find a message start \r\n\r\n
+    message <- readTill partialMessage (\msg -> (msg |> List.walkUntil [] matchContentStart) == ['\r', '\n', '\r', '\n']) |> Task.await
+    # now we try to parse
+    message |> parseMessage
+
+matchContentStart = \state, char ->
+    when (state, char) is
+        (['\r', '\n', '\r'], '\n') -> Break (state |> List.append char)
+        (['\r', '\n'], '\r')
+        | (['\r'], '\n')
+        | ([], '\r') -> Continue (state |> List.append char)
+
+        _ -> Continue []
+
+readTill = \message, pred ->
+    Task.loop message \msg ->
+        bytes <- Stdin.bytes |> Task.map
+        newMsg = msg |> List.concat bytes
+        if pred newMsg then
+            Done newMsg
+        else
+            Step newMsg
+
+readTillAtLeastLen = \msg, len -> readTill msg \newMsg -> List.len newMsg >= len
+# TODO!: header is ascii encoded
+parseHeader : _ -> Result (U64, Str) _
+parseHeader = \message ->
+    { before: header, after } <-
+        message
+        |> Str.fromUtf8
+        |> Result.try (\s -> Str.splitFirst s "\r\n\r\n")
+        |> Result.try
+    length <- getContentLength header |> Result.map
+    (length, after)
+
+parseMessage : List U8 -> _
+parseMessage = \message ->
+    (length, rest) <- parseHeader message |> awaitResult
+    read <- (rest |> Str.toUtf8 |> readTillAtLeastLen length) |> Task.map
+    { before: content, others: leftOver } = read |> List.split length
+    { content, leftOver }
+
+## Get's the content lenght header
+## Tolerant of having an unparsed body from a malformed message in the header section because it looks from the end of the text we think is a header
+getContentLength = \header ->
+    headers = header |> Str.split "\r\n"
+    contentHeaderName = "Content-Length: "
+    # we do contians here because if we failed to parse the last body it might be stuck at the end of this header
+    dbg headers
+    contentHeader = headers |> List.findFirst \a -> a |> Str.contains contentHeaderName
+    when contentHeader is
+        Err _ -> Err NoContentHeader
+        Ok cHead ->
+            # Because we might have some junk before this header we just keep anything after the header name
+            cHead |> Str.splitLast contentHeaderName |> Result.try \split -> split.after |> Str.toU64
+
+makeTest = \content ->
+    length = content |> Str.countUtf8Bytes
+    """
+    Content-Length: $(length |> Num.toStr)\r\n\r\n$(content)
+    """
+hoverJson =
+    """
+    {"jsonrpc":"2.0","method":"textDocument/hover","params":{"position":{"character":0,"line":5},"textDocument":{"uri":"file:///home/eli/Code/roc/langServer/main.roc"}},"id":1}        
+    """
+expect
+    input = makeTest hoverJson |> Str.toUtf8
+    res=
+        (length, after) <- parseHeader input |> Result.try
+        {before:content,others:leftOver}=after|>Str.toUtf8 |>List.split length
+        msg <- (content) |> Decode.fromBytes Core.json|>Result.map
+        msgDat:RequestMessage 
+        msgDat=msg
+        when requestMessage msgDat is 
+            Hover a->  
+                leftOver==[] && (a.params.position.line==5) 
+            _-> Bool.false
+
+
+    res==Ok(Bool.true)
+

completion/JsonRpc/ReadMessage.roc

@@ -0,0 +1,7 @@
+interface ReadMessage
+    exposes [readMessage]
+    imports [pf.Task]
+
+readline =\a->Task ""
+readMessage = \ ->
+    readLine {}

completion/Lsp/Types.roc

@@ -0,0 +1,94 @@
+interface Types
+    exposes []
+    imports [Union2,]
+
+
+RequestMessageIntern a : {
+    id : Union2 I64 Str,
+    method : Str,
+    # TODO: This should techincally be a union of array and object
+    params : Option a,
+}
+HoverParams : {
+    textDocument : TextDocumentIdentifier,
+    position : Position,
+    workDoneToken : Option (Union2 I64 Str),
+}
+DidOpenTextDocumentParams : {
+    ## The document that was opened.
+    textDocument : TextDocumentItem,
+}
+RequestMessage := [
+    Hover (RequestMessageIntern HoverParams),
+    DidOpen (RequestMessageIntern DidOpenTextDocumentParams),
+]
+    implements [
+        Decoding {
+            decoder: decodeRequestMessage,
+        },
+    ]
+decodeRequestMessage = Decode.custom \bytes, fmt ->
+    decoded : DecodeResult { method : Str }
+    decoded = Decode.decodeWith bytes Decode.decoder fmt
+    when decoded.result is
+        Err e -> { result: Err e, rest: decoded.rest }
+        Ok res ->
+            decode = \requestType ->
+                when Decode.decodeWith bytes Decode.decoder fmt is
+                    { result, rest } ->
+                        when result is
+                            Err e -> { result: Err e, rest }
+                            Ok a -> { result: Ok (@RequestMessage (requestType a)), rest }
+            when res.method is
+                "textDocument/hover" -> decode Hover
+                "textDocument/didOpen" -> decode DidOpen
+                _ -> { result: Err (TooShort), rest: decoded.rest }
+
+expect
+    testDecode:Result RequestMessage _
+    testDecode=sample|>Decode.fromBytes Core.json
+    when testDecode is
+        Ok a-> 
+            when  a is
+                @RequestMessage (Hover _)-> Bool.true
+                _->Bool.false
+
+        Err _->Bool.false
+
+Position : {
+    line : U64,
+    character : U64,
+}
+##TODO: This should have some decoding constraints and probably be opaque
+DocumentUri : Str
+
+TextDocumentIdentifier : {
+    uri : DocumentUri,
+}
+
+TextDocumentItem : {
+    ## The text document's URI.
+    uri : DocumentUri,
+
+    ## The text document's language identifier.
+    languageId : Str,
+
+    ## The version number of this document (it will increase after each
+    ## change, including undo/redo).
+    version : I64,
+
+    ## The content of the opened text document.
+    text : Str,
+}
+WorkDoneProgressParams : {
+    workDoneToken : Union2 I64 Str,
+}
+
+## Doesn't work
+# ProgressToken : Union2 I64 Str
+
+# RequestMessage should be opaque
+# It will have its own decoder.
+# In the decoder we will decide which Request it should decode to
+# It will return a tag union of all the possible types
+