llama-cpp-haskell 0.2.1 → 0.3

raw patch · 3 files changed

+62/−21 lines, 3 filesdep +data-defaultPVP ok

version bump matches the API change (PVP)

Dependencies added: data-default

API changes (from Hackage documentation)

Files

• Llama.hs +50/−15
• Main.hs +9/−4
• llama-cpp-haskell.cabal +3/−2

@@ -5,6 +5,7 @@ import Conduit import Data.Aeson import Data.ByteString.Lazy (ByteString)+import Data.Default import Data.Text (Text) import Data.Word import GHC.Generics@@ -27,8 +28,9 @@   } deriving (Show, Generic) instance ToJSON LlamaMessage -newtype LlamaApplyTemplateRequest = LlamaApplyTemplateRequest+data LlamaApplyTemplateRequest = LlamaApplyTemplateRequest   { messages :: [LlamaMessage]+  , model :: Maybe Text   } deriving (Show, Generic) instance ToJSON LlamaApplyTemplateRequest @@ -61,12 +63,25 @@  data Health = HealthOk | HealthNok deriving (Show) +-- llama.cpp rejects requests with null options since https://github.com/ggml-org/llama.cpp/pull/24150+noMaybes = defaultOptions { omitNothingFields = True } -- Llama request and response data LlamaRequest = LlamaRequest   { prompt :: Text   , stream :: Bool+  , cache_prompt :: Maybe Bool+  , model :: Maybe Text   } deriving (Show, Generic)-instance ToJSON LlamaRequest+instance ToJSON LlamaRequest where+  toJSON = genericToJSON noMaybes+  toEncoding = genericToEncoding noMaybes+instance Default LlamaRequest where+  def = LlamaRequest+      { prompt = ""+      , stream = False+      , cache_prompt = Nothing+      , model = Nothing+      }  newtype LlamaResponse = LlamaResponse   { content :: Text@@ -97,29 +112,39 @@   case decode (responseBody response) of     Just (LlamaApplyTemplateResponse text) -> return (Just text)     Nothing -> do-      liftIO $ hPutStrLn stderr "Failed to decode Llama response"+      liftIO $ hPutStrLn stderr $ "Failed to decode Llama response, got: " ++ (show $ responseBody response)       return Nothing --- Function to send a message to the Llama model+-- |Simple completion API sendToLlama :: URL -> Manager -> Text -> IO (Maybe Text)-sendToLlama url manager input = do+sendToLlama url manager input = sendToLlamaRequest url manager (def { prompt = input })++-- |Allows to specify other completion options+sendToLlamaRequest :: URL -> Manager -> LlamaRequest -> IO (Maybe Text)+sendToLlamaRequest url manager lreq = do   let request = parseRequest_ $ url ++ "/completion"-      body = encode (LlamaRequest input False)+      body = encode lreq       req = request { method = "POST"                     , requestBody = RequestBodyLBS body                     , requestHeaders = [("Content-Type", "application/json")]+                    , responseTimeout = responseTimeoutMicro 1800000000                     }   response <- httpLbs req manager   case decode (responseBody response) of     Just (LlamaResponse text) -> return (Just text)     Nothing -> do-      liftIO $ hPutStrLn stderr "Failed to decode Llama response"+      liftIO $ hPutStrLn stderr $ "Failed to decode Llama response, got: " ++ (show $ responseBody response)       return Nothing +-- |Returns a token-by-token stream sendToLlamaStreaming :: (MonadThrow m, MonadResource m) => URL -> Manager -> Text -> IO (ConduitT () LlamaStreamingResponse m ())-sendToLlamaStreaming url manager input = do+sendToLlamaStreaming url manager input = sendToLlamaStreamingRequest url manager (def { prompt = input })++-- |Allows to specify other completion options+sendToLlamaStreamingRequest :: (MonadThrow m, MonadResource m) => URL -> Manager -> LlamaRequest -> IO (ConduitT () LlamaStreamingResponse m ())+sendToLlamaStreamingRequest url manager lreq = do   let request = setRequestManager manager $ parseRequest_ $ url ++ "/completion"-      body = encode (LlamaRequest input True)+      body = encode (lreq { stream = True })       req = request { method = "POST"                     , requestBody = RequestBodyLBS body                     , requestHeaders = [("Content-Type", "application/json")]@@ -137,7 +162,7 @@   case decode (responseBody response) of     Just (LlamaTokenizeResponse result) -> return (Just result)     Nothing -> do-      liftIO $ hPutStrLn stderr "Failed to decode Llama response"+      liftIO $ hPutStrLn stderr $ "Failed to decode Llama response, got: " ++ (show $ responseBody response)       return Nothing  detokenize :: URL -> [Token] -> IO (Maybe Text)@@ -152,28 +177,38 @@   case decode (responseBody response) of     Just (LlamaDetokenizeResponse text) -> return (Just text)     Nothing -> do-      liftIO $ hPutStrLn stderr "Failed to decode Llama response"+      liftIO $ hPutStrLn stderr $ "Failed to decode Llama response, got: " ++ (show $ responseBody response)       return Nothing +-- |Extremely basic interface llama :: URL -> Text -> IO (Maybe Text) llama url input = do   manager <- liftIO $ newManager tlsManagerSettings { managerResponseTimeout = responseTimeoutNone }   sendToLlama url manager input +-- |Uses `applyTemplate` before sending the completion request llamaTemplated :: URL -> LlamaApplyTemplateRequest -> IO (Maybe Text)-llamaTemplated url input = do+llamaTemplated url input = llamaTemplatedRequest url input def++-- |Make sure to use the same model in both `LlamaApplyTemplateRequest` and `LlamaRequest`+llamaTemplatedRequest :: URL -> LlamaApplyTemplateRequest -> LlamaRequest -> IO (Maybe Text)+llamaTemplatedRequest url input lreq = do   manager <- liftIO $ newManager tlsManagerSettings { managerResponseTimeout = responseTimeoutNone }   res <- applyTemplate url manager input   case res of-    Just text -> sendToLlama url manager text+    Just text -> sendToLlamaRequest url manager lreq { prompt = text }     _ -> pure Nothing  llamaTemplatedStreaming :: (MonadThrow m, MonadResource m) => URL -> LlamaApplyTemplateRequest -> IO (ConduitT () LlamaStreamingResponse m ())-llamaTemplatedStreaming url input = do+llamaTemplatedStreaming url input = llamaTemplatedStreamingRequest url input def++-- |Make sure to use the same model in both `LlamaApplyTemplateRequest` and `LlamaRequest`+llamaTemplatedStreamingRequest :: (MonadThrow m, MonadResource m) => URL -> LlamaApplyTemplateRequest -> LlamaRequest -> IO (ConduitT () LlamaStreamingResponse m ())+llamaTemplatedStreamingRequest url input lreq = do   manager <- liftIO $ newManager tlsManagerSettings { managerResponseTimeout = responseTimeoutNone }   res <- applyTemplate url manager input   case res of-    Just text -> sendToLlamaStreaming url manager text+    Just text -> sendToLlamaStreamingRequest url manager lreq { prompt = text }     _ -> pure $ yieldMany []  health :: URL -> IO Health

