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

module Data.Ollama.Show
  ( -- * Show Model Info API
    showModel
  , showModelOps
  , ShowModelResponse (..)
  ) where

import Data.Aeson
import Data.Ollama.Common.Utils qualified as CU
import Data.Text (Text)
import Data.Text qualified as T
import GHC.Generics
import GHC.Int (Int64)
import Network.HTTP.Client

-- TODO: Add Options parameter
-- TODO: Add Context parameter

{- |
 #ShowModelOps#
 Input parameters for show model information.
-}
data ShowModelOps = ShowModelOps
  { ShowModelOps -> Text
name :: Text
  , ShowModelOps -> Maybe Bool
verbose :: Maybe Bool
  }
  deriving (Int -> ShowModelOps -> ShowS
[ShowModelOps] -> ShowS
ShowModelOps -> String
(Int -> ShowModelOps -> ShowS)
-> (ShowModelOps -> String)
-> ([ShowModelOps] -> ShowS)
-> Show ShowModelOps
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ShowModelOps -> ShowS
showsPrec :: Int -> ShowModelOps -> ShowS
$cshow :: ShowModelOps -> String
show :: ShowModelOps -> String
$cshowList :: [ShowModelOps] -> ShowS
showList :: [ShowModelOps] -> ShowS
Show, ShowModelOps -> ShowModelOps -> Bool
(ShowModelOps -> ShowModelOps -> Bool)
-> (ShowModelOps -> ShowModelOps -> Bool) -> Eq ShowModelOps
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ShowModelOps -> ShowModelOps -> Bool
== :: ShowModelOps -> ShowModelOps -> Bool
$c/= :: ShowModelOps -> ShowModelOps -> Bool
/= :: ShowModelOps -> ShowModelOps -> Bool
Eq, (forall x. ShowModelOps -> Rep ShowModelOps x)
-> (forall x. Rep ShowModelOps x -> ShowModelOps)
-> Generic ShowModelOps
forall x. Rep ShowModelOps x -> ShowModelOps
forall x. ShowModelOps -> Rep ShowModelOps x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ShowModelOps -> Rep ShowModelOps x
from :: forall x. ShowModelOps -> Rep ShowModelOps x
$cto :: forall x. Rep ShowModelOps x -> ShowModelOps
to :: forall x. Rep ShowModelOps x -> ShowModelOps
Generic, [ShowModelOps] -> Value
[ShowModelOps] -> Encoding
ShowModelOps -> Bool
ShowModelOps -> Value
ShowModelOps -> Encoding
(ShowModelOps -> Value)
-> (ShowModelOps -> Encoding)
-> ([ShowModelOps] -> Value)
-> ([ShowModelOps] -> Encoding)
-> (ShowModelOps -> Bool)
-> ToJSON ShowModelOps
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ShowModelOps -> Value
toJSON :: ShowModelOps -> Value
$ctoEncoding :: ShowModelOps -> Encoding
toEncoding :: ShowModelOps -> Encoding
$ctoJSONList :: [ShowModelOps] -> Value
toJSONList :: [ShowModelOps] -> Value
$ctoEncodingList :: [ShowModelOps] -> Encoding
toEncodingList :: [ShowModelOps] -> Encoding
$comitField :: ShowModelOps -> Bool
omitField :: ShowModelOps -> Bool
ToJSON)

{- |
 #ShowModelResponse#

 Ouput structure for show model information.
-}
data ShowModelResponse = ShowModelResponse
  { ShowModelResponse -> Text
modelFile :: Text
  , ShowModelResponse -> Text
parameters :: Text
  , ShowModelResponse -> Text
template :: Text
  , ShowModelResponse -> ModelDetails
details :: ModelDetails
  , ShowModelResponse -> ModelInfo
modelInfo :: ModelInfo
  }
  deriving (Int -> ShowModelResponse -> ShowS
[ShowModelResponse] -> ShowS
ShowModelResponse -> String
(Int -> ShowModelResponse -> ShowS)
-> (ShowModelResponse -> String)
-> ([ShowModelResponse] -> ShowS)
-> Show ShowModelResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ShowModelResponse -> ShowS
showsPrec :: Int -> ShowModelResponse -> ShowS
$cshow :: ShowModelResponse -> String
show :: ShowModelResponse -> String
$cshowList :: [ShowModelResponse] -> ShowS
showList :: [ShowModelResponse] -> ShowS
Show, ShowModelResponse -> ShowModelResponse -> Bool
(ShowModelResponse -> ShowModelResponse -> Bool)
-> (ShowModelResponse -> ShowModelResponse -> Bool)
-> Eq ShowModelResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ShowModelResponse -> ShowModelResponse -> Bool
== :: ShowModelResponse -> ShowModelResponse -> Bool
$c/= :: ShowModelResponse -> ShowModelResponse -> Bool
/= :: ShowModelResponse -> ShowModelResponse -> Bool
Eq)

