Main.hs

{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}

module Main where

import Control.Monad (foldM, when)
import Data.Aeson (Value (..), (.=))
import Data.Text (Text)
import Data.Vector (Vector)
import GHC.Exts (toList)
import OpenAI.V1
import OpenAI.V1.Chat.Completions
import OpenAI.V1.Tool
import OpenAI.V1.ToolCall

import qualified Data.Aeson as Aeson
import qualified Data.ByteString.Lazy as ByteString.Lazy
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text.Encoding
import qualified Data.Text.IO as Text.IO
import qualified Data.Vector as Vector
import qualified System.Environment as Environment

-- | Mock weather data for different cities
mockWeatherData :: Text -> Text
mockWeatherData city = case Text.toLower city of
  "london" -> "London: 18°C, partly cloudy, 60% humidity, light rain expected"
  "paris" -> "Paris: 22°C, sunny, 45% humidity, clear skies"
  "tokyo" -> "Tokyo: 28°C, humid, 80% humidity, thunderstorms possible"
  "new york" -> "New York: 25°C, partly sunny, 55% humidity, pleasant weather"
  "san francisco" -> "San Francisco: 16°C, foggy, 70% humidity, typical coastal weather"
  _ -> city <> ": Weather data not available for this location. Try London, Paris, Tokyo, New York, or San Francisco."

-- | Process a weather tool call and return the result
processWeatherToolCall :: ToolCall -> IO (Message (Vector Content))
processWeatherToolCall (ToolCall_Function toolCallId function) = do
  let functionName = OpenAI.V1.ToolCall.name function
      arguments = OpenAI.V1.ToolCall.arguments function

  putStrLn $ "🔧 Processing tool call: " <> Text.unpack functionName
  putStrLn $ "   Arguments: " <> Text.unpack arguments

  -- Parse arguments to extract city name
  let weatherResult = case Aeson.decode (ByteString.Lazy.fromStrict $ Text.Encoding.encodeUtf8 arguments) of
        Just (Object obj) -> case lookup "city" (toList obj) of
          Just (String cityName) -> mockWeatherData cityName
          _ -> "Error: Could not parse city name from arguments"
        _ -> "Error: Invalid arguments format"

  putStrLn $ "   Result: " <> Text.unpack weatherResult
  putStrLn ""

  -- Return a Tool message with the result
  return $
    Tool
      { content = [Text weatherResult],
        tool_call_id = toolCallId
      }

-- | Define the weather tool
weatherTool :: Tool
weatherTool =
  Tool_Function $
    OpenAI.V1.Tool.Function
      { description = Just "Get current weather information for a city",
        name = "get_weather",
        parameters =
          Just $
            Aeson.object
              [ "type" .= ("object" :: Text),
                "properties"
                  .= Aeson.object
                    [ "city"
                        .= Aeson.object
                          [ "type" .= ("string" :: Text),
                            "description" .= ("The city name to get weather for" :: Text)
                          ]
                    ],
                "required" .= (["city"] :: [Text]),
                "additionalProperties" .= False
              ],
        strict = Just True
      }

-- | Convert a Message Text to Message (Vector Content)
convertMessage :: Message Text -> Message (Vector Content)
convertMessage (System {content, name}) = System {content = [Text content], name = name}
convertMessage (User {content, name}) = User {content = [Text content], name = name}
convertMessage (Assistant {assistant_content, refusal, name, assistant_audio, tool_calls}) =
  Assistant
    { assistant_content = fmap (\c -> [Text c]) assistant_content,
      refusal = refusal,
      name = name,
      assistant_audio = assistant_audio,
      tool_calls = tool_calls
    }
convertMessage (Tool {content, tool_call_id}) = Tool {content = [Text content], tool_call_id = tool_call_id}

-- | Process all tool calls in a message and return tool response messages
processToolCalls :: Vector ToolCall -> IO (Vector (Message (Vector Content)))
processToolCalls toolCalls = do
  when (not $ Vector.null toolCalls) $ do
    putStrLn $ "🤖 Processing " <> show (Vector.length toolCalls) <> " tool call(s)..."
  Vector.mapM processWeatherToolCall toolCalls

