{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module IntelliMonad.Tools.KeyValue where

import Control.Monad.IO.Class
import qualified Data.Aeson as A
import Data.Text (Text)
import Database.Persist.Sqlite (SqliteConf)
import GHC.Generics
import GHC.IO.Exception
import IntelliMonad.Persist
import IntelliMonad.Prompt
import IntelliMonad.Types
import qualified OpenAI.Types as API
import System.Process
import Data.Proxy

data GetKey = GetKey
  { GetKey -> Text
key :: Text
  }
  deriving (GetKey -> GetKey -> Bool
(GetKey -> GetKey -> Bool)
-> (GetKey -> GetKey -> Bool) -> Eq GetKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetKey -> GetKey -> Bool
== :: GetKey -> GetKey -> Bool
$c/= :: GetKey -> GetKey -> Bool
/= :: GetKey -> GetKey -> Bool
Eq, Int -> GetKey -> ShowS
[GetKey] -> ShowS
GetKey -> String
(Int -> GetKey -> ShowS)
-> (GetKey -> String) -> ([GetKey] -> ShowS) -> Show GetKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetKey -> ShowS
showsPrec :: Int -> GetKey -> ShowS
$cshow :: GetKey -> String
show :: GetKey -> String
$cshowList :: [GetKey] -> ShowS
showList :: [GetKey] -> ShowS
Show, (forall x. GetKey -> Rep GetKey x)
-> (forall x. Rep GetKey x -> GetKey) -> Generic GetKey
forall x. Rep GetKey x -> GetKey
forall x. GetKey -> Rep GetKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GetKey -> Rep GetKey x
from :: forall x. GetKey -> Rep GetKey x
$cto :: forall x. Rep GetKey x -> GetKey
to :: forall x. Rep GetKey x -> GetKey
Generic, Schema
Schema -> JSONSchema GetKey
forall r. Schema -> JSONSchema r
$cschema :: Schema
schema :: Schema
JSONSchema, Maybe GetKey
Value -> Parser [GetKey]
Value -> Parser GetKey
(Value -> Parser GetKey)
-> (Value -> Parser [GetKey]) -> Maybe GetKey -> FromJSON GetKey
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser GetKey
parseJSON :: Value -> Parser GetKey
$cparseJSONList :: Value -> Parser [GetKey]
parseJSONList :: Value -> Parser [GetKey]
$comittedField :: Maybe GetKey
omittedField :: Maybe GetKey
A.FromJSON, [GetKey] -> Value
[GetKey] -> Encoding
GetKey -> Bool
GetKey -> Value
GetKey -> Encoding
(GetKey -> Value)
-> (GetKey -> Encoding)
-> ([GetKey] -> Value)
-> ([GetKey] -> Encoding)
-> (GetKey -> Bool)
-> ToJSON GetKey
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: GetKey -> Value
toJSON :: GetKey -> Value
$ctoEncoding :: GetKey -> Encoding
toEncoding :: GetKey -> Encoding
$ctoJSONList :: [GetKey] -> Value
toJSONList :: [GetKey] -> Value
$ctoEncodingList :: [GetKey] -> Encoding
toEncodingList :: [GetKey] -> Encoding
$comitField :: GetKey -> Bool
omitField :: GetKey -> Bool
A.ToJSON)

instance HasFunctionObject GetKey where
  getFunctionName :: String
getFunctionName = String
"get_key"
  getFunctionDescription :: String
getFunctionDescription = String
"Get a key from the key-value store"
  getFieldDescription :: ShowS
getFieldDescription String
"key" = String
"The key to get"

data SetKey = SetKey
  { SetKey -> Text
key :: Text,
    SetKey -> Text
value :: Text
  }
  deriving (SetKey -> SetKey -> Bool
(SetKey -> SetKey -> Bool)
-> (SetKey -> SetKey -> Bool) -> Eq SetKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SetKey -> SetKey -> Bool
== :: SetKey -> SetKey -> Bool
$c/= :: SetKey -> SetKey -> Bool
/= :: SetKey -> SetKey -> Bool
Eq, Int -> SetKey -> ShowS
[SetKey] -> ShowS
SetKey -> String
(Int -> SetKey -> ShowS)
-> (SetKey -> String) -> ([SetKey] -> ShowS) -> Show SetKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SetKey -> ShowS
showsPrec :: Int -> SetKey -> ShowS
$cshow :: SetKey -> String
show :: SetKey -> String
$cshowList :: [SetKey] -> ShowS
showList :: [SetKey] -> ShowS
Show, (forall x. SetKey -> Rep SetKey x)
-> (forall x. Rep SetKey x -> SetKey) -> Generic SetKey
forall x. Rep SetKey x -> SetKey
forall x. SetKey -> Rep SetKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SetKey -> Rep SetKey x
from :: forall x. SetKey -> Rep SetKey x
$cto :: forall x. Rep SetKey x -> SetKey
to :: forall x. Rep SetKey x -> SetKey
Generic, Schema
Schema -> JSONSchema SetKey
forall r. Schema -> JSONSchema r
$cschema :: Schema
schema :: Schema
JSONSchema, Maybe SetKey
Value -> Parser [SetKey]
Value -> Parser SetKey
(Value -> Parser SetKey)
-> (Value -> Parser [SetKey]) -> Maybe SetKey -> FromJSON SetKey
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser SetKey
parseJSON :: Value -> Parser SetKey
$cparseJSONList :: Value -> Parser [SetKey]
parseJSONList :: Value -> Parser [SetKey]
$comittedField :: Maybe SetKey
omittedField :: Maybe SetKey
A.FromJSON, [SetKey] -> Value
[SetKey] -> Encoding
SetKey -> Bool
SetKey -> Value
SetKey -> Encoding
(SetKey -> Value)
-> (SetKey -> Encoding)
-> ([SetKey] -> Value)
-> ([SetKey] -> Encoding)
-> (SetKey -> Bool)
-> ToJSON SetKey
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: SetKey -> Value
toJSON :: SetKey -> Value
$ctoEncoding :: SetKey -> Encoding
toEncoding :: SetKey -> Encoding
$ctoJSONList :: [SetKey] -> Value
toJSONList :: [SetKey] -> Value
$ctoEncodingList :: [SetKey] -> Encoding
toEncodingList :: [SetKey] -> Encoding
$comitField :: SetKey -> Bool
omitField :: SetKey -> Bool
A.ToJSON)

instance HasFunctionObject SetKey where
  getFunctionName :: String
getFunctionName = String
"set_key"
  getFunctionDescription :: String
getFunctionDescription = String
"Set a key in the key-value store"
  getFieldDescription :: ShowS
getFieldDescription String
"key" = String
"The key to set"
  getFieldDescription String
"value" = String
"The value to set"

data DeleteKey = DeleteKey
  { DeleteKey -> Text
key :: Text
  }
  deriving (DeleteKey -> DeleteKey -> Bool
(DeleteKey -> DeleteKey -> Bool)
-> (DeleteKey -> DeleteKey -> Bool) -> Eq DeleteKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeleteKey -> DeleteKey -> Bool
== :: DeleteKey -> DeleteKey -> Bool
$c/= :: DeleteKey -> DeleteKey -> Bool
/= :: DeleteKey -> DeleteKey -> Bool
Eq, Int -> DeleteKey -> ShowS
[DeleteKey] -> ShowS
DeleteKey -> String
(Int -> DeleteKey -> ShowS)
-> (DeleteKey -> String)
-> ([DeleteKey] -> ShowS)
-> Show DeleteKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeleteKey -> ShowS
showsPrec :: Int -> DeleteKey -> ShowS
$cshow :: DeleteKey -> String
show :: DeleteKey -> String
$cshowList :: [DeleteKey] -> ShowS
showList :: [DeleteKey] -> ShowS
Show, (forall x. DeleteKey -> Rep DeleteKey x)
-> (forall x. Rep DeleteKey x -> DeleteKey) -> Generic DeleteKey
forall x. Rep DeleteKey x -> DeleteKey
forall x. DeleteKey -> Rep DeleteKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DeleteKey -> Rep DeleteKey x
from :: forall x. DeleteKey -> Rep DeleteKey x
$cto :: forall x. Rep DeleteKey x -> DeleteKey
to :: forall x. Rep DeleteKey x -> DeleteKey
Generic, Schema
Schema -> JSONSchema DeleteKey
forall r. Schema -> JSONSchema r
$cschema :: Schema
schema :: Schema
JSONSchema, Maybe DeleteKey
Value -> Parser [DeleteKey]
Value -> Parser DeleteKey
(Value -> Parser DeleteKey)
-> (Value -> Parser [DeleteKey])
-> Maybe DeleteKey
-> FromJSON DeleteKey
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser DeleteKey
parseJSON :: Value -> Parser DeleteKey
$cparseJSONList :: Value -> Parser [DeleteKey]
parseJSONList :: Value -> Parser [DeleteKey]
$comittedField :: Maybe DeleteKey
omittedField :: Maybe DeleteKey
A.FromJSON, [DeleteKey] -> Value
[DeleteKey] -> Encoding
DeleteKey -> Bool
DeleteKey -> Value
DeleteKey -> Encoding
(DeleteKey -> Value)
-> (DeleteKey -> Encoding)
-> ([DeleteKey] -> Value)
-> ([DeleteKey] -> Encoding)
-> (DeleteKey -> Bool)
-> ToJSON DeleteKey
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: DeleteKey -> Value
toJSON :: DeleteKey -> Value
$ctoEncoding :: DeleteKey -> Encoding
toEncoding :: DeleteKey -> Encoding
$ctoJSONList :: [DeleteKey] -> Value
toJSONList :: [DeleteKey] -> Value
$ctoEncodingList :: [DeleteKey] -> Encoding
toEncodingList :: [DeleteKey] -> Encoding
$comitField :: DeleteKey -> Bool
omitField :: DeleteKey -> Bool
A.ToJSON)

instance HasFunctionObject DeleteKey where
  getFunctionName :: String
getFunctionName = String
"delete_key"
  getFunctionDescription :: String
getFunctionDescription = String
"Delete a key from the key-value store"
  getFieldDescription :: ShowS
getFieldDescription String
"key" = String
"The key to delete"

data ListKeys = ListKeys ()
  deriving (ListKeys -> ListKeys -> Bool
(ListKeys -> ListKeys -> Bool)
-> (ListKeys -> ListKeys -> Bool) -> Eq ListKeys
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListKeys -> ListKeys -> Bool
== :: ListKeys -> ListKeys -> Bool
$c/= :: ListKeys -> ListKeys -> Bool
/= :: ListKeys -> ListKeys -> Bool
Eq, Int -> ListKeys -> ShowS
[ListKeys] -> ShowS
ListKeys -> String
(Int -> ListKeys -> ShowS)
-> (ListKeys -> String) -> ([ListKeys] -> ShowS) -> Show ListKeys
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListKeys -> ShowS
showsPrec :: Int -> ListKeys -> ShowS
$cshow :: ListKeys -> String
show :: ListKeys -> String
$cshowList :: [ListKeys] -> ShowS
showList :: [ListKeys] -> ShowS
Show, (forall x. ListKeys -> Rep ListKeys x)
-> (forall x. Rep ListKeys x -> ListKeys) -> Generic ListKeys
forall x. Rep ListKeys x -> ListKeys
forall x. ListKeys -> Rep ListKeys x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ListKeys -> Rep ListKeys x
from :: forall x. ListKeys -> Rep ListKeys x
$cto :: forall x. Rep ListKeys x -> ListKeys
to :: forall x. Rep ListKeys x -> ListKeys
Generic, Schema
Schema -> JSONSchema ListKeys
forall r. Schema -> JSONSchema r
$cschema :: Schema
schema :: Schema
JSONSchema, Maybe ListKeys
Value -> Parser [ListKeys]
Value -> Parser ListKeys
(Value -> Parser ListKeys)
-> (Value -> Parser [ListKeys])
-> Maybe ListKeys
-> FromJSON ListKeys
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ListKeys
parseJSON :: Value -> Parser ListKeys
$cparseJSONList :: Value -> Parser [ListKeys]
parseJSONList :: Value -> Parser [ListKeys]
$comittedField :: Maybe ListKeys
omittedField :: Maybe ListKeys
A.FromJSON, [ListKeys] -> Value
[ListKeys] -> Encoding
ListKeys -> Bool
ListKeys -> Value
ListKeys -> Encoding
(ListKeys -> Value)
-> (ListKeys -> Encoding)
-> ([ListKeys] -> Value)
-> ([ListKeys] -> Encoding)
-> (ListKeys -> Bool)
-> ToJSON ListKeys
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ListKeys -> Value
toJSON :: ListKeys -> Value
$ctoEncoding :: ListKeys -> Encoding
toEncoding :: ListKeys -> Encoding
$ctoJSONList :: [ListKeys] -> Value
toJSONList :: [ListKeys] -> Value
$ctoEncodingList :: [ListKeys] -> Encoding
toEncodingList :: [ListKeys] -> Encoding
$comitField :: ListKeys -> Bool
omitField :: ListKeys -> Bool
A.ToJSON)

instance HasFunctionObject ListKeys where
  getFunctionName :: String
getFunctionName = String
"list_keys"
  getFunctionDescription :: String
getFunctionDescription = String
"List all keys in the key-value store"

instance Tool GetKey where
  data Output GetKey = GetKeyOutput
    { Output GetKey -> Text
value :: Text,
      Output GetKey -> Int
code :: Int,
      Output GetKey -> Text
stderr :: Text
    }
    deriving (Output GetKey -> Output GetKey -> Bool
(Output GetKey -> Output GetKey -> Bool)
-> (Output GetKey -> Output GetKey -> Bool) -> Eq (Output GetKey)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Output GetKey -> Output GetKey -> Bool
== :: Output GetKey -> Output GetKey -> Bool
$c/= :: Output GetKey -> Output GetKey -> Bool
/= :: Output GetKey -> Output GetKey -> Bool
Eq, Int -> Output GetKey -> ShowS
[Output GetKey] -> ShowS
Output GetKey -> String
(Int -> Output GetKey -> ShowS)
-> (Output GetKey -> String)
-> ([Output GetKey] -> ShowS)
-> Show (Output GetKey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Output GetKey -> ShowS
showsPrec :: Int -> Output GetKey -> ShowS
$cshow :: Output GetKey -> String
show :: Output GetKey -> String
$cshowList :: [Output GetKey] -> ShowS
showList :: [Output GetKey] -> ShowS
Show, (forall x. Output GetKey -> Rep (Output GetKey) x)
-> (forall x. Rep (Output GetKey) x -> Output GetKey)
-> Generic (Output GetKey)
forall x. Rep (Output GetKey) x -> Output GetKey
forall x. Output GetKey -> Rep (Output GetKey) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Output GetKey -> Rep (Output GetKey) x
from :: forall x. Output GetKey -> Rep (Output GetKey) x
$cto :: forall x. Rep (Output GetKey) x -> Output GetKey
to :: forall x. Rep (Output GetKey) x -> Output GetKey
Generic, Maybe (Output GetKey)
Value -> Parser [Output GetKey]
Value -> Parser (Output GetKey)
(Value -> Parser (Output GetKey))
-> (Value -> Parser [Output GetKey])
-> Maybe (Output GetKey)
-> FromJSON (Output GetKey)
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser (Output GetKey)
parseJSON :: Value -> Parser (Output GetKey)
$cparseJSONList :: Value -> Parser [Output GetKey]
parseJSONList :: Value -> Parser [Output GetKey]
$comittedField :: Maybe (Output GetKey)
omittedField :: Maybe (Output GetKey)
A.FromJSON, [Output GetKey] -> Value
[Output GetKey] -> Encoding
Output GetKey -> Bool
Output GetKey -> Value
Output GetKey -> Encoding
(Output GetKey -> Value)
-> (Output GetKey -> Encoding)
-> ([Output GetKey] -> Value)
-> ([Output GetKey] -> Encoding)
-> (Output GetKey -> Bool)
-> ToJSON (Output GetKey)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Output GetKey -> Value
toJSON :: Output GetKey -> Value
$ctoEncoding :: Output GetKey -> Encoding
toEncoding :: Output GetKey -> Encoding
$ctoJSONList :: [Output GetKey] -> Value
toJSONList :: [Output GetKey] -> Value
$ctoEncodingList :: [Output GetKey] -> Encoding
toEncodingList :: [Output GetKey] -> Encoding
$comitField :: Output GetKey -> Bool
omitField :: Output GetKey -> Bool
A.ToJSON)

  toolExec :: forall p (m :: * -> *).
(MonadIO m, MonadFail m, PersistentBackend p) =>
GetKey -> Prompt m (Output GetKey)
toolExec GetKey
args = do
    (forall p. PersistentBackend p => p -> Prompt m (Output GetKey))
-> Prompt m (Output GetKey)
forall a (m :: * -> *).
(MonadIO m, MonadFail m) =>
(forall p. PersistentBackend p => p -> Prompt m a) -> Prompt m a
withBackend ((forall p. PersistentBackend p => p -> Prompt m (Output GetKey))
 -> Prompt m (Output GetKey))
-> (forall p. PersistentBackend p => p -> Prompt m (Output GetKey))
-> Prompt m (Output GetKey)
forall a b. (a -> b) -> a -> b
$ \(p
_ :: p) -> do
      Text
namespace' <- Prompt m Text
forall (m :: * -> *). (MonadIO m, MonadFail m) => Prompt m Text
getSessionName
      Maybe Text
mv <- forall p (m :: * -> *) a.
(MonadIO m, MonadFail m, PersistentBackend p) =>
(Conn p -> m a) -> m a
withDB @p ((Conn p -> StateT PromptEnv m (Maybe Text))
 -> StateT PromptEnv m (Maybe Text))
-> (Conn p -> StateT PromptEnv m (Maybe Text))
-> StateT PromptEnv m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Conn p
conn -> forall p (m :: * -> *).
(PersistentBackend p, MonadIO m, MonadFail m) =>
Conn p -> Unique KeyValue -> m (Maybe Text)
getKey @p Conn p
conn (Text -> Text -> Unique KeyValue
KeyName Text
namespace' GetKey
args.key)
      case Maybe Text
mv of
        Just Text
v -> Output GetKey -> Prompt m (Output GetKey)
forall a. a -> StateT PromptEnv m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Output GetKey -> Prompt m (Output GetKey))
-> Output GetKey -> Prompt m (Output GetKey)
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Text -> Output GetKey
GetKeyOutput Text
v Int
0 Text
""
        Maybe Text
Nothing -> Output GetKey -> Prompt m (Output GetKey)
forall a. a -> StateT PromptEnv m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Output GetKey -> Prompt m (Output GetKey))
-> Output GetKey -> Prompt m (Output GetKey)
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Text -> Output GetKey
GetKeyOutput Text
"" Int
1 Text
"Key not found"

