{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedStrings #-}

{- |
Module      : Data.Ollama.Copy
Copyright   : (c) 2025 Tushar Adhatrao
License     : MIT
Maintainer  : Tushar Adhatrao <tusharadhatrao@gmail.com>
Stability   : experimental
Description : Functionality for copying models in the Ollama client.

This module provides functions to copy a model from a source name to a destination name using the Ollama API.
It includes both an IO-based function ('copyModel') and a monadic version ('copyModelM') for use in
'MonadIO' contexts. The copy operation is performed via a POST request to the "/api//copy" endpoint.

Example:

>>> copyModel "gemma3" "gemma3-copy" Nothing
Right ()
-}
module Data.Ollama.Copy
  ( -- * Copy Model API
    copyModel
  , copyModelM
  ) where

import Control.Monad.IO.Class (MonadIO (liftIO))
import Data.Aeson
import Data.Ollama.Common.Config (OllamaConfig (..))
import Data.Ollama.Common.Error (OllamaError)
import Data.Ollama.Common.Utils (nonJsonHandler, withOllamaRequest)
import Data.Text (Text)
import GHC.Generics

-- | Configuration for copying a model.
data CopyModelOps = CopyModelOps
  { CopyModelOps -> Text
source :: !Text
  -- ^ The name of the source model to copy.
  , CopyModelOps -> Text
destination :: !Text
  -- ^ The name of the destination model.
  }
  deriving (Int -> CopyModelOps -> ShowS
[CopyModelOps] -> ShowS
CopyModelOps -> String
(Int -> CopyModelOps -> ShowS)
-> (CopyModelOps -> String)
-> ([CopyModelOps] -> ShowS)
-> Show CopyModelOps
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CopyModelOps -> ShowS
showsPrec :: Int -> CopyModelOps -> ShowS
$cshow :: CopyModelOps -> String
show :: CopyModelOps -> String
$cshowList :: [CopyModelOps] -> ShowS
showList :: [CopyModelOps] -> ShowS
Show, CopyModelOps -> CopyModelOps -> Bool
(CopyModelOps -> CopyModelOps -> Bool)
-> (CopyModelOps -> CopyModelOps -> Bool) -> Eq CopyModelOps
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CopyModelOps -> CopyModelOps -> Bool
== :: CopyModelOps -> CopyModelOps -> Bool
$c/= :: CopyModelOps -> CopyModelOps -> Bool
/= :: CopyModelOps -> CopyModelOps -> Bool
Eq, (forall x. CopyModelOps -> Rep CopyModelOps x)
-> (forall x. Rep CopyModelOps x -> CopyModelOps)
-> Generic CopyModelOps
forall x. Rep CopyModelOps x -> CopyModelOps
forall x. CopyModelOps -> Rep CopyModelOps x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CopyModelOps -> Rep CopyModelOps x
from :: forall x. CopyModelOps -> Rep CopyModelOps x
$cto :: forall x. Rep CopyModelOps x -> CopyModelOps
to :: forall x. Rep CopyModelOps x -> CopyModelOps
Generic, [CopyModelOps] -> Value
[CopyModelOps] -> Encoding
CopyModelOps -> Bool
CopyModelOps -> Value
CopyModelOps -> Encoding
(CopyModelOps -> Value)
-> (CopyModelOps -> Encoding)
-> ([CopyModelOps] -> Value)
-> ([CopyModelOps] -> Encoding)
-> (CopyModelOps -> Bool)
-> ToJSON CopyModelOps
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: CopyModelOps -> Value
toJSON :: CopyModelOps -> Value
$ctoEncoding :: CopyModelOps -> Encoding
toEncoding :: CopyModelOps -> Encoding
$ctoJSONList :: [CopyModelOps] -> Value
toJSONList :: [CopyModelOps] -> Value
$ctoEncodingList :: [CopyModelOps] -> Encoding
toEncodingList :: [CopyModelOps] -> Encoding
$comitField :: CopyModelOps -> Bool
omitField :: CopyModelOps -> Bool
ToJSON)

{- | Copies a model from a source name to a destination name.

Sends a POST request to the "/api//copy" endpoint with the source and destination model names.
Returns 'Right ()' on success or 'Left' with an 'OllamaError' on failure.
Example:

>>> copyModel "gemma3" "gemma3-copy" Nothing
Right ()
-}
copyModel ::
  -- | Source model name
  Text ->
  -- | Destination model name
  Text ->
  -- | Optional 'OllamaConfig' (defaults to 'defaultOllamaConfig' if 'Nothing')
  Maybe OllamaConfig ->
  IO (Either OllamaError ())
copyModel :: Text -> Text -> Maybe OllamaConfig -> IO (Either OllamaError ())
copyModel
  Text
source_
  Text
destination_
  Maybe OllamaConfig
mbConfig = do
    let reqBody :: CopyModelOps
reqBody = CopyModelOps {source :: Text
source = Text
source_, destination :: Text
destination = Text
destination_}
    Text
-> ByteString
-> Maybe CopyModelOps
-> Maybe OllamaConfig
-> (Response BodyReader -> IO (Either OllamaError ()))
-> IO (Either OllamaError ())
forall payload response.
ToJSON payload =>
Text
-> ByteString
-> Maybe payload
-> Maybe OllamaConfig
-> (Response BodyReader -> IO (Either OllamaError response))
-> IO (Either OllamaError response)
withOllamaRequest
      Text
"/api//copy"
      ByteString
"POST"
      (CopyModelOps -> Maybe CopyModelOps
forall a. a -> Maybe a
Just CopyModelOps
reqBody)
      Maybe OllamaConfig
mbConfig
      ((Either OllamaError ByteString -> Either OllamaError ())
-> IO (Either OllamaError ByteString) -> IO (Either OllamaError ())
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((() -> ByteString -> ()
forall a b. a -> b -> a
const ()) (ByteString -> ())
-> Either OllamaError ByteString -> Either OllamaError ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (IO (Either OllamaError ByteString) -> IO (Either OllamaError ()))
-> (Response BodyReader -> IO (Either OllamaError ByteString))
-> Response BodyReader
-> IO (Either OllamaError ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response BodyReader -> IO (Either OllamaError ByteString)
nonJsonHandler)

{- | MonadIO version of 'copyModel' for use in monadic contexts.

Lifts the 'copyModel' function into a 'MonadIO' context, allowing it to be used in monadic computations.

Example:

>>> import Control.Monad.IO.Class
>>> runReaderT (copyModelM "gemma3" "gemma3-copy" Nothing) someContext
Right ()
-}
copyModelM :: MonadIO m => Text -> Text -> Maybe OllamaConfig -> m (Either OllamaError ())
copyModelM :: forall (m :: * -> *).
MonadIO m =>
Text -> Text -> Maybe OllamaConfig -> m (Either OllamaError ())
copyModelM Text
s Text
d Maybe OllamaConfig
mbCfg = IO (Either OllamaError ()) -> m (Either OllamaError ())
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either OllamaError ()) -> m (Either OllamaError ()))
-> IO (Either OllamaError ()) -> m (Either OllamaError ())
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe OllamaConfig -> IO (Either OllamaError ())
copyModel Text
s Text
d Maybe OllamaConfig
mbCfg