llama-cpp-haskell 0 → 0.0.1

raw patch · 2 files changed

+63/−8 lines, 2 files

Files

• Llama.hs +61/−6
• llama-cpp-haskell.cabal +2/−2

@@ -1,18 +1,54 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings, DeriveGeneric #-}  module Llama where -import Network.HTTP.Conduit+import Control.Monad.IO.Class (liftIO) import Data.Aeson import Data.Text (Text)-import Control.Monad.IO.Class (liftIO)+import GHC.Generics+import Network.HTTP.Conduit import System.IO (hPutStrLn, stderr) +data Role = System | User | CustomRole Text deriving Show+instance ToJSON Role where+  toJSON System = "system"+  toJSON User = "system"+  toJSON (CustomRole t) = String t++data LlamaMessage = LlamaMessage+  { role :: Role+  , content :: Text+  } deriving (Show)++instance ToJSON LlamaMessage where+  toJSON m =+    object+      [ "role" .= role m+      , "content" .= content m+      ]++data LlamaApplyTemplateRequest = LlamaApplyTemplateRequest+  { messages :: [LlamaMessage]+  } deriving (Show, Generic)+instance ToJSON LlamaApplyTemplateRequest++--data LlamaApplyTemplateResponse = LlamaApplyTemplateResponse+--  { prompt :: Text+--  } deriving (Show)+ -- Llama request and response data LlamaRequest = LlamaRequest   { prompt :: Text   } deriving (Show) +instance FromJSON LlamaRequest where+  parseJSON = withObject "LlamaRequest" $ \v -> LlamaRequest+    <$> v .: "prompt"++instance ToJSON LlamaRequest where+  toJSON (LlamaRequest p) =+    object ["prompt" .= p]+ data LlamaResponse = LlamaResponse   { generatedText :: Text   } deriving (Show)@@ -21,9 +57,20 @@   parseJSON = withObject "LlamaResponse" $ \v -> LlamaResponse     <$> v .: "content" -instance ToJSON LlamaRequest where-  toJSON (LlamaRequest p) =-    object ["prompt" .= p]+applyTemplate :: Manager -> LlamaApplyTemplateRequest -> IO (Maybe Text)+applyTemplate manager input = do+  let request = parseRequest_ "http://localhost:8080/apply-template"+      body = encode input+      req = request { method = "POST"+                    , requestBody = RequestBodyLBS body+                    , requestHeaders = [("Content-Type", "application/json")]+                    }+  response <- httpLbs req manager+  case decode (responseBody response) of+    Just (LlamaRequest text) -> return (Just text)+    Nothing -> do+      liftIO $ hPutStrLn stderr "Failed to decode Llama response"+      return Nothing  -- Function to send a message to the Llama model sendToLlama :: Manager -> Text -> IO (Maybe Text)@@ -45,3 +92,11 @@ llama input = do   manager <- liftIO $ newManager tlsManagerSettings { managerResponseTimeout = responseTimeoutNone }   sendToLlama manager input++llamaTemplated :: LlamaApplyTemplateRequest -> IO (Maybe Text)+llamaTemplated input = do+  manager <- liftIO $ newManager tlsManagerSettings { managerResponseTimeout = responseTimeoutNone }+  res <- applyTemplate manager input+  case res of+    Just text -> sendToLlama manager text+    _ -> pure Nothing

@@ -1,6 +1,6 @@ cabal-version:      2.2 name:               llama-cpp-haskell-version:            0+version:            0.0.1 synopsis:           Haskell bindings for the llama.cpp llama-server -- description: license:            AGPL-3.0-only@@ -19,7 +19,7 @@ Source-repository this   type:              git   location:          https://github.com/l29ah/llama-cpp-haskell.git-  tag:               0+  tag:               0.0.1  common stuff     ghc-options: -Wall