llm-with-context (empty) → 0.1.0.0
raw patch · 6 files changed
+766/−0 lines, 6 filesdep +aesondep +basedep +bytestring
Dependencies added: aeson, base, bytestring, containers, data-default, directory, http-client, http-client-tls, http-types, parsec, scrappy-core, text, transformers
Files
- CHANGELOG.md +5/−0
- LICENSE +20/−0
- llm-with-context.cabal +46/−0
- src/LLM/LLM.hs +378/−0
- src/LLM/ScrubPrefix.hs +7/−0
- src/LLM/Types.hs +310/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for llm-with-context++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -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.
+ llm-with-context.cabal view
@@ -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
+ src/LLM/LLM.hs view
@@ -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": <String>+ -- , "suggested_word_count": Int+ -- , "predicted_time_seconds": Int+ -- , "section_overview": <String> + -- }+ -- , ]+ -- } +++-- 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"+
+ src/LLM/ScrubPrefix.hs view
@@ -0,0 +1,7 @@+module LLM.ScrubPrefix where++import Data.Aeson++scrubPrefix :: String -> Options+scrubPrefix s =+ defaultOptions { fieldLabelModifier = drop (length s) }
+ src/LLM/Types.hs view
@@ -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