ollama-haskell-0.2.1.0: test/Test/Ollama/Create.hs
{-# LANGUAGE OverloadedStrings #-}
module Test.Ollama.Create (tests) where
import Control.Monad (void)
import Data.Maybe (isNothing)
import Data.Ollama.Common.Types (ModelOptions (..))
import Data.Ollama.Common.Utils (defaultModelOptions)
import Data.Ollama.Create
import Data.Ollama.Delete (deleteModel)
import Test.Tasty
import Test.Tasty.HUnit
testCreateModelBasic :: TestTree
testCreateModelBasic = testCase "Create model: basic from existing model" $ do
let ops =
(defaultCreateOps "test-model-basic")
{ fromModel = Just "gemma3"
, systemPrompt = Just "You are a helpful assistant."
}
createModel ops Nothing
assertBool "Create should complete without error" True
void $ deleteModel "test-model-basic" Nothing
testCreateModelWithQuantization :: TestTree
testCreateModelWithQuantization = testCase "Create model: with quantization" $ do
let ops =
(defaultCreateOps "test-model-quantized")
{ fromModel = Just "gemma3"
, quantizeType = Just Q4_K_M
}
createModel ops Nothing
assertBool "Quantization request should complete" True
void $ deleteModel "test-model-quantized" Nothing
testCreateModelWithParameters :: TestTree
testCreateModelWithParameters = testCase "Create model: with custom parameters" $ do
let modelOpts =
defaultModelOptions
{ temperature = Just 0.7
, topP = Just 0.9
, topK = Just 40
}
ops =
(defaultCreateOps "test-model-params")
{ fromModel = Just "gemma3"
, parameters = Just modelOpts
, template = Just "Custom template: {{.Prompt}}"
}
createModel ops Nothing
assertBool "Custom parameters should be handled" True
void $ deleteModel "test-model-params" Nothing
testQuantizationTypeValues :: TestTree
testQuantizationTypeValues = testCase "Quantization types: should have valid values" $ do
let q1 = Q4_K_M
q2 = Q4_K_S
q3 = Q8_0
assertBool "Q4_K_M should be valid" (show q1 == "Q4_K_M")
assertBool "Q4_K_S should be valid" (show q2 == "Q4_K_S")
assertBool "Q8_0 should be valid" (show q3 == "Q8_0")
testCreateModelFieldAccess :: TestTree
testCreateModelFieldAccess = testCase "CreateOps: field access should work" $ do
let ops = defaultCreateOps "test-model"
assertBool "modelName should be accessible" (modelName ops == "test-model")
assertBool "fromModel should be Nothing by default" (isNothing (fromModel ops))
assertBool "files should be Nothing by default" (isNothing (files ops))
tests :: TestTree
tests =
testGroup
"Create tests"
[ testCreateModelBasic
, testCreateModelWithQuantization
, testCreateModelWithParameters
, testQuantizationTypeValues
, testCreateModelFieldAccess
]