data ModelDetails = ModelDetails
  { ModelDetails -> Text
parentModel :: Text
  , ModelDetails -> Text
format :: Text
  , ModelDetails -> Text
familiy :: Text
  , ModelDetails -> [Text]
families :: [Text]
  , ModelDetails -> Text
parameterSize :: Text
  , ModelDetails -> Text
quantizationLevel :: Text
  }
  deriving (Int -> ModelDetails -> ShowS
[ModelDetails] -> ShowS
ModelDetails -> String
(Int -> ModelDetails -> ShowS)
-> (ModelDetails -> String)
-> ([ModelDetails] -> ShowS)
-> Show ModelDetails
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModelDetails -> ShowS
showsPrec :: Int -> ModelDetails -> ShowS
$cshow :: ModelDetails -> String
show :: ModelDetails -> String
$cshowList :: [ModelDetails] -> ShowS
showList :: [ModelDetails] -> ShowS
Show, ModelDetails -> ModelDetails -> Bool
(ModelDetails -> ModelDetails -> Bool)
-> (ModelDetails -> ModelDetails -> Bool) -> Eq ModelDetails
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModelDetails -> ModelDetails -> Bool
== :: ModelDetails -> ModelDetails -> Bool
$c/= :: ModelDetails -> ModelDetails -> Bool
/= :: ModelDetails -> ModelDetails -> Bool
Eq)

data ModelInfo = ModelInfo
  { ModelInfo -> Maybe Text
generalArchitecture :: Maybe Text
  , ModelInfo -> Maybe Int
generalFileType :: Maybe Int
  , ModelInfo -> Maybe Int64
generalParameterCount :: Maybe Int64
  , ModelInfo -> Maybe Int
generalQuantizationVersion :: Maybe Int
  , ModelInfo -> Maybe Int
llamaAttentionHeadCount :: Maybe Int
  , ModelInfo -> Maybe Int
llamaAttentionHeadCountKV :: Maybe Int
  , ModelInfo -> Maybe Float
llamaAttentionLayerNormRMSEpsilon :: Maybe Float
  , ModelInfo -> Maybe Int
llamaBlockCount :: Maybe Int
  , ModelInfo -> Maybe Int
llamaContextLength :: Maybe Int
  , ModelInfo -> Maybe Int
llamaEmbeddingLength :: Maybe Int
  , ModelInfo -> Maybe Int
llamaFeedForwardLength :: Maybe Int
  , ModelInfo -> Maybe Int
llamaRopeDimensionCount :: Maybe Int
  , ModelInfo -> Maybe Int64
llamaRopeFreqBase :: Maybe Int64
  , ModelInfo -> Maybe Int64
llamaVocabSize :: Maybe Int64
  , ModelInfo -> Maybe Int
tokenizerGgmlBosToken_id :: Maybe Int
  , ModelInfo -> Maybe Int
tokenizerGgmlEosToken_id :: Maybe Int
  , ModelInfo -> Maybe [Text]
tokenizerGgmlMerges :: Maybe [Text]
  , ModelInfo -> Maybe Text
tokenizerGgmlMode :: Maybe Text
  , ModelInfo -> Maybe Text
tokenizerGgmlPre :: Maybe Text
  , ModelInfo -> Maybe [Text]
tokenizerGgmlTokenType :: Maybe [Text]
  , ModelInfo -> Maybe [Text]
tokenizerGgmlTokens :: Maybe [Text]
  }
  deriving (Int -> ModelInfo -> ShowS
[ModelInfo] -> ShowS
ModelInfo -> String
(Int -> ModelInfo -> ShowS)
-> (ModelInfo -> String)
-> ([ModelInfo] -> ShowS)
-> Show ModelInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModelInfo -> ShowS
showsPrec :: Int -> ModelInfo -> ShowS
$cshow :: ModelInfo -> String
show :: ModelInfo -> String
$cshowList :: [ModelInfo] -> ShowS
showList :: [ModelInfo] -> ShowS
Show, ModelInfo -> ModelInfo -> Bool
(ModelInfo -> ModelInfo -> Bool)
-> (ModelInfo -> ModelInfo -> Bool) -> Eq ModelInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModelInfo -> ModelInfo -> Bool
== :: ModelInfo -> ModelInfo -> Bool
$c/= :: ModelInfo -> ModelInfo -> Bool
/= :: ModelInfo -> ModelInfo -> Bool
Eq)

