never executed always true always false

    1 module PureClaw.Tools.Memory
    2   ( -- * Tool registration
    3     memoryStoreTool
    4   , memoryRecallTool
    5   ) where
    6 
    7 import Control.Exception
    8 import Data.Aeson
    9 import Data.Aeson.Types
   10 import Data.Map.Strict qualified as Map
   11 import Data.Text (Text)
   12 import Data.Text qualified as T
   13 
   14 import PureClaw.Core.Types
   15 import PureClaw.Handles.Memory
   16 import PureClaw.Providers.Class
   17 import PureClaw.Tools.Registry
   18 
   19 -- | Create a memory store tool.
   20 memoryStoreTool :: MemoryHandle -> (ToolDefinition, ToolHandler)
   21 memoryStoreTool mh = (def, handler)
   22   where
   23     def = ToolDefinition
   24       { _td_name        = "memory_store"
   25       , _td_description = "Store a piece of information in long-term memory for later recall."
   26       , _td_inputSchema = object
   27           [ "type" .= ("object" :: Text)
   28           , "properties" .= object
   29               [ "content" .= object
   30                   [ "type" .= ("string" :: Text)
   31                   , "description" .= ("The content to remember" :: Text)
   32                   ]
   33               , "tags" .= object
   34                   [ "type" .= ("string" :: Text)
   35                   , "description" .= ("Comma-separated tags for categorization" :: Text)
   36                   ]
   37               ]
   38           , "required" .= (["content"] :: [Text])
   39           ]
   40       }
   41 
   42     handler = ToolHandler $ \input ->
   43       case parseEither parseInput input of
   44         Left err -> pure (T.pack err, True)
   45         Right (content, tags) -> do
   46           let source = MemorySource
   47                 { _ms_content  = content
   48                 , _ms_metadata = Map.fromList [("tags", tags)]
   49                 }
   50           result <- try @SomeException (_mh_save mh source)
   51           case result of
   52             Left e -> pure (T.pack (show e), True)
   53             Right Nothing -> pure ("Failed to store memory", True)
   54             Right (Just mid) -> pure ("Stored with id: " <> unMemoryId mid, False)
   55 
   56     parseInput :: Value -> Parser (Text, Text)
   57     parseInput = withObject "MemoryStoreInput" $ \o ->
   58       (,) <$> o .: "content" <*> o .:? "tags" .!= ""
   59 
   60 -- | Create a memory recall tool.
   61 memoryRecallTool :: MemoryHandle -> (ToolDefinition, ToolHandler)
   62 memoryRecallTool mh = (def, handler)
   63   where
   64     def = ToolDefinition
   65       { _td_name        = "memory_recall"
   66       , _td_description = "Search long-term memory for relevant information."
   67       , _td_inputSchema = object
   68           [ "type" .= ("object" :: Text)
   69           , "properties" .= object
   70               [ "query" .= object
   71                   [ "type" .= ("string" :: Text)
   72                   , "description" .= ("The search query" :: Text)
   73                   ]
   74               ]
   75           , "required" .= (["query"] :: [Text])
   76           ]
   77       }
   78 
   79     handler = ToolHandler $ \input ->
   80       case parseEither parseInput input of
   81         Left err -> pure (T.pack err, True)
   82         Right query -> do
   83           result <- try @SomeException (_mh_search mh query defaultSearchConfig)
   84           case result of
   85             Left e -> pure (T.pack (show e), True)
   86             Right [] -> pure ("No memories found for: " <> query, False)
   87             Right results ->
   88               let formatted = T.intercalate "\n---\n"
   89                     [ _sr_content r <> " (score: " <> T.pack (show (_sr_score r)) <> ")"
   90                     | r <- results
   91                     ]
   92               in pure (formatted, False)
   93 
   94     parseInput :: Value -> Parser Text
   95     parseInput = withObject "MemoryRecallInput" $ \o -> o .: "query"