;;; llm-anthropic.scm - Anthropic provider implementation for llm egg
;;;
;;; BSD-3-Clause License
;;; Copyright (c) 2025, Rolando Abarca

(module llm-anthropic

(anthropic-http-client
 anthropic-call-api
 anthropic-provider
 anthropic-prepare-message
 anthropic-build-payload
 anthropic-parse-response
 anthropic-format-tool-result
 anthropic-get-model-pricing
 anthropic-extract-tool-calls
 *anthropic-default-model*
 *anthropic-default-temperature*
 *anthropic-default-max-tokens*)

(import
 scheme
 chicken.base
 chicken.condition
 chicken.process-context
 chicken.port
 chicken.io
 chicken.string
 openssl
 http-client
 medea
 intarweb
 uri-common
 srfi-1
 srfi-13
 logger
 llm-provider
 llm-common)

(logger/install LLM-ANTHROPIC)

;;; ================================================================
;;; Anthropic Model Configuration
;;; ================================================================

;; Model configurations with pricing (cost per 1M tokens in USD)
;; See https://docs.anthropic.com/en/docs/about-claude/models for model IDs
(define *anthropic-model-configs*
  '(;; Claude 4.5 models (latest)
    (claude-sonnet-4-5-20250929 . ((input-price-per-1m . 3.00)
                                    (output-price-per-1m . 15.00)))
    (claude-haiku-4-5-20251001 . ((input-price-per-1m . 1.00)
                                   (output-price-per-1m . 5.00)))
    (claude-opus-4-5-20251101 . ((input-price-per-1m . 5.00)
                                  (output-price-per-1m . 25.00)))
    ;; Claude 4.x legacy models
    (claude-opus-4-1-20250805 . ((input-price-per-1m . 15.00)
                                  (output-price-per-1m . 75.00)))
    (claude-sonnet-4-20250514 . ((input-price-per-1m . 3.00)
                                  (output-price-per-1m . 15.00)))
    (claude-opus-4-20250514 . ((input-price-per-1m . 15.00)
                                (output-price-per-1m . 75.00)))
    ;; Claude 3.x models
    (claude-3-7-sonnet-20250219 . ((input-price-per-1m . 3.00)
                                    (output-price-per-1m . 15.00)))
    (claude-3-haiku-20240307 . ((input-price-per-1m . 0.25)
                                 (output-price-per-1m . 1.25)))))

;; Default settings for Anthropic
(define *anthropic-default-model* "claude-sonnet-4-5-20250929")
(define *anthropic-default-temperature* 1)
(define *anthropic-default-max-tokens* 4096)

;;; ================================================================
;;; HTTP Client Infrastructure
;;; ================================================================

;; Get Anthropic API key from environment
(define (get-api-key)
  (or (get-environment-variable "ANTHROPIC_API_KEY")
      (error "ANTHROPIC_API_KEY environment variable must be set")))

