packages feed

llm-simple-0.4.2.0: src/LLM/Load/ProviderCatalog.hs

module LLM.Load.ProviderCatalog
  ( ProviderProtocol (..),
    ProviderCatalogItem (..),
    ProviderCatalogMap,
    defaultProviderCatalogMap,
    loadProviderCatalog,
    loadProviderCatalogForModelCatalog,
  )
where

import Control.Monad.Except (ExceptT (..), throwError)
import Control.Monad.IO.Class (liftIO)
import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), withText)
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Text (Text)
import Data.Text qualified as T
import GHC.Generics (Generic)
import LLM.Load.Types (LoadConfigError (..))
import LLM.Load.Utils (decodeJsonFile)
import System.Directory (doesFileExist)
import System.FilePath ((</>), takeDirectory)

data ProviderProtocol
  = OpenAIProtocol
  | ClaudeProtocol
  | GeminiProtocol
  | OllamaProtocol
  | DeepSeekProtocol
  deriving (Show, Eq, Ord)

instance ToJSON ProviderProtocol where
  toJSON = toJSON . protocolToText

instance FromJSON ProviderProtocol where
  parseJSON = withText "ProviderProtocol" $ \t ->
    case T.toLower t of
      "openai" -> pure OpenAIProtocol
      "claude" -> pure ClaudeProtocol
      "gemini" -> pure GeminiProtocol
      "ollama" -> pure OllamaProtocol
      "deepseek" -> pure DeepSeekProtocol
      other -> fail $ "unknown provider protocol: " <> T.unpack other

protocolToText :: ProviderProtocol -> Text
protocolToText = \case
  OpenAIProtocol -> "openai"
  ClaudeProtocol -> "claude"
  GeminiProtocol -> "gemini"
  OllamaProtocol -> "ollama"
  DeepSeekProtocol -> "deepseek"

data ProviderCatalogItem = ProviderCatalogItem
  { providerName :: Text,
    protocol :: ProviderProtocol,
    baseUrl :: Text,
    apiKeyEnv :: Maybe Text,
    baseUrlEnv :: Maybe Text
  }
  deriving (Show, Eq, Ord, Generic, FromJSON, ToJSON)

type ProviderCatalogMap = Map Text ProviderCatalogItem

defaultProviderCatalogMap :: ProviderCatalogMap
defaultProviderCatalogMap =
  Map.fromList
    [ ("openai", openaiItem),
      ("claude", claudeItem),
      ("gemini", geminiItem),
      ("deepseek", deepseekItem),
      ("ollama", ollamaItem)
    ]
  where
    openaiItem =
      ProviderCatalogItem
        { providerName = "openai",
          protocol = OpenAIProtocol,
          baseUrl = "https://api.openai.com",
          apiKeyEnv = Just "OPENAI_API_KEY",
          baseUrlEnv = Just "OPENAI_BASE_URL"
        }
    claudeItem =
      ProviderCatalogItem
        { providerName = "claude",
          protocol = ClaudeProtocol,
          baseUrl = "https://api.anthropic.com",
          apiKeyEnv = Just "CLAUDE_API_KEY",
          baseUrlEnv = Just "CLAUDE_BASE_URL"
        }
    geminiItem =
      ProviderCatalogItem
        { providerName = "gemini",
          protocol = GeminiProtocol,
          baseUrl = "https://generativelanguage.googleapis.com",
          apiKeyEnv = Just "GEMINI_API_KEY",
          baseUrlEnv = Just "GEMINI_BASE_URL"
        }
    deepseekItem =
      ProviderCatalogItem
        { providerName = "deepseek",
          protocol = DeepSeekProtocol,
          baseUrl = "https://api.deepseek.com",
          apiKeyEnv = Just "DEEPSEEK_API_KEY",
          baseUrlEnv = Just "DEEPSEEK_BASE_URL"
        }
    ollamaItem =
      ProviderCatalogItem
        { providerName = "ollama",
          protocol = OllamaProtocol,
          baseUrl = "http://localhost:11434",
          apiKeyEnv = Nothing,
          baseUrlEnv = Just "OLLAMA_BASE_URL"
        }

-- | Read a provider catalog file. Fails with 'LoadProviderCatalogError' if
-- the file cannot be read or parsed, or if two entries share a
-- @providerName@.
loadProviderCatalog :: FilePath -> ExceptT LoadConfigError IO ProviderCatalogMap
loadProviderCatalog filePath = do
  items <- decodeJsonFile filePath (LoadProviderCatalogError . T.pack)
  case duplicates (map (.providerName) items) of
    name : _ -> throwError (LoadProviderCatalogError ("duplicate providerName: " <> name))
    [] -> pure (Map.fromList [(item.providerName, item) | item <- items])
  where
    duplicates names = [n | (i, n) <- zip [0 :: Int ..] names, n `elem` take i names]

-- | Load providers for a model catalog path.
--
-- Built-in providers are always available. When @providers.json@ exists in the
-- same directory as the model catalog, its entries are merged on top: file
-- entries add new providers or override built-ins with the same
-- @providerName@.
loadProviderCatalogForModelCatalog :: FilePath -> ExceptT LoadConfigError IO ProviderCatalogMap
loadProviderCatalogForModelCatalog modelCatalogPath = do
  let providerPath = takeDirectory modelCatalogPath </> "providers.json"
  exists <- liftIO $ doesFileExist providerPath
  fileCatalog <-
    if exists
      then loadProviderCatalog providerPath
      else pure Map.empty
  pure $ Map.union fileCatalog defaultProviderCatalogMap