packages feed

genai-lib 1.3 → 2.0

raw patch · 15 files changed

+704/−447 lines, 15 filesdep +containersdep +http-client-tlsdep +scientificdep −formattingdep −heredocdep −hsloggernew-component:exe:ex-genai-ollamanew-component:exe:ex-genai-openai

Dependencies added: containers, http-client-tls, scientific, time

Dependencies removed: formatting, heredoc, hslogger, optparse-applicative, prettyprinter

Files

CHANGELOG.md view
@@ -1,3 +1,14 @@+2.0 (2025-04-22)++  * Extensive redesign of this library+  * Work done to support multiple LLM servers+  * Redesigned how LLM options work using Semigroup+  * Now supporting loading the API key from a file+  * Added code to make the TLS request timeout longer+  * Added and adjusted docs including Haddock API docs+  * Redesigned failure with throwIO and a custom exception type+  * Added keep_alive to the Ollama request+ 1.3 (2025-03-27)    * Initial release
README.md view
@@ -3,16 +3,62 @@  ## Synopsis -Library and command line tool for interacting with various generative AI LLMs+A library for interacting with various generative AI LLMs   ## Description -Library and command line tool for performing completions and chats with various-generative AI LLMs (Large Language Models). Works today with Ollama and some-work has been done to support OpenAI in the future.+A library for performing completions and chats with various generative AI LLMs+(Large Language Models). Works today with Ollama and OpenAI with more to come+in the future.  This project is very much in-progress and incomplete.+++## Using this library++An example, more available in `src/example`++    import Control.Exception (Handler (..), catches)+    import Data.Text.Lazy.IO qualified as TL+    import GenAILib (ClientError, Request (..), jsonToText, mkRequest, numopt,+      stringopt, systemmsg, usermsg)+    import GenAILib.HTTP (GenAIException, openaiV1Chat, openaiV1ChatJ,+      tokenFromFile)+    import GenAILib.OpenAI (OpenAIRequest, getMessage)+++    main :: IO ()+    main = do+      openaiJSON+      openaiData++    -- A simple example with no error handling that expects an Aeson Value+    -- (OpenAIRequest is an instance of ToJSON) and displays the encoded JSON+    -- response+    openaiJSON :: IO ()+    openaiJSON = do+      let req :: OpenAIRequest =  mkRequest "gpt-3.5-turbo" $ usermsg "Why is the sky blue?"+      token <- tokenFromFile "path/to/openai/key"+      TL.putStrLn . jsonToText =<< openaiV1ChatJ token Nothing req++    -- Another example with exception handling that expects an OpenAIResponse+    -- data structure, displaying that and also just the response text+    openaiData :: IO ()+    openaiData = do+      let req :: OpenAIRequest =  mkRequest "gpt-3.5-turbo"+              (  systemmsg "Answer in the style of Bugs Bunny. Try to work the phrase \"What's up Doc?\" in somewhere."+              <> usermsg "Why is the sky blue?"+              <> numopt "temperature" 0.8+              <> stringopt "service_tier" "default"+              )+      token <- tokenFromFile "path/to/openai/key"+      res <- openaiV1Chat token Nothing req `catches`+        [ Handler (\(e :: GenAIException) -> error . show $ e)+        , Handler (\(e :: ClientError) -> error . show $ e)+        ]+      print res  -- The entire OpenAIResponse+      TL.putStrLn . getMessage $ res  -- Just the response Message Content   ## Getting source
genai-lib.cabal view
@@ -1,11 +1,11 @@ cabal-version: 2.2  name: genai-lib-version: 1.3-synopsis: Library and command line tool for interacting with various generative-  AI LLMs-description: Library and command line tool for performing completions and chats-  with various generative AI LLMs (Large Language Models).+version: 2.0+synopsis: A library for interacting with various generative AI LLMs+description: A library for performing completions and chats with various+  generative AI LLMs (Large Language Models). Works today with Ollama and+  OpenAI with more to come in the future. author: Dino Morelli maintainer: dino@ui3.info copyright: 2024 Dino Morelli@@ -58,43 +58,48 @@     -Wincomplete-uni-patterns     -Wpartial-fields     -Wredundant-constraints-  build-depends:-      aeson >= 2.1.2 && < 2.2-    , base >= 3 && < 5-    , formatting >= 7.2.0 && < 7.3-    , text >= 1.2.5 && < 3  library   import: lang   exposed-modules:-    GenAILib.Common+    GenAILib     GenAILib.HTTP+    GenAILib.JSON     GenAILib.Ollama-    GenAILib.System.Log+    GenAILib.OpenAI   hs-source-dirs:     src/lib   build-depends:-      bytestring >= 0.11.4 && < 0.12-    , hslogger >= 1.3.1 && < 1.4+      aeson >= 2.1.2 && < 2.2+    , base >= 3 && < 5+    , bytestring >= 0.11.4 && < 0.12+    , containers >= 0.6.7 && < 0.7     , http-client >= 0.7.16 && < 0.8+    , http-client-tls >= 0.3.6 && < 0.4+    , scientific >= 0.3.7 && < 0.4     , servant >= 0.20.1 && < 0.21     , servant-client >= 0.20 && < 0.21     , servant-client-core >= 0.20 && < 0.21     , string-conv >= 0.2.0 && < 0.3+    , text >= 1.2.5 && < 3+    , time >= 1.12.2 && < 1.13 -executable genai+executable ex-genai-ollama   import: lang-  main-is: Main.hs+  main-is: ex-genai-ollama.hs   hs-source-dirs:-    src/app-  other-modules:-    GenAI.Common-    GenAI.Opts-    Paths_genai_lib-  autogen-modules:-    Paths_genai_lib+    src/example   build-depends:-      heredoc >= 0.2.0 && < 0.3+      base >= 3 && < 5     , genai-lib-    , optparse-applicative >= 0.17.1 && < 0.19-    , prettyprinter >= 1.7.1 && < 1.8+    , text >= 1.2.5 && < 3++executable ex-genai-openai+  import: lang+  main-is: ex-genai-openai.hs+  hs-source-dirs:+    src/example+  build-depends:+      base >= 3 && < 5+    , genai-lib+    , text >= 1.2.5 && < 3
− src/app/GenAI/Common.hs 
@@ -1,39 +0,0 @@-{-# LANGUAGE OverloadedRecordDot #-}--module GenAI.Common-  where--import Data.Aeson (Value (Object))-import Data.Aeson.Types (emptyObject)-import Data.Text.Lazy qualified as TL-import GenAILib.Common (LLMOptions (..), Model, Prompt (..), RawOutput)-import GenAILib.Ollama (Host, OllamaRequest (..), Stream, System)-import GenAILib.System.Log (Priority (DEBUG))---data CLIOptions = CLIOptions-  { host :: Host-  , system :: Maybe System-  , llmOptions :: LLMOptions-  , stream :: Stream-  , rawOutput :: RawOutput-  , verbose :: Verbose-  , model :: Model-  }---newtype Verbose = Verbose Bool-  deriving Show---verbosityToPriority :: Verbose -> Maybe Priority-verbosityToPriority (Verbose True) = Just DEBUG-verbosityToPriority (Verbose False) = Nothing---mkLLMRequest :: CLIOptions -> TL.Text -> OllamaRequest-mkLLMRequest opts promptText = OllamaRequest opts.model opts.system-  (Prompt promptText) opts.stream (wrapMaybe opts.llmOptions.v)-  where-    wrapMaybe o@(Object _) = if o == emptyObject then Nothing else Just o-    wrapMaybe _ = Nothing
− src/app/GenAI/Opts.hs 
@@ -1,154 +0,0 @@-{-# LANGUAGE DuplicateRecordFields, OverloadedRecordDot, QuasiQuotes #-}--module GenAI.Opts-  ( parseOpts-  )-  where--import Data.Text.Lazy (pack)-import Data.Version (showVersion)-import Formatting ((%+), format, formatToString, string)-import Formatting.ShortFormatters (s)-import GenAILib.Common (Model (..), RawOutput (..), convertOptions)-import GenAILib.Ollama (Host (..), Stream (..),-  System (..), defaultHost, hostFromString)-import Options.Applicative-import Paths_genai_lib (version)-import Prettyprinter (pretty)-import System.Environment (getProgName)-import Text.Heredoc (here)--import GenAI.Common (CLIOptions (..), Verbose (..))---readHost :: ReadM Host-readHost = eitherReader (\hostPortStr ->-  maybe-    (Left $ formatToString-      ("Unable to parse" %+ string %+ "into host and port parts") hostPortStr)-    Right-    $ hostFromString hostPortStr-  )---{- HLINT ignore "Functor law" -}-parser :: Parser CLIOptions-parser = CLIOptions-  <$> option readHost-        (  long "host"-        <> short 'H'-        <> metavar "HOST:PORT"-        <> help "Host and port where ollama serve is running"-        <> showDefault-        <> value defaultHost-        )-  -- NOTE: The inner <$> is for Maybe, the outer <$> is for Parser-  <*> ( (System . pack <$>) <$> optional ( strOption-        (  long "system"-        <> short 's'-        <> metavar "STR"-        <> help "System parameter"-        )-      ))-  <*> ( convertOptions <$> many ( strOption-        (  long "option"-        <> short 'o'-        <> metavar "KEY:VALUE"-        <> help "Options for the LLM, repeat for each option pair. See LLM OPTIONS below"-        )-      ))-  <*> ( Stream <$> switch-        (  long "stream"-        <> help "Response will be returned as a stream of objects"-        )-      )-  <*> ( RawOutput <$> switch-        (  long "raw-output"-        <> short 'r'-        <> help "Output the entire JSON response from the LLM"-        )-      )-  <*> ( Verbose <$> switch-        (  long "verbose"-        <> short 'v'-        <> help "Enable verbose output. Note: All logging goes to stderr"-        )-      )-  <*> ( Model . pack <$> argument str-        (  metavar "MODEL_ID"-        <> help "Model identifier, see available models with `ollama list`"-        )-      )---versionHelper :: String -> Parser (a -> a)-versionHelper progName =-  infoOption (formatToString (s %+ s) progName (showVersion version)) $ mconcat-  [ long "version"-  , help "Show version information"-  , hidden-  ]---parseOpts :: IO CLIOptions-parseOpts = do-  pn <- getProgName-  execParser $ info (parser <**> helper <**> versionHelper pn)-    (  header (formatToString (s %+ "- Command line tool for interacting with an ollama server") pn)-    <> footer'-    )---footer' :: InfoMod a-footer' = footerDoc . Just . pretty . format content . showVersion $ version-  where content = [here|OVERVIEW--This software expects the prompt string on STDIN and will respond with the LLM-response on STDOUT--example usage--    $ echo "Why is the sky blue?" | genai some-fancy-model--WHY WAS THIS DONE?--ollama ships with command-line ability to submit prompts and do completions:--    $ ollama MODEL [PROMPT] ...--but as far as I can see there's no easy way to use this method to change-options like the temperature and seed. This software allows greater control-over the options.--    $ echo "Tell me a story" | genai some-other-model -o temperature:0.2--LLM OPTIONS--Some settings are communicated to the LLM as a map of options. Use them like this--    -o temperature:0.2--Some useful options--    option name   description                                                   default-    --------------------------------------------------------------------------------------    seed          Sets the random number seed to use for generation. Setting    0-                  this to a specific number will make the model generate the-                  same text for the same prompt.-    temperature   The temperature of the model. Increasing the temperature      0.8-                  will make the model answer more creatively.-                  Range 0.0 to 1.0-    top_k         Reduces the probability of generating nonsense. A higher      40-                  value (e.g. 100) will give more diverse answers, while a-                  lower value (e.g. 10) will be more conservative.-                  Range 0 to 100-    top_p         Works together with top-k. A higher value (e.g., 0.95) will   0.9-                  lead to more diverse text, while a lower value (e.g., 0.5)-                  will generate more focused and conservative text.-                  Range unknown, guessing 0.0 to 1.0--For the complete list of LLM options, see--https://github.com/ollama/ollama/blob/main/docs/modelfile.md#valid-parameters-and-values--Version|] %+ s %+ " Dino Morelli <dino@ui3.info>"
− src/app/Main.hs 
@@ -1,22 +0,0 @@-{-# LANGUAGE OverloadedRecordDot #-}--import Data.Text.Lazy.IO qualified as TL-import GenAILib.HTTP (display, doCompletion)-import GenAILib.System.Log (infoM, initLogging, lname)-import System.IO (stdin)--import GenAI.Common (CLIOptions (host, rawOutput, verbose), mkLLMRequest,-  verbosityToPriority)-import GenAI.Opts (parseOpts)---main :: IO ()-main = do-  opts <- parseOpts-  initLogging . verbosityToPriority . verbose $ opts-  infoM lname "Logging configured"-  infoM lname "Args parsed"--  promptText <- TL.hGetContents stdin-  let or' = mkLLMRequest opts promptText-  doCompletion opts.host or' >>= display opts.rawOutput
+ src/example/ex-genai-ollama.hs view
@@ -0,0 +1,39 @@+import Control.Exception (Handler (..), catches)+import Data.Text.Lazy.IO qualified as TL+import GenAILib (ClientError, Request (..), boolopt, jsonToText, mkRequest,+  numopt, optional, systemmsg, usermsg)+import GenAILib.HTTP (GenAIException, ollamaChat, ollamaChatJ)+import GenAILib.Ollama (OllamaRequest, getMessage, keepalive)+++main :: IO ()+main = do+  ollamaJSON+  ollamaData++-- A simple example with no error handling that expects an Aeson Value+-- (OllamaRequest is an instance of ToJSON) and displays the encoded JSON+-- response+ollamaJSON :: IO ()+ollamaJSON = do+  let req :: OllamaRequest = mkRequest "gemma3:1b" $ usermsg "Why is the sky blue?"+  TL.putStrLn . jsonToText =<< ollamaChatJ Nothing req++-- Another example with exception handling that expects an OllamaResponse+-- data structure, displaying that and also just the response text+ollamaData :: IO ()+ollamaData = do+  let mbDuration = Just "30m"+  let req =  mkRequest "gemma3:1b"+          (  systemmsg "Answer in the style of Bugs Bunny. Try to work in the phrase \"What's up Doc?\" somewhere."+          <> usermsg "Why is the sky blue?"+          <> numopt "temperature" 0.1+          <> boolopt "penalize_newline" True+          <> (keepalive `optional` mbDuration)+          )+  res <- ollamaChat Nothing req `catches`+    [ Handler (\(e :: GenAIException) -> error . show $ e)+    , Handler (\(e :: ClientError) -> error . show $ e)+    ]+  print res  -- The entire OllamaResponse+  TL.putStrLn . getMessage $ res  -- Just the response Message Content
+ src/example/ex-genai-openai.hs view
@@ -0,0 +1,40 @@+import Control.Exception (Handler (..), catches)+import Data.Text.Lazy.IO qualified as TL+import GenAILib (ClientError, Request (..), jsonToText, mkRequest, numopt,+  stringopt, systemmsg, usermsg)+import GenAILib.HTTP (GenAIException, openaiV1Chat, openaiV1ChatJ,+  tokenFromFile)+import GenAILib.OpenAI (OpenAIRequest, getMessage)+++main :: IO ()+main = do+  openaiJSON+  openaiData++-- A simple example with no error handling that expects an Aeson Value+-- (OpenAIRequest is an instance of ToJSON) and displays the encoded JSON+-- response+openaiJSON :: IO ()+openaiJSON = do+  let req :: OpenAIRequest =  mkRequest "gpt-3.5-turbo" $ usermsg "Why is the sky blue?"+  token <- tokenFromFile "path/to/openai/key"+  TL.putStrLn . jsonToText =<< openaiV1ChatJ token Nothing req++-- Another example with exception handling that expects an OpenAIResponse+-- data structure, displaying that and also just the response text+openaiData :: IO ()+openaiData = do+  let req :: OpenAIRequest =  mkRequest "gpt-3.5-turbo"+          (  systemmsg "Answer in the style of Bugs Bunny. Try to work the phrase \"What's up Doc?\" in somewhere."+          <> usermsg "Why is the sky blue?"+          <> numopt "temperature" 0.8+          <> stringopt "service_tier" "default"+          )+  token <- tokenFromFile "path/to/openai/key"+  res <- openaiV1Chat token Nothing req `catches`+    [ Handler (\(e :: GenAIException) -> error . show $ e)+    , Handler (\(e :: ClientError) -> error . show $ e)+    ]+  print res  -- The entire OpenAIResponse+  TL.putStrLn . getMessage $ res  -- Just the response Message Content
+ src/lib/GenAILib.hs view
@@ -0,0 +1,209 @@+module GenAILib+  (+  -- * A library for interacting with LLM back-ends like Ollama and OpenAI+  --+  -- | An example+  --+  -- > import Control.Exception (Handler (..), catches)+  -- > import Data.Text.Lazy.IO qualified as TL+  -- > import GenAILib (ClientError, Request (..), jsonToText, mkRequest, numopt,+  -- >   stringopt, systemmsg, usermsg)+  -- > import GenAILib.HTTP (GenAIException, openaiV1Chat, openaiV1ChatJ,+  -- >   tokenFromFile)+  -- > import GenAILib.OpenAI (OpenAIRequest, getMessage)+  -- >+  -- >+  -- > main :: IO ()+  -- > main = do+  -- >   openaiJSON+  -- >   openaiData+  -- >+  -- > -- A simple example with no error handling that expects an Aeson Value+  -- > -- (OpenAIRequest is an instance of ToJSON) and displays the encoded JSON+  -- > -- response+  -- > openaiJSON :: IO ()+  -- > openaiJSON = do+  -- >   let req :: OpenAIRequest =  mkRequest "gpt-3.5-turbo" $ usermsg "Why is the sky blue?"+  -- >   token <- tokenFromFile "path/to/openai/key"+  -- >   TL.putStrLn . jsonToText =<< openaiV1ChatJ token Nothing req+  -- >+  -- > -- Another example with exception handling that expects an OpenAIResponse+  -- > -- data structure, displaying that and also just the response text+  -- > openaiData :: IO ()+  -- > openaiData = do+  -- >   let req :: OpenAIRequest =  mkRequest "gpt-3.5-turbo"+  -- >           (  systemmsg "Answer in the style of Bugs Bunny. Try to work the phrase \"What's up Doc?\" in somewhere."+  -- >           <> usermsg "Why is the sky blue?"+  -- >           <> numopt "temperature" 0.8+  -- >           <> stringopt "service_tier" "default"+  -- >           )+  -- >   token <- tokenFromFile "path/to/openai/key"+  -- >   res <- openaiV1Chat token Nothing req `catches`+  -- >     [ Handler (\(e :: GenAIException) -> error . show $ e)+  -- >     , Handler (\(e :: ClientError) -> error . show $ e)+  -- >     ]+  -- >   print res  -- The entire OpenAIResponse+  -- >   TL.putStrLn . getMessage $ res  -- Just the response Message Content++    Request (..)+  , RequestMod (..)+  , usermsg+  , numopt+  , boolopt+  , stringopt+  , systemmsg+  , optional+  , mkMessage+  , mkMessageWithRole+  , Model (..)+  , Message (..)+  , Role (..)+  , Content (..)+  , ImageData (..)+  , Stream (..)++  -- re-exporting+  , ClientError+  , module GenAILib.JSON+  )+  where++import Data.Aeson (FromJSON, ToJSON, Value (Number, String))+import Data.Aeson qualified as A+import Data.List.NonEmpty (NonEmpty)+import Data.Scientific (fromFloatDigits)+import Data.Text qualified as TS+import Data.Text.Lazy qualified as TL+import GHC.Generics (Generic)+import Servant.Client.Core (ClientError)++import GenAILib.JSON+++-- | The name of an LLM model+--+--   This lets the back-end know which model we want to use by name.+newtype Model = Model TL.Text+  deriving (Generic, Show)++instance FromJSON Model+instance ToJSON Model+++-- | Text values sent to and from LLMs like prompts and responses.+newtype Content = Content TL.Text+  deriving (Generic, Show)++instance FromJSON Content+instance ToJSON Content+++-- | Which role is responsible for this content+--+--   Valid values are 'system', 'user', 'assistant' or 'tool'+newtype Role = Role TL.Text+  deriving (Generic, Show)++instance FromJSON Role+instance ToJSON Role+++-- | Base64 encoded image data for working with models+newtype ImageData = ImageData TL.Text+  deriving (Generic, Show)++instance FromJSON ImageData+instance ToJSON ImageData+++-- | Requests and responses to and from LLMs contain one or more @Message@s+--+--   These data structures always contain a @Role@ and some @Content@ and may+--   also optionally have an array of image data.+--+--   NOTE: The images as base64 encoded @Text@ are specific to Ollama at this+--   time and work is ongoing to support OpenAI's APIs+data Message = Message+  { role :: Role+  , content :: Content+  , images :: Maybe (NonEmpty ImageData)+  }+  deriving (Generic, Show)++instance FromJSON Message+instance ToJSON Message+++-- | Convenience function to create a simple @Message@ with the role of 'user',+--   some @Content@ (prompt text) and no image data.+mkMessage :: TL.Text -> Message+mkMessage = mkMessageWithRole $ Role "user"+++-- | Convenience function to create a simple @Message@ with the specified role,+--   some @Content@ (prompt text) and no image data.+mkMessageWithRole :: Role -> TL.Text -> Message+mkMessageWithRole role' content = Message role' (Content content) Nothing+++-- | Whether the back-end should use streaming to send response data in "chunks"+--+--   NOTE: This is mostly unused at this time and the behavior is untested+newtype Stream = Stream Bool+  deriving (Generic, Show)++instance ToJSON Stream+++class Request a where+  -- | Append a @Message@ to an existing request+  appendMessage :: Message -> a -> a++  -- | Construct a new @Request@+  --   Note: This request has no prompt data yet so at a minimum it must be used like this+  --+  --   > mkRequest "somefabulousmodel" $ usermsg "some fabulous prompt"+  mkRequest :: TL.Text -> RequestMod a -> a++  -- | Set an arbitrary LLM option given a name and JSON @Value@+  --   This is used internally by functions like boolopt, stringopt, ...+  setOpt :: TS.Text -> Value -> a -> a+++newtype RequestMod r = RequestMod (r -> r)++instance Request r => Semigroup (RequestMod r) where+  RequestMod f1 <> RequestMod f2 = RequestMod (f2 . f1)+++-- | Append a system prompt+systemmsg :: Request r => TL.Text -> RequestMod r+systemmsg systemPrompt = RequestMod . appendMessage+  $ mkMessageWithRole (Role "system") systemPrompt+++-- | Append a user message (prompt)+usermsg :: Request r => TL.Text -> RequestMod r+usermsg prompt = RequestMod . appendMessage $ mkMessage prompt+++-- | Apply a request modifier to a Maybe value+--+--   > stringopt `optional` (Just "foo")+optional :: (a -> RequestMod r) -> Maybe a -> RequestMod r+optional = maybe $ RequestMod id+++-- | Set an option with a @Bool@ value+boolopt :: Request r => TS.Text -> Bool -> RequestMod r+boolopt keystr = RequestMod . setOpt keystr . A.Bool+++-- | Set an option with a @Double@ value+numopt :: Request r => TS.Text -> Double -> RequestMod r+numopt keystr = RequestMod . setOpt keystr . Number . fromFloatDigits+++-- | Set an option with a @Text@ value+stringopt :: Request r => TS.Text -> TS.Text -> RequestMod r+stringopt keystr = RequestMod . setOpt keystr . String
− src/lib/GenAILib/Common.hs 
@@ -1,58 +0,0 @@-{-# LANGUAGE DuplicateRecordFields #-}--module GenAILib.Common-  where--import Control.Arrow ((&&&))-import Control.Monad (when)-import Data.Aeson (Key, ToJSON, Value (Number, String), object, toJSON)-import Data.Aeson.Key (fromString)-import Data.Aeson.Types (Pair)-import Data.Maybe (mapMaybe)-import Data.String.Conv (toS)-import Data.Text.Lazy qualified as TL-import GHC.Generics (Generic)---newtype Model = Model TL.Text-  deriving Generic--instance ToJSON Model---newtype Prompt = Prompt TL.Text-  deriving Generic--instance ToJSON Prompt---splitAtColon :: String -> Maybe (String, String)-splitAtColon combinedStr = do-  let (leftSide, rightSide) = takeWhile (/= ':') &&& dropWhile (/= ':') $ combinedStr-  when (null rightSide) Nothing-  pure (leftSide, tail rightSide)---newtype RawOutput = RawOutput Bool---newtype LLMOptions = LLMOptions { v :: Value }-  deriving Generic--instance ToJSON LLMOptions----- For debugging the LLM options parsing, unused most of the time-debugOptsJSON :: LLMOptions -> Value-debugOptsJSON = toJSON--convertOptions :: [String] -> LLMOptions-convertOptions = LLMOptions . object . pairs'--pairs' :: [String] -> [Pair]-pairs' = map convertTypes . mapMaybe splitAtColon--convertTypes :: (String, String) -> (Key, Value)--- Turns out the only non-number option we're interested in for Ollama is "stop"-convertTypes (keystr@"stop", valstr) = (fromString keystr, String . toS $ valstr)-convertTypes (keystr, valstr) = (fromString keystr, Number . read $ valstr)
src/lib/GenAILib/HTTP.hs view
@@ -1,37 +1,57 @@ {-# LANGUAGE DataKinds, TypeOperators #-}  module GenAILib.HTTP-  ( display-  , doChat-  , doCompletion+  ( BearerToken (..)+  , GenAIException+  , ollamaChat+  , ollamaChatJ+  , openaiV1Chat+  , openaiV1ChatJ+  , tokenFromText+  , tokenFromFile   )   where -import Data.Aeson (FromJSON, ToJSON, Value (Object, String), decode, encode)-import Data.Aeson.KeyMap qualified as A-import Data.ByteString.Lazy qualified as BL+import Control.Exception (Exception, throwIO)+import Data.Aeson (FromJSON, ToJSON, Value (Object), decode, encode, toJSON) import Data.Maybe (fromMaybe) import Data.Proxy (Proxy (..))-import Data.String.Conv (toS)+import Data.Text qualified as TS import Data.Text.IO qualified as TS-import Formatting ((%+), formatToString, string)-import Network.HTTP.Client (defaultManagerSettings, managerResponseTimeout,-  newManager, responseTimeoutMicro)-import Servant.API ((:<|>) (..), (:>), JSON, Post, ReqBody)-import Servant.Client (BaseUrl (..), Scheme (Http), ClientM,-  mkClientEnv, runClientM)+import Data.Typeable (Typeable)+import Network.HTTP.Client (Manager, defaultManagerSettings,+  managerResponseTimeout, newManager, responseTimeoutMicro)+import Network.HTTP.Client.TLS (newTlsManagerWith, tlsManagerSettings)+import Servant.API ((:<|>) (..), (:>), Header', JSON, Post, ReqBody, Required,+  ToHttpApiData)+import Servant.Client (BaseUrl (..), ClientM, mkClientEnv, runClientM) import Servant.Client.Core (clientIn)-import System.Exit (exitFailure) -import GenAILib.Common (RawOutput (..))-import GenAILib.Ollama (Host (..))-import GenAILib.System.Log (debugM, emergencyM, errorM, lname)+import GenAILib.Ollama (OllamaResponse)+import GenAILib.Ollama qualified as Ollama+import GenAILib.OpenAI (OpenAIResponse)+import GenAILib.OpenAI qualified as OpenAI   defaultHttpTimeout :: Int defaultHttpTimeout = 1_200_000_000  -- In microseconds, this is 2 minutes  +-- | A type to contain the Authorization Bearer token data needed for some requests+newtype BearerToken = BearerToken TS.Text+  deriving ToHttpApiData+++-- | Construct bearer token authorization header data from @Text@+tokenFromText :: TS.Text -> BearerToken+tokenFromText = BearerToken . ("Bearer " <>) . TS.strip+++-- | Construct bearer token authorization header data from the contents of a file+tokenFromFile :: FilePath -> IO BearerToken+tokenFromFile path = tokenFromText <$> TS.readFile path++ {- NOTE: The reason we've chosen Aeson's Value type for the response is we want    to do one of these things with these responses: @@ -41,9 +61,13 @@     We don't need to model the entire Ollama response JSON document to achieve these goals. -}+type CommonReqMethodRes = ReqBody '[JSON] Value :> Post '[JSON] Value+ type API-  =    "api" :> "generate" :> ReqBody '[JSON] Value :> Post '[JSON] Value-  :<|> "api" :> "chat" :> ReqBody '[JSON] Value :> Post '[JSON] Value+  =    "api" :> "chat" :> CommonReqMethodRes+  :<|> "v1" :> "chat" :> "completions"+    :> Header' '[Required] "Authorization" BearerToken+    :> CommonReqMethodRes  -- A Proxy to our API api :: Proxy API@@ -52,46 +76,47 @@ clientM :: Proxy ClientM clientM = Proxy -completion :: Value -> ClientM Value-chat :: Value -> ClientM Value-(completion :<|> chat) = api `clientIn` clientM+clientOllamaChat :: Value -> ClientM Value+clientOpenAIV1Chat :: BearerToken -> Value -> ClientM Value+(clientOllamaChat :<|> clientOpenAIV1Chat) = api `clientIn` clientM  -doCompletion :: ToJSON j => Host -> j -> IO Value-doCompletion = doRequest completion+data GenAIException = PostMarshallingException | UnknownResponse String+  deriving (Show, Typeable) -doChat :: ToJSON j => Host -> j -> IO Value-doChat = doRequest chat+instance Exception GenAIException -doRequest :: (FromJSON f, ToJSON t) => (f -> ClientM Value) -> Host -> t -> IO Value-doRequest client' (Host hostName port) bodyData = do-  debugM lname . toS . encode $ bodyData-  let-    bodyDoc = fromMaybe (error "Something went wrong with JSON-ifying the POST data")-      . decode . encode $ bodyData++-- | Make a request to an Ollama server resulting in a JSON @Value@+ollamaChatJ :: ToJSON j => Maybe BaseUrl -> j -> IO Value+ollamaChatJ mBaseUrl j = do   manager' <- newManager $ defaultManagerSettings     { managerResponseTimeout = responseTimeoutMicro defaultHttpTimeout }-  eres <- runClientM (client' bodyDoc)-    (mkClientEnv manager' (BaseUrl Http (toS hostName) port ""))-  case eres of-    Left err -> logAndExit $ show err-    Right v@(Object _) -> pure v-    Right somethingElse -> logAndExit $ show somethingElse+  doRequest clientOllamaChat manager' (fromMaybe Ollama.defaultUrl mBaseUrl) j +-- | Make a request to an Ollama server resulting in a high-level Ollama response+ollamaChat :: ToJSON j => Maybe BaseUrl -> j -> IO OllamaResponse+ollamaChat mBaseUrl j = maybe+  (throwIO . UnknownResponse $ "Unable to read JSON response as an OllamaResponse. Try using ollamaChatJ instead to inspect the bare JSON") pure . decode . encode =<< ollamaChatJ mBaseUrl j -logAndExit :: String -> IO a-logAndExit msg = do-  errorM lname $ formatToString ("Can't continue:" %+ string) msg-  exitFailure+-- | Make a request to an OpenAI server resulting in a JSON @Value@+openaiV1ChatJ :: ToJSON j => BearerToken -> Maybe BaseUrl -> j -> IO Value+openaiV1ChatJ token mBaseUrl j = do+  manager' <- newTlsManagerWith $ tlsManagerSettings+    { managerResponseTimeout = responseTimeoutMicro defaultHttpTimeout }+  doRequest (clientOpenAIV1Chat token) manager' (fromMaybe OpenAI.defaultUrl mBaseUrl) $ toJSON j +-- | Make a request to an OpenAI server resulting in a high-level OpenAI response+openaiV1Chat :: ToJSON j => BearerToken -> Maybe BaseUrl -> j -> IO OpenAIResponse+openaiV1Chat token mBaseUrl j = maybe+  (throwIO . UnknownResponse $ "Unable to read JSON response as an OpenAIResponse. Try using openaiV1ChatJ instead to inspect the bare JSON") pure . decode . encode =<< openaiV1ChatJ token mBaseUrl j -display :: RawOutput -> Value -> IO () -display (RawOutput True) v = BL.putStr $ encode v <> "\n"--display (RawOutput False) (Object keyMap) = case A.lookup "response" keyMap of-  Just (String t) -> TS.putStrLn t-  Just somethingElse -> emergencyM lname $ show somethingElse-  Nothing -> emergencyM lname $ show keyMap--display _ somethingElse = emergencyM lname $ show somethingElse+doRequest :: (FromJSON f, ToJSON t) => (f -> ClientM Value) -> Manager -> BaseUrl -> t -> IO Value+doRequest client' manager' baseUrl bodyData = do+  bodyDoc <- maybe (throwIO PostMarshallingException) pure $ decode . encode $ bodyData+  eres <- runClientM (client' bodyDoc) (mkClientEnv manager' baseUrl)+  case eres of+    Right v@(Object _) -> pure v+    Left err -> throwIO err+    Right somethingElse -> throwIO . UnknownResponse . show $ somethingElse
+ src/lib/GenAILib/JSON.hs view
@@ -0,0 +1,61 @@+module GenAILib.JSON+  ( customJSONOptions+  , flattenOptions+  , jsonToText+  )+  where++import Data.Aeson (Options, Value (Object), defaultOptions, encode,+  fieldLabelModifier, omitNothingFields)+import Data.Aeson.Key (fromText)+import Data.Aeson.KeyMap ((!?), delete, union)+import Data.String.Conv (toS)+import Data.Text.Lazy qualified as TL+++stripInitialUnderscore :: String -> String+stripInitialUnderscore ('_' : fieldName) = fieldName+stripInitialUnderscore fieldName = fieldName+++customJSONOptions :: Options+customJSONOptions = defaultOptions+  { fieldLabelModifier = stripInitialUnderscore+  , omitNothingFields = True+  }+++-- | Most LLM back-ends expect the options like temperature to be at the+--   top-level of the object. This function will move the options Object up and+--   merge it with the other keys, removing the options Object as well.+--+--   Used internally by this library to construct LLM request bodies+--+-- This+--+-- > { "foo" : 1+-- > , "bar" : 5+-- > , "options" : { "bar" : 2, "baz" : 3 }+-- > }+--+-- Becomes this+--+-- > { "foo" : 1+-- > , "bar" : 2+-- > , "baz" : 3+-- > }+flattenOptions :: Value -> Value++flattenOptions (Object origKm) = Object newKm+  where+    optsKey = fromText "options"+    newKm = case origKm !? optsKey of+      (Just (Object optsKm)) -> delete optsKey origKm `union` optsKm+      _ -> origKm++flattenOptions nonObjValue = nonObjValue+++-- | Convenience function to textify a JSON @Value@+jsonToText :: Value -> TL.Text+jsonToText = toS . encode
src/lib/GenAILib/Ollama.hs view
@@ -1,72 +1,113 @@-{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE DuplicateRecordFields, OverloadedRecordDot #-}  module GenAILib.Ollama-  ( Host (..)-  , OllamaRequest (..)-  , Stream (..)-  , System (..)-  , defaultHost-  , hostFromString+  ( OllamaRequest (..)+  , defaultUrl+  , KeepAlive (..)+  , keepalive+  , OllamaResponse (..)+  , getMessage+  -- , stream'   )   where -import Data.Aeson (ToJSON, Value, defaultOptions, genericToEncoding,-  genericToJSON, omitNothingFields, toEncoding, toJSON)-import Data.Aeson qualified as Aeson-import Data.String.Conv (toS)+import Data.Aeson (FromJSON, ToJSON, Value (Object),+  genericToEncoding, genericToJSON, toEncoding, toJSON)+import Data.Aeson.Key (fromText)+import Data.Aeson.KeyMap (singleton, union)+import Data.Maybe (fromMaybe)+import Data.Sequence (Seq, (|>), empty)+import Data.Text qualified as TS import Data.Text.Lazy qualified as TL-import Formatting ((%), formatToString, int, text)+import Data.Time (UTCTime) import GHC.Generics (Generic)-import Text.Read (readMaybe)--import GenAILib.Common (Model, Prompt, splitAtColon)---newtype Stream = Stream Bool-  deriving Generic+import Servant.Client (BaseUrl, parseBaseUrl) -instance ToJSON Stream+import GenAILib (Content (..), Message (..), Model (..), Request (..),+  RequestMod (..), Stream (..))+import GenAILib.JSON (customJSONOptions)  -{- ^ This data structure is used to construct the POST body for an Ollama REST call--}+-- | Data for making Ollama requests data OllamaRequest = OllamaRequest   { model :: Model-  , system :: Maybe System-  , prompt :: Prompt-  , stream :: Stream+  , messages :: Seq Message   , options :: Maybe Value+  , stream :: Stream+  , keep_alive :: Maybe KeepAlive   }-  deriving Generic--customOptions :: Aeson.Options-customOptions = defaultOptions { omitNothingFields = True }+  deriving (Generic, Show)  instance ToJSON OllamaRequest where-  toJSON     = genericToJSON customOptions-  toEncoding = genericToEncoding customOptions+  toJSON     = genericToJSON customJSONOptions+  toEncoding = genericToEncoding customJSONOptions +instance Request OllamaRequest where+  appendMessage :: Message -> OllamaRequest -> OllamaRequest+  appendMessage newMessage oldReq = oldReq { messages = oldReq.messages |> newMessage } -data Host = Host TL.Text Int+  mkRequest :: TL.Text -> RequestMod OllamaRequest -> OllamaRequest+  mkRequest modelName (RequestMod optSetter) = optSetter+    $ OllamaRequest (Model modelName) empty Nothing (Stream False) Nothing --- I don't normally do this because it harms debugging when we want to see the--- actual Haskell data structure serialized BUT this plays nicer with--- optparse-applicative's showDefault-instance Show Host where-  show (Host hostName port) = formatToString (text % ":" % int) hostName port+  setOpt :: TS.Text -> Value -> OllamaRequest -> OllamaRequest+  setOpt keystr val req = req { options = Just . Object $ combinedKm }+    where+      newKm = singleton (fromText keystr) val+      combinedKm = case options req of+        (Just (Object existingKm)) -> existingKm `union` newKm+        _ -> newKm  -defaultHost :: Host-defaultHost = Host "localhost" 11434+-- | How long an Ollama model is kept in memory before clean-up by the Ollama+--   daemon+--+--   This is specific to Ollama.+newtype KeepAlive = KeepAlive TL.Text+  deriving (Generic, Show) +instance ToJSON KeepAlive -hostFromString :: String -> Maybe Host-hostFromString combinedStr = do-  (hostName, portStr) <- splitAtColon combinedStr-  Host (toS hostName) <$> readMaybe portStr +-- FIXME streaming does not work yet for Ollama via this library+-- Enable or disable streaming+-- stream' :: Bool -> OllamaRequest -> OllamaRequest+-- stream' b req = req { stream = Stream b } -newtype System = System TL.Text-  deriving Generic -instance ToJSON System+-- | Set the keep_alive duration+--+--   This takes string duration values like '35m' or '1h'+keepalive :: TL.Text -> RequestMod OllamaRequest+keepalive ka = RequestMod (\req -> req { keep_alive = Just (KeepAlive ka) })+++-- | Data returned for Ollama requests+data OllamaResponse = OllamaResponse+  { model :: Model+  , created_at :: UTCTime+  , message :: Message+  , done :: Bool+  -- Doubtful anyone really needs these fields+  -- , total_duration :: Integer+  -- , load_duration :: Integer+  -- , prompt_eval_count :: Integer+  -- , prompt_eval_duration :: Integer+  -- , eval_count :: Integer+  -- , eval_duration :: Integer+  }+  deriving (Generic, Show)++instance FromJSON OllamaResponse+++-- | The default URL for making Ollama REST calls+defaultUrl :: BaseUrl+defaultUrl = fromMaybe (error "Unable to construct the default url for Ollama!")+  $ parseBaseUrl "localhost:11434"+++-- | Convenience function to extract the response text+getMessage :: OllamaResponse -> TL.Text+getMessage res = assistantResponse+  where (Content assistantResponse) = content . message $ res
+ src/lib/GenAILib/OpenAI.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE DuplicateRecordFields, OverloadedRecordDot #-}++module GenAILib.OpenAI+  ( OpenAIResponse (..)+  , OpenAIRequest (..)+  , defaultUrl+  , getMessage+  )+  where++import Data.Aeson (FromJSON, ToJSON, Value (Object, String), (.:),+  genericToEncoding, genericToJSON, parseJSON, toEncoding, toJSON)+import Data.Aeson.Key (fromText)+import Data.Aeson.KeyMap (singleton, union)+import Data.Aeson.Types (prependFailure, typeMismatch)+import Data.Maybe (fromMaybe)+import Data.Sequence (Seq, (|>), empty)+import Data.Text qualified as TS+import Data.Text.Lazy qualified as TL+import Data.Time (UTCTime)+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)+import GHC.Generics (Generic)+import Servant.Client (BaseUrl, parseBaseUrl)++import GenAILib (Content (..), Message (..), Model (..), Request (..),+  RequestMod (..), Stream (..))+import GenAILib.JSON (customJSONOptions, flattenOptions)+++-- | Data for making OpenAI requests+data OpenAIRequest = OpenAIRequest+  { model :: Model+  , messages :: Seq Message+  , options :: Maybe Value+  , stream :: Maybe Stream+  }+  deriving (Generic, Show)++instance ToJSON OpenAIRequest where+  toJSON = flattenOptions . genericToJSON customJSONOptions+  toEncoding = genericToEncoding customJSONOptions++instance Request OpenAIRequest where+  appendMessage :: Message -> OpenAIRequest -> OpenAIRequest+  appendMessage newMessage oldReq = oldReq { messages = oldReq.messages |> newMessage }++  mkRequest :: TL.Text -> RequestMod OpenAIRequest -> OpenAIRequest+  mkRequest modelName (RequestMod optSetter) = optSetter+    $ OpenAIRequest (Model modelName) empty Nothing Nothing++  setOpt :: TS.Text -> Value -> OpenAIRequest -> OpenAIRequest+  setOpt keystr val req = req { options = Just . Object $ combinedKm }+    where+      newKm = singleton (fromText keystr) val+      combinedKm = case options req of+        (Just (Object existingKm)) -> existingKm `union` newKm+        _ -> newKm+++-- | Data returned for OpenAI requests+data OpenAIResponse = OpenAIResponse+  { model :: Model+  , created :: UTCTime+  , message :: Message+  , done :: Bool+  }+  deriving (Generic, Show)++-- Unfortunately, the OpenAI response JSON is a weird enough shape I decided to+-- take it apart it by-hand+{- HLINT ignore "Functor law" -}+instance FromJSON OpenAIResponse where+  parseJSON (Object o) = do+    choices <- o .: "choices"+    choice <- if null choices+      then fail "No elements in choices array, unable to decode this JSON"+      else pure $ head choices+    OpenAIResponse+      <$> (Model <$> o .: "model")+      <*> (posixSecondsToUTCTime <$> o .: "created")+      <*> (parseJSON =<< choice .: "message")+      <*> (isDone <$> choice .: "finish_reason")+  parseJSON invalid    = prependFailure "Parsing OpenAI chat completion response"+    $ typeMismatch "Object" invalid++isDone :: Value -> Bool+isDone (String s) = s == "stop"+isDone _ = False+++-- | The default URL for OpenAI REST calls+defaultUrl :: BaseUrl+defaultUrl = fromMaybe (error "Unable to construct the default url for OpenAI!")+  $ parseBaseUrl "https://api.openai.com"+++-- | Convenience function to extract the response text+getMessage :: OpenAIResponse -> TL.Text+getMessage res = assistantResponse+  where (Content assistantResponse) = content . message $ res
− src/lib/GenAILib/System/Log.hs 
@@ -1,47 +0,0 @@-module GenAILib.System.Log-  ( initLogging, lname-  , logTest--  -- Re-exported from System.Log.Logger-  , Priority (..), debugM, infoM, noticeM, warningM, errorM-  , criticalM, alertM, emergencyM-  )-  where--import Data.Maybe (fromMaybe)-import System.IO (stderr)-import System.Log.Formatter (simpleLogFormatter)-import System.Log.Handler (setFormatter)-import System.Log.Handler.Simple (streamHandler)-import System.Log.Logger---lname :: String-lname = "normal-output"---initLogging :: Maybe Priority -> IO ()-initLogging mLogPriority = do-  let logPriority = fromMaybe NOTICE mLogPriority--  -- Remove the root logger's default handler that writes every-  -- message to stderr!-  updateGlobalLogger rootLoggerName removeHandler--  errH <- flip setFormatter (simpleLogFormatter "[$time : $prio] $msg")-    <$> streamHandler stderr DEBUG-  updateGlobalLogger lname $ setHandlers [errH]-  updateGlobalLogger lname $ setLevel logPriority----- Test function to generate every kind of log message-logTest :: IO ()-logTest = do-  debugM     lname "log test message DEBUG 1 of 8"-  infoM      lname "log test message INFO 2 of 8"-  noticeM    lname "log test message NOTICE 3 of 8"-  warningM   lname "log test message WARNING 4 of 8"-  errorM     lname "log test message ERROR 5 of 8"-  criticalM  lname "log test message CRITICAL 6 of 8"-  alertM     lname "log test message ALERT 7 of 8"-  emergencyM lname "log test message EMERGENCY 8 of 8"