instance Tool SetKey where
  data Output SetKey = SetKeyOutput
    { Output SetKey -> Int
code :: Int,
      Output SetKey -> Text
stderr :: Text
    }
    deriving (Output SetKey -> Output SetKey -> Bool
(Output SetKey -> Output SetKey -> Bool)
-> (Output SetKey -> Output SetKey -> Bool) -> Eq (Output SetKey)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Output SetKey -> Output SetKey -> Bool
== :: Output SetKey -> Output SetKey -> Bool
$c/= :: Output SetKey -> Output SetKey -> Bool
/= :: Output SetKey -> Output SetKey -> Bool
Eq, Int -> Output SetKey -> ShowS
[Output SetKey] -> ShowS
Output SetKey -> String
(Int -> Output SetKey -> ShowS)
-> (Output SetKey -> String)
-> ([Output SetKey] -> ShowS)
-> Show (Output SetKey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Output SetKey -> ShowS
showsPrec :: Int -> Output SetKey -> ShowS
$cshow :: Output SetKey -> String
show :: Output SetKey -> String
$cshowList :: [Output SetKey] -> ShowS
showList :: [Output SetKey] -> ShowS
Show, (forall x. Output SetKey -> Rep (Output SetKey) x)
-> (forall x. Rep (Output SetKey) x -> Output SetKey)
-> Generic (Output SetKey)
forall x. Rep (Output SetKey) x -> Output SetKey
forall x. Output SetKey -> Rep (Output SetKey) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Output SetKey -> Rep (Output SetKey) x
from :: forall x. Output SetKey -> Rep (Output SetKey) x
$cto :: forall x. Rep (Output SetKey) x -> Output SetKey
to :: forall x. Rep (Output SetKey) x -> Output SetKey
Generic, Maybe (Output SetKey)
Value -> Parser [Output SetKey]
Value -> Parser (Output SetKey)
(Value -> Parser (Output SetKey))
-> (Value -> Parser [Output SetKey])
-> Maybe (Output SetKey)
-> FromJSON (Output SetKey)
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser (Output SetKey)
parseJSON :: Value -> Parser (Output SetKey)
$cparseJSONList :: Value -> Parser [Output SetKey]
parseJSONList :: Value -> Parser [Output SetKey]
$comittedField :: Maybe (Output SetKey)
omittedField :: Maybe (Output SetKey)
A.FromJSON, [Output SetKey] -> Value
[Output SetKey] -> Encoding
Output SetKey -> Bool
Output SetKey -> Value
Output SetKey -> Encoding
(Output SetKey -> Value)
-> (Output SetKey -> Encoding)
-> ([Output SetKey] -> Value)
-> ([Output SetKey] -> Encoding)
-> (Output SetKey -> Bool)
-> ToJSON (Output SetKey)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Output SetKey -> Value
toJSON :: Output SetKey -> Value
$ctoEncoding :: Output SetKey -> Encoding
toEncoding :: Output SetKey -> Encoding
$ctoJSONList :: [Output SetKey] -> Value
toJSONList :: [Output SetKey] -> Value
$ctoEncodingList :: [Output SetKey] -> Encoding
toEncodingList :: [Output SetKey] -> Encoding
$comitField :: Output SetKey -> Bool
omitField :: Output SetKey -> Bool
A.ToJSON)

  toolExec :: forall p (m :: * -> *).
(MonadIO m, MonadFail m, PersistentBackend p) =>
SetKey -> Prompt m (Output SetKey)
toolExec SetKey
args = do
    (forall p. PersistentBackend p => p -> Prompt m (Output SetKey))
-> Prompt m (Output SetKey)
forall a (m :: * -> *).
(MonadIO m, MonadFail m) =>
(forall p. PersistentBackend p => p -> Prompt m a) -> Prompt m a
withBackend ((forall p. PersistentBackend p => p -> Prompt m (Output SetKey))
 -> Prompt m (Output SetKey))
-> (forall p. PersistentBackend p => p -> Prompt m (Output SetKey))
-> Prompt m (Output SetKey)
forall a b. (a -> b) -> a -> b
$ \(p
_ :: p) -> do
      Text
namespace' <- Prompt m Text
forall (m :: * -> *). (MonadIO m, MonadFail m) => Prompt m Text
getSessionName
      forall p (m :: * -> *) a.
(MonadIO m, MonadFail m, PersistentBackend p) =>
(Conn p -> m a) -> m a
withDB @p ((Conn p -> StateT PromptEnv m ()) -> StateT PromptEnv m ())
-> (Conn p -> StateT PromptEnv m ()) -> StateT PromptEnv m ()
forall a b. (a -> b) -> a -> b
$ \Conn p
conn -> forall p (m :: * -> *).
(PersistentBackend p, MonadIO m, MonadFail m) =>
Conn p -> Unique KeyValue -> Text -> m ()
setKey @p Conn p
conn (Text -> Text -> Unique KeyValue
KeyName Text
namespace' SetKey
args.key) SetKey
args.value
      Output SetKey -> Prompt m (Output SetKey)
forall a. a -> StateT PromptEnv m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Output SetKey -> Prompt m (Output SetKey))
-> Output SetKey -> Prompt m (Output SetKey)
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Output SetKey
SetKeyOutput Int
0 Text
""

