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

{- |
Module      : Data.Ollama.Common.Config
Copyright   : (c) 2025 Tushar Adhatrao
License     : MIT
Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>
Stability   : experimental
Description : A unified configuration type for controlling Ollama client behavior.

== Overview

This module defines the core configuration record used throughout the Ollama Haskell client.

Use 'defaultOllamaConfig' as a starting point and customize it with helper functions
like 'withOnModelStart', 'withOnModelFinish', or 'withOnModelError'.

Includes settings for base URL, timeout, retry logic, and custom HTTP managers.
-}
module Data.Ollama.Common.Config
  ( -- * Configuration Type
    OllamaConfig (..)

    -- * Default Config
  , defaultOllamaConfig

    -- * Hook Helpers
  , withOnModelStart
  , withOnModelFinish
  , withOnModelError
  ) where

import Data.Text (Text)
import GHC.Generics
import Network.HTTP.Client

{- | Configuration for the Ollama client.
Used across all requests to customize behavior such as timeouts, retries,
custom HTTP manager, and lifecycle hooks.
--
-- @since 0.2.0.0
-}
data OllamaConfig = OllamaConfig
  { OllamaConfig -> Text
hostUrl :: Text
  -- ^ Base URL for the Ollama server (default: @http://127.0.0.1:11434@)
  , OllamaConfig -> Int
timeout :: Int
  -- ^ Timeout in seconds for API requests (ignored if 'commonManager' is set)
  , OllamaConfig -> Maybe (IO ())
onModelStart :: Maybe (IO ())
  -- ^ Callback executed when a model starts
  , OllamaConfig -> Maybe (IO ())
onModelError :: Maybe (IO ())
  -- ^ Callback executed if a model encounters an error
  , OllamaConfig -> Maybe (IO ())
onModelFinish :: Maybe (IO ())
  -- ^ Callback executed when a model finishes (not called on error)
  , OllamaConfig -> Maybe Int
retryCount :: Maybe Int
  -- ^ Number of retries on failure (default: @0@ if 'Nothing')
  , OllamaConfig -> Maybe Int
retryDelay :: Maybe Int
  -- ^ Delay between retries in seconds (if applicable)
  , OllamaConfig -> Maybe Manager
commonManager :: Maybe Manager
  -- ^ Shared HTTP manager; disables timeout and retry settings
  }
  deriving ((forall x. OllamaConfig -> Rep OllamaConfig x)
-> (forall x. Rep OllamaConfig x -> OllamaConfig)
-> Generic OllamaConfig
forall x. Rep OllamaConfig x -> OllamaConfig
forall x. OllamaConfig -> Rep OllamaConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OllamaConfig -> Rep OllamaConfig x
from :: forall x. OllamaConfig -> Rep OllamaConfig x
$cto :: forall x. Rep OllamaConfig x -> OllamaConfig
to :: forall x. Rep OllamaConfig x -> OllamaConfig
Generic)

{- | A default configuration pointing to @localhost:11434@ with 90s timeout
and no hooks or retry logic.
-}
defaultOllamaConfig :: OllamaConfig
defaultOllamaConfig :: OllamaConfig
defaultOllamaConfig =
  OllamaConfig
    { hostUrl :: Text
hostUrl = Text
"http://127.0.0.1:11434"
    , timeout :: Int
timeout = Int
90
    , onModelStart :: Maybe (IO ())
onModelStart = Maybe (IO ())
forall a. Maybe a
Nothing
    , onModelError :: Maybe (IO ())
onModelError = Maybe (IO ())
forall a. Maybe a
Nothing
    , onModelFinish :: Maybe (IO ())
onModelFinish = Maybe (IO ())
forall a. Maybe a
Nothing
    , retryCount :: Maybe Int
retryCount = Maybe Int
forall a. Maybe a
Nothing
    , retryDelay :: Maybe Int
retryDelay = Maybe Int
forall a. Maybe a
Nothing
    , commonManager :: Maybe Manager
commonManager = Maybe Manager
forall a. Maybe a
Nothing
    }

-- | Add a callback to be executed when a model starts.
withOnModelStart :: IO () -> OllamaConfig -> OllamaConfig
withOnModelStart :: IO () -> OllamaConfig -> OllamaConfig
withOnModelStart IO ()
f OllamaConfig
cfg = OllamaConfig
cfg {onModelStart = Just f}

-- | Add a callback to be executed when a model errors.
withOnModelError :: IO () -> OllamaConfig -> OllamaConfig
withOnModelError :: IO () -> OllamaConfig -> OllamaConfig
withOnModelError IO ()
f OllamaConfig
cfg = OllamaConfig
cfg {onModelError = Just f}

-- | Add a callback to be executed when a model finishes successfully.
withOnModelFinish :: IO () -> OllamaConfig -> OllamaConfig
withOnModelFinish :: IO () -> OllamaConfig -> OllamaConfig
withOnModelFinish IO ()
f OllamaConfig
cfg = OllamaConfig
cfg {onModelFinish = Just f}