@@ -1,6 +1,8 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DisambiguateRecordFields #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeOperators #-}@@ -9,13 +11,15 @@  import Conduit import Data.Conduit.Lazy+import Data.Default import qualified Data.Text as T import qualified Data.Text.IO as T import Options.Generic import System.Exit import System.IO -import Llama+import Llama hiding (model)+import qualified Llama import Llama.Streaming as LS  data Options w = Options@@ -24,6 +28,7 @@   , streaming :: w ::: Bool <?> "use to stream output from the LLM"   , stripThinking :: w ::: Bool <?> "remove \"</think>\" and everything that occurs before it"   , templateOnly :: w ::: Bool <?> "only apply the chat template without running LLM completion"+  , model :: w ::: Maybe Text <?> "model to use"   } deriving (Generic)  instance ParseRecord (Options Wrapped) where@@ -38,20 +43,20 @@                 , LlamaMessage User input                 ]   if templateOnly opts then do-    response <- applyTemplateSimple (url opts) (LlamaApplyTemplateRequest request)+    response <- applyTemplateSimple (url opts) (LlamaApplyTemplateRequest request opts.model)     case response of       Nothing -> T.hPutStrLn stderr "Got no response from the server." >> exitFailure       Just r -> T.putStrLn $ if stripThinking opts then snd $ T.breakOnEnd "</think>" r else r   else     case streaming opts of       False -> do-        response <- llamaTemplated (url opts) (LlamaApplyTemplateRequest request)+        response <- llamaTemplatedRequest opts.url (LlamaApplyTemplateRequest request opts.model) (def { Llama.model = opts.model })         case response of           Nothing -> T.hPutStrLn stderr "Got no response from the server." >> exitFailure           Just r -> T.putStrLn $ if stripThinking opts then snd $ T.breakOnEnd "</think>" r else r       True -> do         hSetBuffering stdout NoBuffering-        conduit <- llamaTemplatedStreaming (url opts) (LlamaApplyTemplateRequest request)+        conduit <- llamaTemplatedStreamingRequest opts.url (LlamaApplyTemplateRequest request opts.model) (def { Llama.model = opts.model })         runResourceT $ do           list <- lazyConsume conduit           liftIO $ mapM_ T.putStr $ (if stripThinking opts then dropSep "</think>" else id) $ map LS.content list

@@ -1,6 +1,6 @@ cabal-version:      2.2 name:               llama-cpp-haskell-version:            0.2.1+version:            0.3 synopsis:           Haskell bindings for the llama.cpp llama-server and a simple CLI description:        This is the interface that allows one to interface with llama-server RPC API using Haskell concepts. It also includes a `llamacall` binary to do it from your favorite command line shell and use it in scripting. license:            AGPL-3.0-only@@ -20,7 +20,7 @@ Source-repository this   type:              git   location:          https://github.com/l29ah/llama-cpp-haskell.git-  tag:               0.2.1+  tag:               0.3  common stuff     ghc-options: -Wall@@ -36,6 +36,7 @@                     , http-types ^>= 0.12                     , bytestring ^>= 0.12.2.0                     , attoparsec ^>= 0.14.4+                    , data-default >= 0.7 && < 0.9  library     import:           stuff