-- | Main chat loop
chatLoop :: (CreateChatCompletion -> IO ChatCompletionObject) -> Vector (Message (Vector Content)) -> IO ()
chatLoop createChatCompletion messages = do
  Text.IO.putStr "You: "
  userInput <- Text.IO.getLine

  -- Exit condition
  when (Text.toLower userInput == "quit" || Text.toLower userInput == "exit") $ do
    putStrLn "Goodbye! 👋"
    return ()

  -- Add user message to conversation
  let userMessage =
        User
          { content = [Text userInput],
            name = Nothing
          }
      updatedMessages = messages <> [userMessage]

  -- Make API call with tool support
  response <-
    createChatCompletion
      _CreateChatCompletion
        { messages = updatedMessages,
          model = "gpt-4o-mini",
          tools = Just [weatherTool],
          tool_choice = Just ToolChoiceAuto
        }

  let ChatCompletionObject {choices} = response

  -- Process each choice (usually just one)
  newMessages <- foldM (processChoice createChatCompletion) updatedMessages choices

  -- Continue the conversation
  chatLoop createChatCompletion newMessages

-- | Process a single choice, handling potential tool calls
processChoice ::
  (CreateChatCompletion -> IO ChatCompletionObject) ->
  Vector (Message (Vector Content)) ->
  Choice ->
  IO (Vector (Message (Vector Content)))
processChoice createChatCompletion messages choice = do
  let Choice {message = assistantMessage} = choice

  case assistantMessage of
    Assistant {assistant_content, tool_calls = Just toolCalls} -> do
      -- Display assistant's message if any
      case assistant_content of
        Just content -> putStrLn $ "Assistant: " <> Text.unpack content
        Nothing -> return ()

      -- Add assistant message to history
      let messagesWithAssistant = messages <> [convertMessage assistantMessage]

      -- Process tool calls
      toolResults <- processToolCalls toolCalls
      let messagesWithTools = messagesWithAssistant <> toolResults

      -- Make another API call to get the final response after tool calls
      finalResponse <-
        createChatCompletion
          _CreateChatCompletion
            { messages = messagesWithTools,
              model = "gpt-4o-mini",
              tools = Just [weatherTool],
              tool_choice = Just ToolChoiceAuto
            }

      let ChatCompletionObject {choices = finalChoices} = finalResponse

      -- Process the final response (this should not have tool calls)
      foldM processFinalChoice messagesWithTools finalChoices
    Assistant {assistant_content = Just content} -> do
      -- No tool calls, just display the response
      putStrLn $ "Assistant: " <> Text.unpack content
      return $ messages <> [convertMessage assistantMessage]
    _ -> do
      putStrLn "Assistant: (No response content)"
      return messages

-- | Process final choice after tool calls (should just be text response)
processFinalChoice :: Vector (Message (Vector Content)) -> Choice -> IO (Vector (Message (Vector Content)))
processFinalChoice messages choice = do
  let Choice {message = finalMessage} = choice
  case finalMessage of
    Assistant {assistant_content = Just content} -> do
      putStrLn $ "Assistant: " <> Text.unpack content
      return $ messages <> [convertMessage finalMessage]
    _ -> do
      putStrLn "Assistant: (Unexpected response format)"
      return messages

main :: IO ()
main = do
  putStrLn "🌤️  Weather Chatbot with Tool Calling"
  putStrLn "======================================"
  putStrLn "Ask me about the weather in different cities!"
  putStrLn "Try: 'What's the weather like in London?'"
  putStrLn "Available cities: London, Paris, Tokyo, New York, San Francisco"
  putStrLn "Type 'quit' or 'exit' to end the conversation."
  putStrLn ""

  -- Get OpenAI API key
  key <- Environment.getEnv "OPENAI_KEY"

  -- Set up client
  clientEnv <- getClientEnv "https://api.openai.com"
  let Methods {createChatCompletion} = makeMethods clientEnv (Text.pack key) Nothing Nothing

  -- Initial system message
  let systemMessage =
        System
          { content = [Text "You are a helpful weather assistant. Use the get_weather tool to provide current weather information when users ask about weather in specific cities. Be conversational and helpful."],
            name = Nothing
          }

  -- Start the chat loop
  chatLoop createChatCompletion [systemMessage]