instance Tool DeleteKey where
  data Output DeleteKey = DeleteKeyOutput
    { Output DeleteKey -> Int
code :: Int,
      Output DeleteKey -> Text
stderr :: Text
    }
    deriving (Output DeleteKey -> Output DeleteKey -> Bool
(Output DeleteKey -> Output DeleteKey -> Bool)
-> (Output DeleteKey -> Output DeleteKey -> Bool)
-> Eq (Output DeleteKey)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Output DeleteKey -> Output DeleteKey -> Bool
== :: Output DeleteKey -> Output DeleteKey -> Bool
$c/= :: Output DeleteKey -> Output DeleteKey -> Bool
/= :: Output DeleteKey -> Output DeleteKey -> Bool
Eq, Int -> Output DeleteKey -> ShowS
[Output DeleteKey] -> ShowS
Output DeleteKey -> String
(Int -> Output DeleteKey -> ShowS)
-> (Output DeleteKey -> String)
-> ([Output DeleteKey] -> ShowS)
-> Show (Output DeleteKey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Output DeleteKey -> ShowS
showsPrec :: Int -> Output DeleteKey -> ShowS
$cshow :: Output DeleteKey -> String
show :: Output DeleteKey -> String
$cshowList :: [Output DeleteKey] -> ShowS
showList :: [Output DeleteKey] -> ShowS
Show, (forall x. Output DeleteKey -> Rep (Output DeleteKey) x)
-> (forall x. Rep (Output DeleteKey) x -> Output DeleteKey)
-> Generic (Output DeleteKey)
forall x. Rep (Output DeleteKey) x -> Output DeleteKey
forall x. Output DeleteKey -> Rep (Output DeleteKey) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Output DeleteKey -> Rep (Output DeleteKey) x
from :: forall x. Output DeleteKey -> Rep (Output DeleteKey) x
$cto :: forall x. Rep (Output DeleteKey) x -> Output DeleteKey
to :: forall x. Rep (Output DeleteKey) x -> Output DeleteKey
Generic, Maybe (Output DeleteKey)
Value -> Parser [Output DeleteKey]
Value -> Parser (Output DeleteKey)
(Value -> Parser (Output DeleteKey))
-> (Value -> Parser [Output DeleteKey])
-> Maybe (Output DeleteKey)
-> FromJSON (Output DeleteKey)
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser (Output DeleteKey)
parseJSON :: Value -> Parser (Output DeleteKey)
$cparseJSONList :: Value -> Parser [Output DeleteKey]
parseJSONList :: Value -> Parser [Output DeleteKey]
$comittedField :: Maybe (Output DeleteKey)
omittedField :: Maybe (Output DeleteKey)
A.FromJSON, [Output DeleteKey] -> Value
[Output DeleteKey] -> Encoding
Output DeleteKey -> Bool
Output DeleteKey -> Value
Output DeleteKey -> Encoding
(Output DeleteKey -> Value)
-> (Output DeleteKey -> Encoding)
-> ([Output DeleteKey] -> Value)
-> ([Output DeleteKey] -> Encoding)
-> (Output DeleteKey -> Bool)
-> ToJSON (Output DeleteKey)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Output DeleteKey -> Value
toJSON :: Output DeleteKey -> Value
$ctoEncoding :: Output DeleteKey -> Encoding
toEncoding :: Output DeleteKey -> Encoding
$ctoJSONList :: [Output DeleteKey] -> Value
toJSONList :: [Output DeleteKey] -> Value
$ctoEncodingList :: [Output DeleteKey] -> Encoding
toEncodingList :: [Output DeleteKey] -> Encoding
$comitField :: Output DeleteKey -> Bool
omitField :: Output DeleteKey -> Bool
A.ToJSON)

  toolExec :: forall p (m :: * -> *).
(MonadIO m, MonadFail m, PersistentBackend p) =>
DeleteKey -> Prompt m (Output DeleteKey)
toolExec DeleteKey
args = do
    (forall p. PersistentBackend p => p -> Prompt m (Output DeleteKey))
-> Prompt m (Output DeleteKey)
forall a (m :: * -> *).
(MonadIO m, MonadFail m) =>
(forall p. PersistentBackend p => p -> Prompt m a) -> Prompt m a
withBackend ((forall p.
  PersistentBackend p =>
  p -> Prompt m (Output DeleteKey))
 -> Prompt m (Output DeleteKey))
-> (forall p.
    PersistentBackend p =>
    p -> Prompt m (Output DeleteKey))
-> Prompt m (Output DeleteKey)
forall a b. (a -> b) -> a -> b
$ \(p
_ :: p) -> do
      Text
namespace' <- Prompt m Text
forall (m :: * -> *). (MonadIO m, MonadFail m) => Prompt m Text
getSessionName
      forall p (m :: * -> *) a.
(MonadIO m, MonadFail m, PersistentBackend p) =>
(Conn p -> m a) -> m a
withDB @p ((Conn p -> StateT PromptEnv m ()) -> StateT PromptEnv m ())
-> (Conn p -> StateT PromptEnv m ()) -> StateT PromptEnv m ()
forall a b. (a -> b) -> a -> b
$ \Conn p
conn -> forall p (m :: * -> *).
(PersistentBackend p, MonadIO m, MonadFail m) =>
Conn p -> Unique KeyValue -> m ()
deleteKey @p Conn p
conn (Text -> Text -> Unique KeyValue
KeyName Text
namespace' DeleteKey
args.key)
      Output DeleteKey -> Prompt m (Output DeleteKey)
forall a. a -> StateT PromptEnv m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Output DeleteKey -> Prompt m (Output DeleteKey))
-> Output DeleteKey -> Prompt m (Output DeleteKey)
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Output DeleteKey
DeleteKeyOutput Int
0 Text
""

