Anthropic's Claude

urweb · Nov 3, 2023 · 6aa9971 · 6aa9971
1 parent 0069626
commit 6aa9971
Show file tree

Hide file tree

Showing 6 changed files with 134 additions and 0 deletions.
diff --git a/examples/claudeDemo.ur b/examples/claudeDemo.ur
@@ -0,0 +1,46 @@
+(* For this demo, it's necessary to create claudeSecrets.ur,
+ * defining [api_key]. *)
+structure C = Claude.Make(Claude.TwoLegged(ClaudeSecrets))
+
+fun render log =
+    case log of
+        [] => <xml></xml>
+      | human :: [] => <xml>
+        <li><b>Human:</b> {[human]}</li>
+      </xml>
+      | human :: assistant :: log' => <xml>
+        <li><b>Human:</b> {[human]}</li>
+        <li><b>Assistant:</b> {[assistant]}</li>
+        {render log'}
+      </xml>
+
+fun flatten log =
+    case log of
+        [] => ""
+      | human :: [] =>
+        "\n\nHuman: " ^ human ^ "\n\nAssistant:"
+      | human :: assistant :: log' =>
+        "\n\nHuman: " ^ human ^ "\n\nAssistant: " ^ assistant ^ flatten log'
+
+fun chat log =
+    C.complete {Model = readError "claude-2",
+                MaxTokensToSample = 1000,
+                Prompt = flatten log}
+
+fun main () =
+    log <- source [];
+    prompt <- source "";
+    return <xml><body>
+      <ul>
+        <dyn signal={log <- signal log;
+                     return (render log)}/>
+      </ul>
+      <ctextbox source={prompt}/>
+      <button value="Chat" onclick={fn _ => pr <- get prompt;
+                                       log' <- get log;
+                                       log' <- return (List.append log' (pr :: []));
+                                       resp <- rpc (chat log');
+                                       log' <- return (List.append log' (resp :: []));
+                                       set log log';
+                                       set prompt ""}/>
+    </body></xml>
diff --git a/examples/claudeDemo.urp b/examples/claudeDemo.urp
@@ -0,0 +1,10 @@
+library ../src/ur
+rewrite all ClaudeDemo/*
+database dbname=claudeDemo
+sql claudeDemo.sql
+safeGetDefault
+allow url https://*
+prefix http://localhost:8080/
+
+claudeSecrets
+claudeDemo
diff --git a/examples/claudeDemo.urs b/examples/claudeDemo.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/src/ur/claude.ur b/src/ur/claude.ur
@@ -0,0 +1,53 @@
+open Json
+open Urls
+
+functor TwoLegged(M : sig
+                        val api_key : string
+                    end) = struct
+    open M
+
+    val token = return (Some api_key)
+end
+
+type model = string
+val read_model = _
+val show_model = _
+
+type complete_arg = {
+     Model : model,
+     Prompt : string,
+     MaxTokensToSample : int
+}
+val _ : json complete_arg = json_record
+                                {Model = "model",
+                                 Prompt = "prompt",
+                                 MaxTokensToSample = "max_tokens_to_sample"}
+
+type complete_result = {
+     Completion : string
+}
+val _ : json complete_result = json_record {Completion = "completion"}
+
+functor Make(M : sig
+                 val token : transaction (option string)
+             end) = struct
+    val token =
+        tok <- M.token;
+        case tok of
+            Some tok => return tok
+          | None => error <xml>How odd: no Claude token!</xml>
+
+    val urlPrefix = "https://api.anthropic.com/v1/"
+
+    fun api url body =
+        tok <- token;
+        WorldFfi.post (bless (urlPrefix ^ url))
+                      (WorldFfi.addHeader
+                           (WorldFfi.addHeader WorldFfi.emptyHeaders "anthropic-version" "2023-06-01")
+                           "x-api-key" tok)
+                      (Some "application/json") body
+
+    fun complete arg =
+        r <- api "complete" (toJson arg);
+        return (fromJson r : complete_result).Completion
+end
diff --git a/src/ur/claude.urs b/src/ur/claude.urs
@@ -0,0 +1,23 @@
+functor TwoLegged(M : sig
+                        val api_key : string
+                    end) : sig
+    val token : transaction (option string)
+end
+
+(** * API records *)
+
+(* LLM models supported by Claude *)
+type model
+val read_model : read model
+val show_model : show model
+
+(** * Now for the actual methods.... *)
+
+functor Make(M : sig
+                 val token : transaction (option string)
+             end) : sig
+    val complete : {Model : model,
+                    Prompt : string,
+                    MaxTokensToSample : int}
+                   -> transaction string
+end
diff --git a/src/ur/lib.urp b/src/ur/lib.urp
@@ -32,3 +32,4 @@ netSuite
 chatgpt
 smartsheet
 serviceNow
+claude
-Original file line number
+Diff line change
@@ Expand Up / @@ -32,3 +32,4 @@ netSuite @@
     chatgpt
     smartsheet
     serviceNow
+    claude