diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for llm-with-context + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2025 lazyLambda + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/llm-with-context.cabal b/llm-with-context.cabal new file mode 100644 --- /dev/null +++ b/llm-with-context.cabal @@ -0,0 +1,46 @@ +cabal-version: 3.0 +name: llm-with-context +version: 0.1.0.0 +synopsis: + Typified interactions with LLMs +description: + Using Proxy and StateT we manage a typed conversation with conversation history. We can also perform more customized qqueries of history to be included in the next response. +license: MIT +license-file: LICENSE +author: lazyLambda +maintainer: galen.sprout@gmail.com +-- copyright: +category: AI +build-type: Simple +extra-doc-files: CHANGELOG.md +-- extra-source-files: +source-repository head + type: git + location: https://github.com/augyg/llm-with-context + +common warnings + ghc-options: -Wall + +library + import: warnings + exposed-modules: LLM.LLM + LLM.ScrubPrefix + LLM.Types + -- other-modules: + -- other-extensions: + build-depends: aeson >= 2.2.3 && < 2.3 + , base >= 4.20.2 && < 4.21 + , bytestring >= 0.12.2 && < 0.13 + , containers >= 0.7 && < 0.8 + , data-default >= 0.8.0 && < 0.9 + , directory >= 1.3.8 && < 1.4 + , http-client >= 0.7.19 && < 0.8 + , http-client-tls >= 0.3.6 && < 0.4 + , http-types >= 0.12.4 && < 0.13 + , parsec >= 3.1.18 && < 3.2 + , scrappy-core >= 0.1.0 && < 0.2 + , text >= 2.1.3 && < 2.2 + , transformers >= 0.6.1 && < 0.7 + + hs-source-dirs: src + default-language: Haskell2010 diff --git a/src/LLM/LLM.hs b/src/LLM/LLM.hs new file mode 100644 --- /dev/null +++ b/src/LLM/LLM.hs @@ -0,0 +1,378 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module LLM.LLM where + +import LLM.Types + +import Scrappy.Elem as S hiding (Tag) + +import Network.HTTP.Client hiding (Proxy) +import Network.HTTP.Types.Header + +import Control.Monad.IO.Class +import Control.Monad.Trans.State +import Control.Exception as CE +import Data.Bifunctor +import Data.Aeson as Aeson +import Text.Parsec as Psc +import Data.Typeable +import Data.Default +import Text.Read (readEither) +import Data.Maybe (catMaybes) +import qualified Data.List as L +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Data.ByteString.Lazy as LBS + +tshow :: Show a => a -> T.Text +tshow = T.pack . show + + + +mkDSPrompt :: DeepSeekModel -> [ContentWithRole] -> DeepSeekRequestBody +mkDSPrompt dsModel cwrs = def + { _deepSeekRequest_model = dsModel + , _deepSeekRequest_messages = cwrs + } + + + +getRelevant :: RelevantContext +getRelevant = LastNRelevant 10 $ \(Tag t) -> T.isPrefixOf "html" t + +renderHistory :: ConversationHistory -> ContentWithRole +renderHistory = cwr Assistant . ((<>) "Our conversation history so far:") . T.intercalate "\n" . fmap renderItem + where + renderItem (GPTQuery _ (GPTQuestion q) (GPTAnswer a)) = + "Me: " <> (T.decodeUtf8 . LBS.toStrict . Aeson.encode) q <> "\n" <> "ChatGPT: " <> a + + + + +getRelevantCtx :: MonadIO m => RelevantContext -> MonadGPT m ConversationHistory +getRelevantCtx = \case + LastN n -> gets (take n) + Relevants tags -> gets (flip finds tags) + LastNRelevant n anonF -> gets (\x -> + take n + . filter (anonF . _gptQuery_tag) $ x + ) + where + finds hist tags = + catMaybes $ fmap (\t -> L.find (\h -> t == _gptQuery_tag h) hist) tags + +getRelevantCtxDeepSeek :: MonadIO m => RelevantContextDS -> MonadDeepSeek m ConversationHistoryDeepSeek +getRelevantCtxDeepSeek = \case + LastN_DS n -> gets (take n) + Relevants_DS tags -> gets (flip finds tags) + LastNRelevant_DS n anonF -> gets (\historyTotal -> + take n + . filter (\(historyItem :: (TagDS, [ContentWithRole])) -> + anonF . fst $ historyItem + ) $ historyTotal + ) + where + finds hist tags = + catMaybes $ fmap (\t -> L.find (\h -> t == fst h) hist) tags + + +-- testctx :: MonadIO m => MonadGPT m () +-- testctx = do +-- mgr <- liftIO $ newManager tlsManagerSettings +-- k <- liftIO $ fmap T.pack $ readFile "config/backend/gptAPIKey" +-- r1 <- askGPTWithContext k mgr (LastN 10) (Tag "Name", GPTQuestion [cwr User "my name is galen"]) +-- r2 <- askGPTWithContext k mgr (LastN 10) (Tag "Hey", GPTQuestion [cwr User "please tell me what my name is"]) +-- r3 :: Either GPTError (GPTAnswer Int) <- askGPTWithContextTyped k mgr (LastN 10) (Tag "Hey", GPTQuestion [cwr User "how many letters in my name"]) +-- r4 :: Either GPTError (GPTAnswer Int) <- askGPTWithContextTyped k mgr (Relevants [Tag "Name"]) (Tag "Hey", GPTQuestion [cwr User "how many letters in my name"]) +-- r5 :: Either GPTError (GPTAnswer Int) <- askGPTWithContextTyped k mgr (Relevants []) (Tag "Hey", GPTQuestion [cwr User "how many letters in my name"]) +-- r6 :: Either GPTError (GPTAnswer Int) <- askGPTWithContextTyped k mgr (LastN 0) (Tag "Hey", GPTQuestion [cwr User "how many letters in my name"]) +-- liftIO $ print r1 +-- liftIO $ print r2 +-- liftIO $ print r3 +-- liftIO $ print r4 +-- liftIO $ print r5 +-- liftIO $ print r6 +-- pure () + +askGPTWithContextTyped + :: forall m a. + ( Typeable a + , Read a + , MonadIO m + ) + => APIKey 'OpenAI + -> Manager + -> TokenLimit + -> RelevantContext + -> (Tag, GPTQuestion) + -> MonadGPT m (Either GPTError (GPTAnswer a)) +askGPTWithContextTyped key mgr tokenLimit relCtx (thisTag, GPTQuestion contents) = do + let typeProxy = Proxy :: Proxy a + let returnT = gptReturnType typeProxy + let + readEitherText :: T.Text -> Either T.Text a + readEitherText = first T.pack . readEither2 . T.unpack + where + readEither2 x = case readEither x of + Right a -> Right a + Left _ -> case readEither $ "\"" <> x <> "\"" of + Right a -> Right a + Left _ -> readEither $ "\"" <> (T.unpack $ escapeText $ T.pack x) <> "\"" + + ctx <- renderHistory <$> getRelevantCtx relCtx + askGPT key mgr tokenLimit (ctx : contents <> returnT) >>= \case + Left e -> pure . Left . GPTError $ e + Right txt -> case readEitherText txt of + Left e -> pure . Left . GPTError $ + e <> "When reading return type: (x :: " <> (T.pack . show $ typeRep proxy ) <> ") from base response: " <> txt + <> "From Prompt: " + <> (T.pack $ show (ctx : contents <> returnT)) + + Right typed -> do + let new = GPTQuery thisTag (GPTQuestion contents) (GPTAnswer txt) + modify ((:) new) + pure . Right . GPTAnswer $ typed + +askGPTWithContext + :: MonadIO m + => APIKey 'OpenAI + -> Manager + -> TokenLimit + -> RelevantContext + -> (Tag, GPTQuestion) + -> MonadGPT m (Either GPTError (GPTAnswer T.Text)) +askGPTWithContext key mgr maxTokens relCtx (thisTag, GPTQuestion contents) = do + histItems <- getRelevantCtx relCtx + askGPT key mgr maxTokens (renderHistory histItems : contents) >>= \case + Left e -> pure $ Left $ GPTError e + Right answer -> do + let new = GPTQuery thisTag (GPTQuestion contents) (GPTAnswer answer) + modify ((:) new) + pure $ Right $ GPTAnswer answer + + + + + +-- Script flow: + -- give Title and unique story to focus on + -- + give instructions for any script (factuality, stats-heavy, clips direction etc.) + -- + category specific instructions + -- Instruct DeepSeek to return a high level outline of what the script should be as JSON + -- JSON: + -- { "title": ::String + -- , "sections" : [ { "section_title": + -- , "suggested_word_count": Int + -- , "predicted_time_seconds": Int + -- , "section_overview": + -- } + -- , ] + -- } + + +-- runStateAction :: MonadIO m => Manager -> DeepSeekModel -> [ContentWithRole] -> MonadDeepSeek m (Either GPTError DeepSeekAnswer) +-- runStateAction mgr modelChoice cwrs = askDeepSeekWithContext mgr modelChoice (LastN_DS 1000) (TagDS "sometag" False, DeepSeekQuestion cwrs) + + +askDeepSeekWithContext + :: MonadIO m + => Manager + -> DeepSeekModel + -> RelevantContextDS + -> (TagDS, DeepSeekQuestion) + -> MonadDeepSeek m (Either GPTError DeepSeekAnswer) +askDeepSeekWithContext mgr modelDS relCtx (thisTag, DeepSeekQuestion contents) = do + + + + histItems <- getRelevantCtxDeepSeek relCtx + let + historyAtNow = (mconcat $ reverse $ fmap snd histItems) + fullCWRs = historyAtNow <> contents -- [1,2] <> [3] --> [1,2,3] + + deepSeekResult <- askDeepSeek mgr modelDS $ fullCWRs + + case deepSeekResult of + Left e -> pure $ Left . GPTError $ e + Right res -> do + let newAnswer = _deepSeekResponse_message res + modify (\state_ -> + let question = (thisTag, contents) + answer = (TagDS (unTagDS thisTag) True, [newAnswer]) + in + answer : question : state_ + ) + pure $ Right . GPTAnswer $ newAnswer + +-- | TODO: Configure temperature for less variability +-- | Todo: we should probably use scrappy here so that we dont care about prefixing/position +askGPTTyped + :: forall m a. + ( MonadIO m + , Typeable a + , Read a + ) + => APIKey 'OpenAI + -> Manager + -> TokenLimit + -> GPTQuestion + -> m (Either GPTError (GPTAnswer a)) +askGPTTyped apiKey mgr maxTokens (GPTQuestion prompt) = do + let typeProxy = Proxy :: Proxy a + let returnT = gptReturnType typeProxy -- "Please only respond with nothing but the haskell type Map Int Int" + let + readEitherText :: T.Text -> Either T.Text a + readEitherText = first T.pack . readEither2 . T.unpack + where readEither2 x = case readEither x of + Right a -> Right a + Left _ -> readEither $ "\"" <> escape x <> "\"" + --Right a -> Right a + + + r <- askGPT apiKey mgr maxTokens $ prompt <> returnT + pure . bimap GPTError GPTAnswer $ readEitherText =<< r + +escapeText :: T.Text -> T.Text +escapeText = T.concatMap escapeChar + where + escapeChar '\"' = "\\\"" + escapeChar '\\' = "\\\\" + escapeChar c = T.singleton c + + +escape :: String -> String +escape = concatMap esc + where + escchars :: String + escchars = "$\\^.*~[]" + esc c | c `elem` escchars = ['\\',c] + | otherwise = [c] + +gptReturnType :: forall a. Typeable a => Proxy a -> [ContentWithRole] +gptReturnType typeProxy = + let + typeInfo = T.pack $ show (typeRep typeProxy) + in + if typeInfo == "Text" || typeInfo == "String" + then [] + else [ cwr System $ "In responding to the above question, give me only the Haskell type:" <> typeInfo <> " and nothing else in your response: Format should be parsable as the Haskell type:" <> typeInfo ] + +type TokenLimit = Maybe Int +-- | TODO: change to gptPrim +askGPT :: MonadIO m => APIKey 'OpenAI -> Manager -> TokenLimit -> [ContentWithRole] -> m (Either T.Text T.Text) +askGPT apiKey mgr maxTokens contents = liftIO $ do + putStrLn "askGPT" + let url = "https://api.openai.com/v1/chat/completions" + req <- parseRequest url + let headers = [ (hAuthorization, "Bearer " <> (T.unpack . T.strip . unAPIKey $ apiKey)) + , (hContentType, "application/json") + ] + let promptLen = maybe [] (\_len -> [cwr System $ "Please limit response to " <> (T.pack $ show (50 :: Integer)) <> " tokens"]) maxTokens + -- We add 50 to limit because as the request gets larger GPT is worse at knowing when to stop + -- This should not affect shorter responses + let prompt = GPTRequestBody gptModel ((+ 50) <$> maxTokens) $ promptLen <> contents + let req' = req { requestHeaders = (fmap . fmap) (T.encodeUtf8 . T.pack) headers + , method = "POST" + , requestBody = RequestBodyLBS $ Aeson.encode prompt --txt + } + liftIO $ print $ Aeson.encode prompt + (CE.try $ fmap responseBody $ httpLbs req' mgr) >>= \case + Left (e :: HttpException) -> pure $ Left $ tshow e + Right resBody -> case eitherDecode resBody :: Either String PromptResponse of + Left e -> case eitherDecode resBody :: Either String ErrorResponseOpenAI of + Left ee -> pure . Left . T.pack $ e <> ee + Right (ErrorResponseOpenAI (ErrorOpenAI msg _ _ _)) -> do + liftIO $ print $ "Error with OpenAI: " <> msg + pure $ Left "Unknown AI Error" + Right r -> case choices r of + [] -> pure $ Left "No choices" + chcs -> pure . Right . _cwr_content . message . head $ chcs + + +-- curl -X POST http://localhost:11434/api/generate -d '{ +-- "model": "deepseek-r1:1.5b", +-- "prompt": "Write a haiku about the moon.", +-- "stream": true +-- }' -H "Content-Type: application/json" + + + +toThoughtResponse :: ContentWithRole -> Either Psc.ParseError ThoughtResponse +toThoughtResponse r = + let + contentSrc :: T.Text + contentSrc = _cwr_content $ r + p = do + thinkTag <- S.el "think" [] + rest <- Psc.many Psc.anyChar + pure $ ThoughtResponse (T.lines . T.pack $ S.innerText' thinkTag) (T.lines . T.pack $ rest) + in + Psc.parse p "deepseek response" contentSrc + +-- import Text.Parsec as Psc + +codeBlock :: Psc.Stream s m Char => Psc.ParsecT s u m (String,String) +codeBlock = do + _ <- Psc.count 3 (Psc.char '`') + (codeType, _) <- S.manyTill_ (Psc.try Psc.alphaNum) (Psc.char '\n' Psc.<|> Psc.char '\\') + (code, _) <- S.manyTill_ (Psc.anyChar Psc.<|> Psc.char '\n') (Psc.count 3 $ Psc.char '`') + pure (codeType, code) + + + +-- Would be dope to have a retry strategy + +-- askGen :: Retries -> Question -> (DeepSeekResponse -> a) -> IO a + + + + +askDeepSeek :: MonadIO m => Manager -> DeepSeekModel -> [ContentWithRole] -> m (Either T.Text DeepSeekResponse) +askDeepSeek mgr modelDS contents = liftIO $ do + putStrLn "askDeepSeek" + let url = "http://localhost:11434/api/chat" + req <- parseRequest url + let headers = [ (hContentType, "application/json") + ] + let prompt = mkDSPrompt modelDS contents -- [ cwr User contents ] + let req' = req { requestHeaders = (fmap . fmap) (T.encodeUtf8 . T.pack) headers + , method = "POST" + , responseTimeout = responseTimeoutNone + , requestBody = RequestBodyLBS $ Aeson.encode prompt --txt + } + + response_ :: Either HttpException LBS.ByteString <- (CE.try $ fmap responseBody $ httpLbs req' mgr) + case response_ of + Left (e :: HttpException) -> pure $ Left $ T.pack $ (show e) + Right resBody -> do + case eitherDecode resBody :: Either String DeepSeekResponse of + Left e -> do + pure . Left . T.pack $ e + Right a -> pure $ Right a + + + + +askGPTJSON + :: FromJSON b + => APIKey 'OpenAI + -> Manager + -> TokenLimit + -> [ContentWithRole] + -> IO (Either T.Text (Maybe b)) +askGPTJSON apiKey mgr tokenLimit contents = do + content_ <- askGPT apiKey mgr tokenLimit contents + print content_ + pure $ flip fmap content_ (Aeson.decode . LBS.fromStrict . T.encodeUtf8) + + +gptModel :: T.Text +gptModel = "gpt-4o-2024-05-13" -- "gpt-4" + diff --git a/src/LLM/ScrubPrefix.hs b/src/LLM/ScrubPrefix.hs new file mode 100644 --- /dev/null +++ b/src/LLM/ScrubPrefix.hs @@ -0,0 +1,7 @@ +module LLM.ScrubPrefix where + +import Data.Aeson + +scrubPrefix :: String -> Options +scrubPrefix s = + defaultOptions { fieldLabelModifier = drop (length s) } diff --git a/src/LLM/Types.hs b/src/LLM/Types.hs new file mode 100644 --- /dev/null +++ b/src/LLM/Types.hs @@ -0,0 +1,310 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module LLM.Types where + +import LLM.ScrubPrefix + +import Control.Monad.Trans.State +import Data.Default +import Data.Aeson +import Data.Aeson.TH +import qualified Data.Text as T +import Data.ByteString.Lazy as LBS +import GHC.Generics + + +data APIProvider = OpenAI | Google | AWS +-- Define the APIKey type with a phantom type parameter +newtype APIKey (api :: APIProvider) = APIKey { unAPIKey :: T.Text } + +data GPTRequestBody = GPTRequestBody + { model :: T.Text + -- , response_format :: GPTResponseFormat + , max_tokens :: Maybe Int + , messages :: [ContentWithRole] + -- more exist but we dont need them or use them + } deriving (Show,Generic) + +data GPTType = GPT_Text | GPT_JSON deriving Show + + +data GPTResponseFormat = GPTResponseFormat + { _gptResponseFormat_type :: GPTType + } deriving (Generic, Show) + + +-- | Shorthand for ContentWithRole +cwr :: GPTRole -> T.Text -> ContentWithRole +cwr = ContentWithRole + +data ContentWithRole = ContentWithRole + { _cwr_role :: GPTRole + , _cwr_content :: T.Text + } deriving (Show, Generic) + +data GPTRole = System -- we provide some context: "Pretend you are an Interviewer" + | User -- we ask some question + | Assistant deriving (Show, Generic) + -- We tell GPT something : "The assistant messages help store prior responses. + -- They can also be written by a developer to help give examples of desired behavior." + +instance ToJSON GPTRole where + toJSON = \case + System -> String "system" + User -> String "user" + Assistant -> String "assistant" + +instance FromJSON GPTRole where + parseJSON = withText "Role" $ \case + "system" -> pure System + "user" -> pure User + "assistant" -> pure Assistant + x -> fail $ show x + + + +data PromptResponse = PromptResponse { id :: T.Text + , object :: T.Text + , created :: Int + , choices :: [ResMessage] + , usage :: Usage + } deriving (Show, Generic) + +data ResMessage = ResMessage { message :: ContentWithRole + , finish_reason :: T.Text + , index :: Int + } deriving (Show,Generic) + + +data Usage = Usage { prompt_tokens :: Int + , completion_tokens :: Int + , total_tokens :: Int + } deriving (Show,Generic) + + + +-- Wrapper for Raw GPT Response +data Content = Content { unContent :: LBS.ByteString } deriving Show + +-- default +data TextToSpeechBody = TextToSpeechBody + { _textToSpeech_model :: T.Text + , _textToSpeech_voice :: T.Text + , _textToSpeech_input :: T.Text + } + +data ErrorOpenAI = ErrorOpenAI { + _errorOpenAI_message :: T.Text, + _errorOpenAI_type :: T.Text, -- 'type' is a reserved keyword in Haskell, so we use type' or another name + _errorOpenAI_param :: Maybe T.Text, + _errorOpenAI_code :: Maybe T.Text +} deriving (Show, Generic) + +-- Define the data structure for the top-level object +data ErrorResponseOpenAI = ErrorResponseOpenAI { + _errorResponseOpenAI_error :: ErrorOpenAI +} deriving (Show, Generic) + +-- instance Show e => Show (RequestError' e) where +-- --show (NoAuth s) = "NoAuth " <> s +-- show (RequestErr e) = "RequestErr " <> show e + +-- data DeepSeekRequestBody = DeepSeekRequestBody +-- { _ds_model :: T.Text +-- , _ds_prompt :: T.Text +-- , _ds_stream :: Bool +-- } deriving Generic + +data ResponseFormat = AsText | AsJSON deriving (Eq, Show) +instance ToJSON ResponseFormat where + toJSON = \case + AsJSON -> String "json_object" + AsText -> String "text" + +instance FromJSON ResponseFormat where + parseJSON = withText "ResponseFormat" $ \t -> + case T.unpack t of + "json_object" -> pure AsJSON + "text" -> pure AsText + _ -> fail $ "Unknown ResponseFormat: " ++ T.unpack t + +data DeepSeekRequestBody = DeepSeekRequestBody + { _deepSeekRequest_messages :: [ContentWithRole] + , _deepSeekRequest_model :: DeepSeekModel + , _deepSeekRequest_images :: Maybe T.Text + -- , _deepSeekRequest_frequency_penalty :: Double + -- , _deepSeekRequest_max_tokens :: Int + -- , _deepSeekRequest_presence_penalty :: Double + -- , _deepSeekRequest_response_format :: ResponseFormat + -- , _deepSeekRequest_stop :: Maybe String + , _deepSeekRequest_stream :: Bool + -- , _deepSeekRequest_stream_options :: Maybe String + -- , _deepSeekRequest_temperature :: Double + -- , _deepSeekRequest_top_p :: Double + -- , _deepSeekRequest_tools :: Maybe String + -- , _deepSeekRequest_tool_choice :: String + -- , _deepSeekRequest_logprobs :: Bool + -- , _deepSeekRequest_top_logprobs :: Maybe String + } deriving (Show, Generic) + +--instance ToJSON DeepSeekRequestBody + + +instance Default DeepSeekRequestBody where + def = DeepSeekRequestBody + { _deepSeekRequest_messages = [] + , _deepSeekRequest_model = DS_1_5b + , _deepSeekRequest_images = Nothing + -- , _deepSeekRequest_frequency_penalty = 0 + -- , _deepSeekRequest_max_tokens = 4096 + -- , _deepSeekRequest_presence_penalty = 0 + -- , _deepSeekRequest_response_format = AsText + -- , _deepSeekRequest_stop = Nothing + , _deepSeekRequest_stream = False + -- , _deepSeekRequest_stream_options = Nothing + -- , _deepSeekRequest_temperature = 1 + -- , _deepSeekRequest_top_p = 1 + -- , _deepSeekRequest_tools = Nothing + -- , _deepSeekRequest_tool_choice = "" + -- , _deepSeekRequest_logprobs = False + -- , _deepSeekRequest_top_logprobs = Nothing + } + +data DeepSeekModel = DS_1_5b | DS_7b | DS_8b | DS_14b | DS_32b | DS_70b | DS_671b deriving (Eq, Ord, Enum, Show, Generic) +instance ToJSON DeepSeekModel where + toJSON = \case + DS_1_5b -> "deepseek-r1:1.5b" + DS_7b -> "deepseek-r1:7b" + DS_8b -> "deepseek-r1:8b" + DS_14b -> "deepseek-r1:14b" + DS_32b -> "deepseek-r1:32b" + DS_70b -> "deepseek-r1:70b" + DS_671b -> "deepseek-r1:671b" -- just in case `\_o_/` + +instance FromJSON DeepSeekModel where + parseJSON = withText "DeepSeekModel" $ \t -> + case T.unpack t of + "deepseek-r1:1.5b" -> pure DS_1_5b + "deepseek-r1:7b" -> pure DS_7b + "deepseek-r1:8b" -> pure DS_8b + "deepseek-r1:14b" -> pure DS_14b + "deepseek-r1:32b" -> pure DS_32b + "deepseek-r1:70b" -> pure DS_70b + "deepseek-r1:671b" -> pure DS_671b + _ -> fail $ "Unknown DeepSeekModel: " ++ T.unpack t +-- 1.5b +-- 7b +-- 8b +-- 14b +-- 32b +-- 70b +-- 671b + + +data DeepSeekResponse = DeepSeekResponse + { _deepSeekResponse_model :: String + , _deepSeekResponse_created_at :: String + --, _deepSeekResponse_response :: String + , _deepSeekResponse_message :: ContentWithRole + , _deepSeekResponse_done :: Bool + , _deepSeekResponse_done_reason :: String + , _deepSeekResponse_context :: Maybe [Int] + } deriving (Show, Generic) + + + +-- todo: use readerT for Manager and ApiKey +-- then create this monad as a newtype with getter funcs +-- and a put for history +type MonadGPT m a = StateT ConversationHistory m a +type MonadDeepSeek m a = StateT ConversationHistoryDeepSeek m a +type ConversationHistory = [GPTQuery T.Text] +--type ConversationHistoryCWR = [GPTQuery ContentWithRole] + +type ConversationHistoryDeepSeek = [(TagDS, [ContentWithRole])] + +-- q == x +-- a == x ++ "-answer" + + +data GPTQuery a = GPTQuery + { _gptQuery_tag :: Tag + , _gptQuery_question :: GPTQuestion + , _gptQuery_answer :: GPTAnswer a + } +newtype Tag = Tag { unTag :: T.Text } deriving (Eq,Show) +data TagDS = TagDS { unTagDS :: T.Text, isAnswerDS :: Bool } deriving (Eq,Show, Generic) + +instance ToJSON TagDS +instance FromJSON TagDS + +newtype GPTQuestion = GPTQuestion [ContentWithRole] +newtype GPTAnswer a = GPTAnswer { unGPTAnswer :: a } deriving (Generic, Show) + +instance ToJSON a => ToJSON (GPTAnswer a) +instance FromJSON a => FromJSON (GPTAnswer a) + +type DeepSeekAnswer = GPTAnswer ContentWithRole + +newtype GPTError = GPTError T.Text deriving Show + +data RelevantContext + = LastN Int + | Relevants [Tag] + | LastNRelevant Int (Tag -> Bool) -- LastN matching pattern; most general + +data RelevantContextDS + = LastN_DS Int + | Relevants_DS [TagDS] + | LastNRelevant_DS Int (TagDS -> Bool) -- LastN matching pattern; most general + +-- 3 tags: +-- html-1 +-- html-2 +-- xml-2342 + +newtype DeepSeekQuestion = DeepSeekQuestion [ContentWithRole] + +data ThoughtResponse = ThoughtResponse + { _thoughtResponse_think :: [T.Text] + , _thoughtResponse_answer :: [T.Text] + } deriving Show + +instance ToJSON GPTType where + toJSON = toJSON . T.pack . \case + GPT_Text -> "text" + GPT_JSON -> "json_object" + +instance FromJSON GPTType where + parseJSON = withText "GPTType" $ \case + "text" -> pure GPT_Text + "json_object" -> pure GPT_JSON + t -> fail . T.unpack $ "unknown GPT type" <> t + +data OllamaError = OllamaError { _ollama_error :: T.Text } + +deriveJSON (scrubPrefix "_errorOpenAI_") ''ErrorOpenAI +deriveJSON (scrubPrefix "_errorResponseOpenAI_") ''ErrorResponseOpenAI +deriveJSON (scrubPrefix "_textToSpeech_") ''TextToSpeechBody +deriveJSON (scrubPrefix "_gptResponseFormat_") ''GPTResponseFormat +deriveJSON (scrubPrefix "_cwr_") ''ContentWithRole +deriveJSON (scrubPrefix "_deepSeekRequest_") ''DeepSeekRequestBody +deriveJSON (scrubPrefix "_deepSeekResponse_") ''DeepSeekResponse +deriveJSON (scrubPrefix "_ollama_") ''OllamaError + +instance FromJSON Usage +instance ToJSON Usage +instance FromJSON PromptResponse +instance ToJSON PromptResponse +instance FromJSON ResMessage +instance ToJSON ResMessage + + +instance ToJSON GPTRequestBody