;; Default HTTP client implementation using http-client
(define (default-anthropic-http-client endpoint payload)
  (let* ((api-key (get-api-key))
         (uri (make-uri scheme: 'https
                        host: "api.anthropic.com"
                        path: '(/ "v1" "messages"))))
    (condition-case
        (let* ((req-headers (headers `((content-type application/json)
                                       (x-api-key #(,api-key raw))
                                       (anthropic-version #("2023-06-01" raw)))))
               (req (make-request uri: uri
                                  method: 'POST
                                  headers: req-headers)))
          (let-values (((data req resp) (with-input-from-request req
                                                                  (json->string payload)
                                                                  read-json)))
            data))
      [var (http client-error)
           (let ((resp (get-condition-property var 'client-error 'response))
                 (body (get-condition-property var 'client-error 'body)))
             (e "API Error: " var)
             (e body)
             #f)])))

;; Parameter for dependency injection
(define anthropic-http-client (make-parameter default-anthropic-http-client))

;; Helper to make Anthropic API requests using the injected client
;; Note: endpoint is ignored - Anthropic only uses /v1/messages
(define (anthropic-call-api endpoint payload)
  ((anthropic-http-client) endpoint payload))

;;; ================================================================
;;; Provider Interface Implementation
;;; ================================================================

;; Convert a chat message to Anthropic format
;; For cost savings, file attachments are NOT sent to the model by default.
;; Instead, files are described as text annotations.
;;
;; If include-file is #t, the file WILL be embedded
(define (anthropic-prepare-message msg include-file)
  (let ((role (alist-ref 'role msg))
        (content (alist-ref 'content msg))
        (file-data (alist-ref 'file_data msg))
        (file-type (alist-ref 'file_type msg))
        (file-name (alist-ref 'file_name msg)))
    (cond
     ;; If include-file is false and we have file data, convert to text description
     ((and file-data (not include-file))
      (let ((type-desc (cond
                        ((image-mime-type? file-type) "image")
                        ((pdf-mime-type? file-type) "PDF document")
                        (else "file"))))
        `((role . ,role)
          (content . ,(conc (or content "") "\n[Attached " type-desc ": " (or file-name "file") "]")))))

     ;; PDF with base64 data: use Anthropic "document" format
     ((and file-data (pdf-mime-type? file-type))
      (d "Preparing PDF message with existing base64 data")
      `((role . ,role)
        (content . #(((type . "text") (text . ,content))
                     ((type . "document")
                      (source . ((type . "base64")
                                 (media_type . "application/pdf")
                                 (data . ,file-data))))))))

     ;; Image with base64 data: use Anthropic "image" format
     ((and file-data (image-mime-type? file-type))
      `((role . ,role)
        (content . #(((type . "text") (text . ,content))
                     ((type . "image")
                      (source . ((type . "base64")
                                 (media_type . ,file-type)
                                 (data . ,file-data))))))))

     ;; Regular message: pass through unchanged
     (else msg))))

;; Convert OpenAI-style tools to Anthropic format
;; OpenAI: ((type . "function") (function . ((name . ...) (description . ...) (parameters . ...))))
;; Anthropic: ((name . ...) (description . ...) (input_schema . ...))
(define (convert-tools-to-anthropic tools)
  (if (and tools (> (vector-length tools) 0))
      (list->vector
       (map (lambda (tool)
              (let ((fn (alist-ref 'function tool)))
                `((name . ,(alist-ref 'name fn))
                  (description . ,(alist-ref 'description fn))
                  (input_schema . ,(alist-ref 'parameters fn)))))
            (vector->list tools)))
      #f))

;; Build Anthropic API payload
;; Key differences from OpenAI:
;; - System message goes in top-level "system" field
;; - max_tokens instead of max_completion_tokens
;; - tools format is different
(define (anthropic-build-payload messages tools model temperature max-tokens)
  (let* (;; Separate system messages from others
         (system-messages (filter (lambda (m) (equal? (alist-ref 'role m) "system"))
                                  messages))
         (non-system-messages (filter (lambda (m) (not (equal? (alist-ref 'role m) "system")))
                                      messages))
         ;; Get system content (combine if multiple)
         (system-content (if (null? system-messages)
                             #f
                             (string-join
                              (map (lambda (m) (alist-ref 'content m)) system-messages)
                              "\n\n")))
         ;; Convert file messages to proper Anthropic format
         (prepared-messages (map (lambda (m) (anthropic-prepare-message m #f)) non-system-messages))
         ;; Convert tools to Anthropic format
         (anthropic-tools (convert-tools-to-anthropic tools))
         ;; Build base payload
         (base `((model . ,(or model *anthropic-default-model*))
                 (max_tokens . ,(or max-tokens *anthropic-default-max-tokens*))
                 (messages . ,(list->vector prepared-messages)))))
    ;; Add optional fields
    (let* ((with-temp (if temperature
                          (cons `(temperature . ,temperature) base)
                          base))
           (with-system (if system-content
                            (cons `(system . ,system-content) with-temp)
                            with-temp))
           (with-tools (if anthropic-tools
                           (append with-system `((tools . ,anthropic-tools)))
                           with-system)))
      with-tools)))

;; Parse Anthropic API response
;; Key differences from OpenAI:
;; - No choices array, content is directly in response
;; - Content is an array of content blocks
;; - Tool calls are content blocks with type "tool_use"
;; Returns: alist with 'message, 'content, 'tool-calls, 'finish-reason, 'usage
(define (anthropic-parse-response response-data)
  (if (not response-data)
      `((success . #f)
        (error . "No response from API"))
      (let* ((usage (alist-ref 'usage response-data))
             (input-tokens (if usage (alist-ref 'input_tokens usage) 0))
             (output-tokens (if usage (alist-ref 'output_tokens usage) 0))
             (content-blocks (alist-ref 'content response-data))
             (stop-reason (alist-ref 'stop_reason response-data)))
        (if (not content-blocks)
            `((success . #f)
              (error . ,(or (alist-ref 'error response-data) "No content in response"))
              (input-tokens . ,(or input-tokens 0))
              (output-tokens . ,(or output-tokens 0)))
            ;; Extract text content from content blocks
            (let* ((text-blocks (filter (lambda (b) (equal? (alist-ref 'type b) "text"))
                                        (vector->list content-blocks)))
                   (tool-use-blocks (filter (lambda (b) (equal? (alist-ref 'type b) "tool_use"))
                                            (vector->list content-blocks)))
                   (text-content (if (null? text-blocks)
                                     #f
                                     (string-join (map (lambda (b) (alist-ref 'text b)) text-blocks) "")))
                   ;; Build a message-like structure for compatibility with llm.scm
                   ;; Store content blocks for tool call extraction
                   (message `((role . "assistant")
                              (content . ,text-content)
                              (content_blocks . ,content-blocks)))
                   ;; Convert tool_use blocks to tool_calls vector for compatibility
                   (tool-calls (if (null? tool-use-blocks)
                                   #f
                                   (list->vector tool-use-blocks))))
              `((success . #t)
                (message . ,message)
                (content . ,text-content)
                (tool-calls . ,tool-calls)
                (finish-reason . ,stop-reason)
                (input-tokens . ,(or input-tokens 0))
                (output-tokens . ,(or output-tokens 0))))))))

;; Extract tool calls from Anthropic response message
;; Content blocks with type "tool_use" contain: id, name, input
;; Returns: list of alists with 'id, 'name, 'arguments (as JSON string)
(define (anthropic-extract-tool-calls response-message)
  (let ((content-blocks (alist-ref 'content_blocks response-message)))
    (if (and content-blocks (> (vector-length content-blocks) 0))
        (let ((tool-use-blocks (filter (lambda (b) (equal? (alist-ref 'type b) "tool_use"))
                                       (vector->list content-blocks))))
          (map (lambda (tc)
                 (let* ((tool-id (alist-ref 'id tc))
                        (tool-name (alist-ref 'name tc))
                        (input (alist-ref 'input tc)))
                   `((id . ,tool-id)
                     (name . ,tool-name)
                     ;; Convert input back to JSON string for compatibility
                     (arguments . ,(json->string input)))))
               tool-use-blocks))
        '())))

;; Format tool result message for Anthropic
;; Anthropic uses role "user" with content blocks of type "tool_result"
;; Returns: message alist in Anthropic's tool result format
(define (anthropic-format-tool-result tool-call-id result)
  `((role . "user")
    (content . #(((type . "tool_result")
                  (tool_use_id . ,tool-call-id)
                  (content . ,(if (string? result) result (json->string result))))))))

;; Get pricing for a model
;; Returns: alist with 'input-price-per-1m and 'output-price-per-1m
(define (anthropic-get-model-pricing model-name)
  (let* ((model-sym (if (string? model-name)
                        (string->symbol model-name)
                        model-name))
         (config (alist-ref model-sym *anthropic-model-configs*)))
    (or config
        ;; Fallback pricing if model not found (use Claude 3.5 Sonnet pricing)
        '((input-price-per-1m . 3.00)
          (output-price-per-1m . 15.00)))))

;;; ================================================================
;;; Anthropic Provider Instance
;;; ================================================================

;; Create the Anthropic provider instance
(define anthropic-provider
  (make-llm-provider
   'anthropic                      ;; name
   *anthropic-default-model*       ;; default-model
   anthropic-prepare-message       ;; prepare-message
   anthropic-build-payload         ;; build-payload
   anthropic-call-api              ;; call-api
   anthropic-parse-response        ;; parse-response
   anthropic-format-tool-result    ;; format-tool-result
   anthropic-get-model-pricing     ;; get-model-pricing
   anthropic-extract-tool-calls    ;; extract-tool-calls
   #f                              ;; generate-image (not supported)
   #f))                            ;; transcribe-audio (not supported)

) ;; end module