instance Tool ListKeys where
  data Output ListKeys = ListKeysOutput
    { Output ListKeys -> [Text]
keys :: [Text],
      Output ListKeys -> Int
code :: Int,
      Output ListKeys -> Text
stderr :: Text
    }
    deriving (Output ListKeys -> Output ListKeys -> Bool
(Output ListKeys -> Output ListKeys -> Bool)
-> (Output ListKeys -> Output ListKeys -> Bool)
-> Eq (Output ListKeys)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Output ListKeys -> Output ListKeys -> Bool
== :: Output ListKeys -> Output ListKeys -> Bool
$c/= :: Output ListKeys -> Output ListKeys -> Bool
/= :: Output ListKeys -> Output ListKeys -> Bool
Eq, Int -> Output ListKeys -> ShowS
[Output ListKeys] -> ShowS
Output ListKeys -> String
(Int -> Output ListKeys -> ShowS)
-> (Output ListKeys -> String)
-> ([Output ListKeys] -> ShowS)
-> Show (Output ListKeys)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Output ListKeys -> ShowS
showsPrec :: Int -> Output ListKeys -> ShowS
$cshow :: Output ListKeys -> String
show :: Output ListKeys -> String
$cshowList :: [Output ListKeys] -> ShowS
showList :: [Output ListKeys] -> ShowS
Show, (forall x. Output ListKeys -> Rep (Output ListKeys) x)
-> (forall x. Rep (Output ListKeys) x -> Output ListKeys)
-> Generic (Output ListKeys)
forall x. Rep (Output ListKeys) x -> Output ListKeys
forall x. Output ListKeys -> Rep (Output ListKeys) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Output ListKeys -> Rep (Output ListKeys) x
from :: forall x. Output ListKeys -> Rep (Output ListKeys) x
$cto :: forall x. Rep (Output ListKeys) x -> Output ListKeys
to :: forall x. Rep (Output ListKeys) x -> Output ListKeys
Generic, Maybe (Output ListKeys)
Value -> Parser [Output ListKeys]
Value -> Parser (Output ListKeys)
(Value -> Parser (Output ListKeys))
-> (Value -> Parser [Output ListKeys])
-> Maybe (Output ListKeys)
-> FromJSON (Output ListKeys)
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser (Output ListKeys)
parseJSON :: Value -> Parser (Output ListKeys)
$cparseJSONList :: Value -> Parser [Output ListKeys]
parseJSONList :: Value -> Parser [Output ListKeys]
$comittedField :: Maybe (Output ListKeys)
omittedField :: Maybe (Output ListKeys)
A.FromJSON, [Output ListKeys] -> Value
[Output ListKeys] -> Encoding
Output ListKeys -> Bool
Output ListKeys -> Value
Output ListKeys -> Encoding
(Output ListKeys -> Value)
-> (Output ListKeys -> Encoding)
-> ([Output ListKeys] -> Value)
-> ([Output ListKeys] -> Encoding)
-> (Output ListKeys -> Bool)
-> ToJSON (Output ListKeys)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Output ListKeys -> Value
toJSON :: Output ListKeys -> Value
$ctoEncoding :: Output ListKeys -> Encoding
toEncoding :: Output ListKeys -> Encoding
$ctoJSONList :: [Output ListKeys] -> Value
toJSONList :: [Output ListKeys] -> Value
$ctoEncodingList :: [Output ListKeys] -> Encoding
toEncodingList :: [Output ListKeys] -> Encoding
$comitField :: Output ListKeys -> Bool
omitField :: Output ListKeys -> Bool
A.ToJSON)

  toolExec :: forall p (m :: * -> *).
