{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}

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

This module provides functions to delete a model from the Ollama server using its name. It includes
both an IO-based function ('deleteModel') and a monadic version ('deleteModelM') for use in
'MonadIO' contexts. The delete operation is performed via a DELETE request to the "/api//delete" endpoint.

Example:

>>> deleteModel "gemma3" Nothing
Right ()
-}
module Data.Ollama.Delete
  ( -- * Delete Model API
    deleteModel
  , deleteModelM
  ) 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)

-- | Request payload for deleting a model.
newtype DeleteModelReq
  = -- | The name of the model to delete.
    DeleteModelReq {DeleteModelReq -> Text
name :: Text}
  deriving newtype (Int -> DeleteModelReq -> ShowS
[DeleteModelReq] -> ShowS
DeleteModelReq -> String
(Int -> DeleteModelReq -> ShowS)
-> (DeleteModelReq -> String)
-> ([DeleteModelReq] -> ShowS)
-> Show DeleteModelReq
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeleteModelReq -> ShowS
showsPrec :: Int -> DeleteModelReq -> ShowS
$cshow :: DeleteModelReq -> String
show :: DeleteModelReq -> String
$cshowList :: [DeleteModelReq] -> ShowS
showList :: [DeleteModelReq] -> ShowS
Show, DeleteModelReq -> DeleteModelReq -> Bool
(DeleteModelReq -> DeleteModelReq -> Bool)
-> (DeleteModelReq -> DeleteModelReq -> Bool) -> Eq DeleteModelReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeleteModelReq -> DeleteModelReq -> Bool
== :: DeleteModelReq -> DeleteModelReq -> Bool
$c/= :: DeleteModelReq -> DeleteModelReq -> Bool
/= :: DeleteModelReq -> DeleteModelReq -> Bool
Eq)

instance ToJSON DeleteModelReq where
  toJSON :: DeleteModelReq -> Value
toJSON (DeleteModelReq Text
name_) = [Pair] -> Value
object [Key
"name" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
name_]

{- | Deletes a model from the Ollama server.

Sends a DELETE request to the "/api//delete" endpoint with the specified model name.
Returns 'Right ()' on success or 'Left' with an 'OllamaError' on failure.
-}
deleteModel ::
  -- | Model name to delete
  Text ->
  -- | Optional 'OllamaConfig' (defaults to 'defaultOllamaConfig' if 'Nothing')
  Maybe OllamaConfig ->
  IO (Either OllamaError ())
deleteModel :: Text -> Maybe OllamaConfig -> IO (Either OllamaError ())
deleteModel Text
modelName Maybe OllamaConfig
mbConfig = do
  let reqBody :: DeleteModelReq
reqBody = DeleteModelReq {name :: Text
name = Text
modelName}
  Text
-> ByteString
-> Maybe DeleteModelReq
-> 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//delete"
    ByteString
"DELETE"
    (DeleteModelReq -> Maybe DeleteModelReq
forall a. a -> Maybe a
Just DeleteModelReq
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 'deleteModel' for use in monadic contexts.

Lifts the 'deleteModel' function into a  context,
allowing it to be used in monadic computations.
-}
deleteModelM :: MonadIO m => Text -> Maybe OllamaConfig -> m (Either OllamaError ())
deleteModelM :: forall (m :: * -> *).
MonadIO m =>
Text -> Maybe OllamaConfig -> m (Either OllamaError ())
deleteModelM Text
t 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 -> Maybe OllamaConfig -> IO (Either OllamaError ())
deleteModel Text
t Maybe OllamaConfig
mbCfg