Request.hs

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Request types (Protocol-Agnostic Internal Representation)
-- All protocol-specific requests convert TO this format
module Louter.Types.Request
  ( ChatRequest(..)
  , Message(..)
  , MessageRole(..)
  , ContentPart(..)
  , Tool(..)
  , ToolChoice(..)
  , defaultChatRequest
  ) where

import Data.Aeson (FromJSON(..), ToJSON(..), Value(..), (.=), object)
import Data.Aeson.KeyMap (lookup)
import Data.Text (Text)
import qualified Data.Vector as V
import GHC.Generics (Generic)
import Prelude hiding (lookup)

-- | Protocol-agnostic chat request (Internal Representation)
-- Inspired by OpenAI's format but owned by Louter
data ChatRequest = ChatRequest
  { reqModel :: !Text                 -- ^ Model name (e.g., "gpt-4", "gemini-pro")
  , reqMessages :: ![Message]         -- ^ Conversation messages
  , reqTools :: ![Tool]               -- ^ Available tools/functions
  , reqToolChoice :: !ToolChoice      -- ^ How to choose tools
  , reqTemperature :: !(Maybe Double) -- ^ Sampling temperature
  , reqMaxTokens :: !(Maybe Int)      -- ^ Maximum tokens to generate
  , reqStream :: !Bool                -- ^ Whether to stream response
  } deriving (Show, Eq, Generic)

instance FromJSON ChatRequest
instance ToJSON ChatRequest

-- | Default request with sensible defaults
defaultChatRequest :: Text -> [Message] -> ChatRequest
defaultChatRequest model msgs = ChatRequest
  { reqModel = model
  , reqMessages = msgs
  , reqTools = []
  , reqToolChoice = ToolChoiceAuto
  , reqTemperature = Nothing
  , reqMaxTokens = Nothing
  , reqStream = False
  }

-- | Content part (text, image, etc.)
data ContentPart
  = TextPart !Text
  | ImagePart
      { imageMediaType :: !Text  -- ^ MIME type (e.g., "image/png")
      , imageData :: !Text       -- ^ Base64-encoded image data
      }
  deriving (Show, Eq, Generic)

instance ToJSON ContentPart where
  toJSON (TextPart txt) = object
    [ "type" .= ("text" :: Text)
    , "text" .= txt
    ]
  toJSON (ImagePart mediaType dataB64) = object
    [ "type" .= ("image_url" :: Text)
    , "image_url" .= object
        [ "url" .= ("data:" <> mediaType <> ";base64," <> dataB64)
        ]
    ]

instance FromJSON ContentPart where
  parseJSON (Object obj) = case lookup "type" obj of
    Just (String "text") -> case lookup "text" obj of
      Just (String txt) -> pure $ TextPart txt
      _ -> fail "Missing text field"
    Just (String "image_url") -> case lookup "image_url" obj of
      Just (Object imgObj) -> case lookup "url" imgObj of
        Just (String url) -> pure $ TextPart url  -- Simplified for now
        _ -> fail "Missing url in image_url"
      _ -> fail "Missing image_url object"
    _ -> fail "Unknown content part type"
  parseJSON _ = fail "Expected object for ContentPart"

-- | Message in a conversation
data Message = Message
  { msgRole :: !MessageRole
  , msgContent :: ![ContentPart]  -- ^ Changed from Text to [ContentPart]
  } deriving (Show, Eq, Generic)

instance FromJSON Message where
  parseJSON (Object obj) = do
    role <- case lookup "role" obj of
      Just r -> parseJSON r
      Nothing -> fail "Missing role"
    content <- case lookup "content" obj of
      -- Support both string and array format
      Just (String txt) -> pure [TextPart txt]
      Just (Array arr) -> mapM parseJSON (V.toList arr)
      _ -> fail "Missing or invalid content"
    pure $ Message role content
  parseJSON _ = fail "Expected object for Message"

instance ToJSON Message where
  toJSON (Message role content) = object
    [ "role" .= role
    , "content" .= case content of
        [TextPart txt] -> String txt  -- Simplify single text to string
        parts -> toJSON parts         -- Multiple parts as array
    ]

-- | Message role
data MessageRole
  = RoleSystem
  | RoleUser
  | RoleAssistant
  | RoleTool
  deriving (Show, Eq)

instance FromJSON MessageRole where
  parseJSON (String "system") = pure RoleSystem
  parseJSON (String "user") = pure RoleUser
  parseJSON (String "assistant") = pure RoleAssistant
  parseJSON (String "tool") = pure RoleTool
  parseJSON _ = fail "Invalid role"

instance ToJSON MessageRole where
  toJSON role = case role of
    RoleSystem -> String "system"
    RoleUser -> String "user"
    RoleAssistant -> String "assistant"
    RoleTool -> String "tool"

-- | Tool/Function definition
data Tool = Tool
  { toolName :: !Text              -- ^ Function name
  , toolDescription :: !(Maybe Text) -- ^ Description
  , toolParameters :: !Value       -- ^ JSON Schema for parameters
  } deriving (Show, Eq, Generic)

instance FromJSON Tool

instance ToJSON Tool where
  toJSON t = object
    [ "type" .= ("function" :: Text)
    , "function" .= object
        [ "name" .= toolName t
        , "description" .= toolDescription t
        , "parameters" .= toolParameters t
        ]
    ]

-- | How to choose which tool to call
data ToolChoice
  = ToolChoiceAuto     -- ^ Let model decide
  | ToolChoiceNone     -- ^ Don't call any tools
  | ToolChoiceRequired -- ^ Must call at least one tool
  | ToolChoiceSpecific !Text -- ^ Call specific tool
  deriving (Show, Eq)

instance FromJSON ToolChoice where
  parseJSON (String "auto") = pure ToolChoiceAuto
  parseJSON (String "none") = pure ToolChoiceNone
  parseJSON (String "required") = pure ToolChoiceRequired
  parseJSON (Object obj) = case lookup "type" obj of
    Just (String "function") -> case lookup "function" obj of
      Just (Object fn) -> case lookup "name" fn of
        Just (String name) -> pure $ ToolChoiceSpecific name
        _ -> fail "Missing name in function"
      _ -> fail "Missing function object"
    _ -> fail "Unknown tool choice type"
  parseJSON _ = fail "Invalid tool choice"

instance ToJSON ToolChoice where
  toJSON choice = case choice of
    ToolChoiceAuto -> String "auto"
    ToolChoiceNone -> String "none"
    ToolChoiceRequired -> String "required"
    ToolChoiceSpecific name -> object ["type" .= ("function" :: Text), "function" .= object ["name" .= name]]