(MonadIO m, MonadFail m, PersistentBackend p) =>
ListKeys -> Prompt m (Output ListKeys)
toolExec ListKeys
args = do
    (forall p. PersistentBackend p => p -> Prompt m (Output ListKeys))
-> Prompt m (Output ListKeys)
forall a (m :: * -> *).
(MonadIO m, MonadFail m) =>
(forall p. PersistentBackend p => p -> Prompt m a) -> Prompt m a
withBackend ((forall p. PersistentBackend p => p -> Prompt m (Output ListKeys))
 -> Prompt m (Output ListKeys))
-> (forall p.
    PersistentBackend p =>
    p -> Prompt m (Output ListKeys))
-> Prompt m (Output ListKeys)
forall a b. (a -> b) -> a -> b
$ \(p
_ :: p) -> do
      Text
namespace' <- Prompt m Text
forall (m :: * -> *). (MonadIO m, MonadFail m) => Prompt m Text
getSessionName
      [Unique KeyValue]
keys <- forall p (m :: * -> *) a.
(MonadIO m, MonadFail m, PersistentBackend p) =>
(Conn p -> m a) -> m a
withDB @p ((Conn p -> StateT PromptEnv m [Unique KeyValue])
 -> StateT PromptEnv m [Unique KeyValue])
-> (Conn p -> StateT PromptEnv m [Unique KeyValue])
-> StateT PromptEnv m [Unique KeyValue]
forall a b. (a -> b) -> a -> b
$ \Conn p
conn -> forall p (m :: * -> *).
(PersistentBackend p, MonadIO m, MonadFail m) =>
Conn p -> m [Unique KeyValue]
listKeys @p Conn p
conn
      Output ListKeys -> Prompt m (Output ListKeys)
forall a. a -> StateT PromptEnv m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Output ListKeys -> Prompt m (Output ListKeys))
-> Output ListKeys -> Prompt m (Output ListKeys)
forall a b. (a -> b) -> a -> b
$ [Text] -> Int -> Text -> Output ListKeys
ListKeysOutput ((Unique KeyValue -> Text) -> [Unique KeyValue] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\(KeyName Text
_ Text
key) -> Text
key) [Unique KeyValue]
keys) Int
0 Text
""