-- FromJSON instances

-- | The instance for show model response
instance FromJSON ShowModelResponse where
  parseJSON :: Value -> Parser ShowModelResponse
parseJSON = String
-> (Object -> Parser ShowModelResponse)
-> Value
-> Parser ShowModelResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ShowModelResponse" ((Object -> Parser ShowModelResponse)
 -> Value -> Parser ShowModelResponse)
-> (Object -> Parser ShowModelResponse)
-> Value
-> Parser ShowModelResponse
forall a b. (a -> b) -> a -> b
$ \Object
v ->
    Text
-> Text -> Text -> ModelDetails -> ModelInfo -> ShowModelResponse
ShowModelResponse
      (Text
 -> Text -> Text -> ModelDetails -> ModelInfo -> ShowModelResponse)
-> Parser Text
-> Parser
     (Text -> Text -> ModelDetails -> ModelInfo -> ShowModelResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"modelfile"
      Parser
  (Text -> Text -> ModelDetails -> ModelInfo -> ShowModelResponse)
-> Parser Text
-> Parser (Text -> ModelDetails -> ModelInfo -> ShowModelResponse)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"parameters"
      Parser (Text -> ModelDetails -> ModelInfo -> ShowModelResponse)
-> Parser Text
-> Parser (ModelDetails -> ModelInfo -> ShowModelResponse)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"template"
      Parser (ModelDetails -> ModelInfo -> ShowModelResponse)
-> Parser ModelDetails -> Parser (ModelInfo -> ShowModelResponse)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser ModelDetails
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"details"
      Parser (ModelInfo -> ShowModelResponse)
-> Parser ModelInfo -> Parser ShowModelResponse
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser ModelInfo
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"model_info"

instance FromJSON ModelDetails where
  parseJSON :: Value -> Parser ModelDetails
parseJSON = String
-> (Object -> Parser ModelDetails) -> Value -> Parser ModelDetails
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ModelDetails" ((Object -> Parser ModelDetails) -> Value -> Parser ModelDetails)
-> (Object -> Parser ModelDetails) -> Value -> Parser ModelDetails
forall a b. (a -> b) -> a -> b
$ \Object
v ->
    Text -> Text -> Text -> [Text] -> Text -> Text -> ModelDetails
ModelDetails
      (Text -> Text -> Text -> [Text] -> Text -> Text -> ModelDetails)
-> Parser Text
-> Parser (Text -> Text -> [Text] -> Text -> Text -> ModelDetails)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"parent_model"
      Parser (Text -> Text -> [Text] -> Text -> Text -> ModelDetails)
-> Parser Text
-> Parser (Text -> [Text] -> Text -> Text -> ModelDetails)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"format"
      Parser (Text -> [Text] -> Text -> Text -> ModelDetails)
-> Parser Text -> Parser ([Text] -> Text -> Text -> ModelDetails)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"family"
      Parser ([Text] -> Text -> Text -> ModelDetails)
-> Parser [Text] -> Parser (Text -> Text -> ModelDetails)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser [Text]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"families"
      Parser (Text -> Text -> ModelDetails)
-> Parser Text -> Parser (Text -> ModelDetails)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"parameter_size"
      Parser (Text -> ModelDetails) -> Parser Text -> Parser ModelDetails
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"quantization_level"

instance FromJSON ModelInfo where
  parseJSON :: Value -> Parser ModelInfo
parseJSON = String -> (Object -> Parser ModelInfo) -> Value -> Parser ModelInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ModelInfo" ((Object -> Parser ModelInfo) -> Value -> Parser ModelInfo)
-> (Object -> Parser ModelInfo) -> Value -> Parser ModelInfo
forall a b. (a -> b) -> a -> b
$ \Object
v ->
    Maybe Text
-> Maybe Int
-> Maybe Int64
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Float
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int64
-> Maybe Int64
-> Maybe Int
-> Maybe Int
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe [Text]
-> Maybe [Text]
-> ModelInfo
ModelInfo
      (Maybe Text
 -> Maybe Int
 -> Maybe Int64
 -> Maybe Int
 -> Maybe Int
 -> Maybe Int
 -> Maybe Float
 -> Maybe Int
 -> Maybe Int
 -> Maybe Int
 -> Maybe Int
 -> Maybe Int
 -> Maybe Int64
 -> Maybe Int64
 -> Maybe Int
 -> Maybe Int
 -> Maybe [Text]
 -> Maybe Text
 -> Maybe Text
 -> Maybe [Text]
 -> Maybe [Text]
 -> ModelInfo)
-> Parser (Maybe Text)
-> Parser
     (Maybe Int
      -> Maybe Int64
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Float
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int64
      -> Maybe Int64
      -> Maybe Int
      -> Maybe Int
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe [Text]
      -> ModelInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"general.architecture"
      Parser
  (Maybe Int
   -> Maybe Int64
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Float
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int64
   -> Maybe Int64
   -> Maybe Int
   -> Maybe Int
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe [Text]
   -> ModelInfo)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int64
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Float
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int64
      -> Maybe Int64
      -> Maybe Int
      -> Maybe Int
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe [Text]
      -> ModelInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"general.file_type"
      Parser
  (Maybe Int64
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Float
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int64
   -> Maybe Int64
   -> Maybe Int
   -> Maybe Int
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe [Text]
   -> ModelInfo)
-> Parser (Maybe Int64)
-> Parser
     (Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Float
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int64
      -> Maybe Int64
      -> Maybe Int
      -> Maybe Int
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe [Text]
      -> ModelInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Int64)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"general.parameter_count"
      Parser
  (Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Float
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int64
   -> Maybe Int64
   -> Maybe Int
   -> Maybe Int
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe [Text]
   -> ModelInfo)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int
      -> Maybe Int
      -> Maybe Float
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int64
      -> Maybe Int64
      -> Maybe Int
      -> Maybe Int
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe [Text]
      -> ModelInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"general.quantization_version"
      Parser
  (Maybe Int
   -> Maybe Int
   -> Maybe Float
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int64
   -> Maybe Int64
   -> Maybe Int
   -> Maybe Int
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe [Text]
   -> ModelInfo)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int
      -> Maybe Float
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int64
      -> Maybe Int64
      -> Maybe Int
      -> Maybe Int
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe [Text]
      -> ModelInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"llama.attention.head_count"
      Parser
  (Maybe Int
   -> Maybe Float
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int64
   -> Maybe Int64
   -> Maybe Int
   -> Maybe Int
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe [Text]
   -> ModelInfo)
-> Parser (Maybe Int)
-> Parser
     (Maybe Float
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int64
      -> Maybe Int64
      -> Maybe Int
      -> Maybe Int
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe [Text]
      -> ModelInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"llama.attention.head_count_kv"
      Parser
  (Maybe Float
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int64
   -> Maybe Int64
   -> Maybe Int
   -> Maybe Int
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe [Text]
   -> ModelInfo)
-> Parser (Maybe Float)
-> Parser
     (Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int64
      -> Maybe Int64
      -> Maybe Int
      -> Maybe Int
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe [Text]
      -> ModelInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Float)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"llama.attention.layer_norm_rms_epsilon"
      Parser
  (Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int64
   -> Maybe Int64
   -> Maybe Int
   -> Maybe Int
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe [Text]
   -> ModelInfo)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int64
      -> Maybe Int64
      -> Maybe Int
      -> Maybe Int
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe [Text]
      -> ModelInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"llama.block_count"
      Parser
  (Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int64
   -> Maybe Int64
   -> Maybe Int
   -> Maybe Int
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe [Text]
   -> ModelInfo)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int
      -> Maybe Int
      -> Maybe Int
      -> Maybe Int64
      -> Maybe Int64
      -> Maybe Int
      -> Maybe Int
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe [Text]
      -> ModelInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"llama.context_length"
      Parser
  (Maybe Int
   -> Maybe Int
   -> Maybe Int
   -> Maybe Int64
   -> Maybe Int64
   -> Maybe Int
   -> Maybe Int
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe [Text]
   -> ModelInfo)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int
      -> Maybe Int
      -> Maybe Int64
      -> Maybe Int64
      -> Maybe Int
      -> Maybe Int
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe [Text]
      -> ModelInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"llama.embedding_length"
      Parser
  (Maybe Int
   -> Maybe Int
   -> Maybe Int64
   -> Maybe Int64
   -> Maybe Int
   -> Maybe Int
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe [Text]
   -> ModelInfo)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int
      -> Maybe Int64
      -> Maybe Int64
      -> Maybe Int
      -> Maybe Int
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe [Text]
      -> ModelInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"llama.feed_forward_length"
      Parser
  (Maybe Int
   -> Maybe Int64
   -> Maybe Int64
   -> Maybe Int
   -> Maybe Int
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe [Text]
   -> ModelInfo)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int64
      -> Maybe Int64
      -> Maybe Int
      -> Maybe Int
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe [Text]
      -> ModelInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"llama.rope.dimension_count"
      Parser
  (Maybe Int64
   -> Maybe Int64
   -> Maybe Int
   -> Maybe Int
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe [Text]
   -> ModelInfo)
-> Parser (Maybe Int64)
-> Parser
     (Maybe Int64
      -> Maybe Int
      -> Maybe Int
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe [Text]
      -> ModelInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Int64)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"llama.rope.freq_base"
      Parser
  (Maybe Int64
   -> Maybe Int
   -> Maybe Int
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe [Text]
   -> ModelInfo)
-> Parser (Maybe Int64)
-> Parser
     (Maybe Int
      -> Maybe Int
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe [Text]
      -> ModelInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Int64)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"llama.vocab_size"
      Parser
  (Maybe Int
   -> Maybe Int
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe [Text]
   -> ModelInfo)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe [Text]
      -> ModelInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"tokenizer.ggml.bos_token_id"
      Parser
  (Maybe Int
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe [Text]
   -> ModelInfo)
-> Parser (Maybe Int)
-> Parser
     (Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe [Text]
      -> ModelInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"tokenizer.ggml.eos_token_id"
      Parser
  (Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe [Text]
   -> ModelInfo)
-> Parser (Maybe [Text])
-> Parser
     (Maybe Text
      -> Maybe Text -> Maybe [Text] -> Maybe [Text] -> ModelInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"tokenizer.ggml.merges"
      Parser
  (Maybe Text
   -> Maybe Text -> Maybe [Text] -> Maybe [Text] -> ModelInfo)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe [Text] -> Maybe [Text] -> ModelInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"tokenizer.ggml.model"
      Parser (Maybe Text -> Maybe [Text] -> Maybe [Text] -> ModelInfo)
-> Parser (Maybe Text)
-> Parser (Maybe [Text] -> Maybe [Text] -> ModelInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"tokenizer.ggml.pre"
      Parser (Maybe [Text] -> Maybe [Text] -> ModelInfo)
-> Parser (Maybe [Text]) -> Parser (Maybe [Text] -> ModelInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"tokenizer.ggml.token_type"
      Parser (Maybe [Text] -> ModelInfo)
-> Parser (Maybe [Text]) -> Parser ModelInfo
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"tokenizer.ggml.tokens"

{- | Show given model's information with options.

@since 1.0.0.0
-}
showModelOps ::
  -- | model name
  Text ->
  -- | verbose
  Maybe Bool ->
  IO (Maybe ShowModelResponse)
showModelOps :: Text -> Maybe Bool -> IO (Maybe ShowModelResponse)
showModelOps
  Text
modelName
  Maybe Bool
verbose =
    do
      let url :: Text
url = OllamaClient -> Text
CU.host OllamaClient
CU.defaultOllama
      Manager
manager <- ManagerSettings -> IO Manager
newManager ManagerSettings
defaultManagerSettings
      Request
initialRequest <- String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest (String -> IO Request) -> String -> IO Request
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text
url Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/api/show")
      let reqBody :: ShowModelOps
reqBody =
            ShowModelOps
              { $sel:name:ShowModelOps :: Text
name = Text
modelName
              , $sel:verbose:ShowModelOps :: Maybe Bool
verbose = Maybe Bool
verbose
              }
          request :: Request
request =
            Request
initialRequest
              { method = "POST"
              , requestBody = RequestBodyLBS $ encode reqBody
              }
      Response ByteString
response <- Request -> Manager -> IO (Response ByteString)
httpLbs Request
request Manager
manager
      let eRes :: Either String ShowModelResponse
eRes =
            ByteString -> Either String ShowModelResponse
forall a. FromJSON a => ByteString -> Either String a
eitherDecode (Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
response) ::
              Either String ShowModelResponse
      case Either String ShowModelResponse
eRes of
        Left String
_ -> Maybe ShowModelResponse -> IO (Maybe ShowModelResponse)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ShowModelResponse
forall a. Maybe a
Nothing
        Right ShowModelResponse
r -> Maybe ShowModelResponse -> IO (Maybe ShowModelResponse)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ShowModelResponse -> IO (Maybe ShowModelResponse))
-> Maybe ShowModelResponse -> IO (Maybe ShowModelResponse)
forall a b. (a -> b) -> a -> b
$ ShowModelResponse -> Maybe ShowModelResponse
forall a. a -> Maybe a
Just ShowModelResponse
r

{- | Show given model's information.

Higher level API for show.
@since 1.0.0.0
-}
showModel ::
  -- | model name
  Text ->
  IO (Maybe ShowModelResponse)
showModel :: Text -> IO (Maybe ShowModelResponse)
showModel Text
modelName =
  Text -> Maybe Bool -> IO (Maybe ShowModelResponse)
showModelOps Text
modelName Maybe Bool
forall a. Maybe a
Nothing