packages feed

ollama-haskell-0.3.0.0: src/Ollama/Types/Message.hs

{- |
Module      : Ollama.Types.Message
Copyright   : (c) 2024-2026 Tushar Adhatrao
License     : MIT
Maintainer  : tusharadhatrao@gmail.com
Stability   : stable
Portability : portable

Chat message definitions and helper constructors.

@since 3.0.0.0
-}
module Ollama.Types.Message (
  Role (..),
  Message (..),
  userMessage,
  systemMessage,
  assistantMessage,
  toolMessage,
  toolResultMessage,
  imageMessage,
) where

import Data.Aeson
import Data.Maybe (catMaybes)
import Data.Text (Text)
import GHC.Generics (Generic)
import Ollama.Types.Common (Base64Image)
import Ollama.Types.Tool (ToolCall)

{- | Entity role in a conversation.

@since 3.0.0.0
-}
data Role = System | User | Assistant | Tool
  deriving stock (Eq, Ord, Show, Bounded, Enum, Generic)

instance ToJSON Role where
  toJSON System = String "system"
  toJSON User = String "user"
  toJSON Assistant = String "assistant"
  toJSON Tool = String "tool"

instance FromJSON Role where
  parseJSON = withText "Role" $ \case
    "system" -> pure System
    "user" -> pure User
    "assistant" -> pure Assistant
    "tool" -> pure Tool
    other -> fail $ "Invalid Role: " <> show other

{- | Chat message within a conversation payload.

@since 3.0.0.0
-}
data Message = Message
  { messageRole :: !Role
  , messageContent :: !Text
  , messageImages :: !(Maybe [Base64Image])
  , messageToolCalls :: !(Maybe [ToolCall])
  , messageToolName :: !(Maybe Text)
  , messageThinking :: !(Maybe Text)
  }
  deriving stock (Eq, Show, Generic)

instance ToJSON Message where
  toJSON Message {..} =
    object $
      catMaybes
        [ Just $ "role" .= messageRole
        , Just $ "content" .= messageContent
        , ("images" .=) <$> messageImages
        , ("tool_calls" .=) <$> messageToolCalls
        , ("tool_name" .=) <$> messageToolName
        , ("thinking" .=) <$> messageThinking
        ]

instance FromJSON Message where
  parseJSON = withObject "Message" $ \v ->
    Message
      <$> v .: "role"
      <*> v .: "content"
      <*> v .:? "images"
      <*> v .:? "tool_calls"
      <*> v .:? "tool_name"
      <*> v .:? "thinking"

{- | Create a 'User' role message.

@since 3.0.0.0
-}
userMessage :: Text -> Message
userMessage t = Message User t Nothing Nothing Nothing Nothing

{- | Create a 'System' role message.

@since 3.0.0.0
-}
systemMessage :: Text -> Message
systemMessage t = Message System t Nothing Nothing Nothing Nothing

{- | Create an 'Assistant' role message.

@since 3.0.0.0
-}
assistantMessage :: Text -> Message
assistantMessage t = Message Assistant t Nothing Nothing Nothing Nothing

{- | Create a 'Tool' role message.

@since 3.0.0.0
-}
toolMessage :: Text -> Message
toolMessage t = Message Tool t Nothing Nothing Nothing Nothing

{- | Create a 'Tool' role message with specific @tool_name@ informing the model of tool execution.

@since 3.0.0.0
-}
toolResultMessage :: Text -> Text -> Message
toolResultMessage content toolName =
  Message Tool content Nothing Nothing (Just toolName) Nothing

{- | Create a 'User' message with attached Base64 image data.

@since 3.0.0.0
-}
imageMessage :: Text -> [Base64Image] -> Message
imageMessage t imgs = Message User t (Just imgs) Nothing Nothing Nothing