From 68a21dbfd71a2d280ee3201e87d36c2fed231c50 Mon Sep 17 00:00:00 2001 From: solomon Date: Sun, 20 Nov 2022 12:21:39 -0800 Subject: [PATCH] Updates Lists API --- cofree-bot.cabal | 1 + src/CofreeBot/Bot.hs | 9 ------- src/CofreeBot/Bot/Behaviors/Lists.hs | 28 +++++++++++++++------ src/CofreeBot/Bot/Context.hs | 37 ++++++++++++++++++++++++++++ src/CofreeBot/Utils.hs | 12 +++++++++ 5 files changed, 71 insertions(+), 16 deletions(-) diff --git a/cofree-bot.cabal b/cofree-bot.cabal index 664405e..9afd435 100644 --- a/cofree-bot.cabal +++ b/cofree-bot.cabal @@ -102,3 +102,4 @@ library , process , random , vector + , xdg-basedir diff --git a/src/CofreeBot/Bot.hs b/src/CofreeBot/Bot.hs index 9554c7f..e7c9349 100644 --- a/src/CofreeBot/Bot.hs +++ b/src/CofreeBot/Bot.hs @@ -43,9 +43,6 @@ module CofreeBot.Bot import CofreeBot.Utils import CofreeBot.Utils.ListT import qualified Control.Arrow as Arrow -import Control.Exception ( catch - , throwIO - ) import Control.Lens ( (^.) , _Just , ifolded @@ -64,13 +61,11 @@ import qualified Data.Map.Strict as Map import Data.Profunctor import Data.Profunctor.Traversing import qualified Data.Text as T -import qualified Data.Text.IO as T import Data.These import Network.Matrix.Client import Network.Matrix.Client.Lens import System.Directory ( createDirectoryIfMissing ) import System.IO -import System.IO.Error ( isDoesNotExistError ) import System.Random -------------------------------------------------------------------------------- @@ -293,10 +288,6 @@ type MatrixBot m s = Bot m s (RoomID, Event) (RoomID, Event) liftMatrixIO :: (MonadIO m, MonadError MatrixError m) => MatrixIO x -> m x liftMatrixIO m = liftEither =<< liftIO m -readFileMaybe :: String -> IO (Maybe T.Text) -readFileMaybe path = fmap Just (T.readFile path) - `catch` \e -> if isDoesNotExistError e then pure Nothing else throwIO e - -- | A Matrix 'Server' for connecting a 'Bot' to the Matrix protocol. matrix :: forall m diff --git a/src/CofreeBot/Bot/Behaviors/Lists.hs b/src/CofreeBot/Bot/Behaviors/Lists.hs index dd8d4ba..8c99333 100644 --- a/src/CofreeBot/Bot/Behaviors/Lists.hs +++ b/src/CofreeBot/Bot/Behaviors/Lists.hs @@ -3,6 +3,9 @@ module CofreeBot.Bot.Behaviors.Lists ( listsBot ) where +-- TODO: I want a bot combinator ala Sessionize that allows you take +-- any bot and save its state to disk on updates. + -------------------------------------------------------------------------------- import CofreeBot.Bot @@ -15,15 +18,15 @@ import qualified Data.IntMap.Strict as IntMap import Data.IntMap.Strict ( IntMap ) import qualified Data.Map.Strict as Map import Data.Map.Strict ( Map ) +import Data.Maybe ( fromMaybe ) import Data.Profunctor import qualified Data.Text as T -import Data.Maybe (fromMaybe) -------------------------------------------------------------------------------- data ListItemAction = Insert T.Text | Modify Int T.Text | Remove Int -data ListAction = CreateList T.Text | ModifyList T.Text ListItemAction | RemoveList T.Text | List T.Text +data ListAction = CreateList T.Text | ModifyList T.Text ListItemAction | DeleteList T.Text | List T.Text listItemBot :: Monad m => Bot m (IntMap T.Text) ListItemAction T.Text listItemBot = Bot $ \s -> \case @@ -44,7 +47,7 @@ listsBot' = Bot $ \s -> \case let t = fromMaybe IntMap.empty $ Map.lookup name s t' <- fmap snd $ runBot listItemBot t action pure ("List Updated", Map.insert name t' s) - RemoveList name -> pure ("List deleted", Map.delete name s) + DeleteList name -> pure ("List deleted", Map.delete name s) List name -> pure (T.pack $ show $ Map.lookup name s, s) listsBot :: Monad m => Bot m (Map T.Text (IntMap T.Text)) T.Text T.Text @@ -52,17 +55,28 @@ listsBot = dimap (parseOnly parseListAction) indistinct $ emptyBot \/ listsBot' parseListAction :: Parser ListAction parseListAction = - parseCreateList <|> parseModifyList <|> parseRemoveList <|> parseListList + parseCreateList + <|> parseDeleteList + <|> parseShowList + <|> parseAddListItem + <|> parseRemoveListItem + <|> parseUpdateListItem where parseCreateList = "create" *> skipSpace *> fmap CreateList (takeTill isSpace) - parseModifyList = + parseDeleteList = "delete" *> skipSpace *> fmap DeleteList (takeTill isSpace) + parseShowList = "show" *> skipSpace *> fmap List (takeTill isSpace) + parseAddListItem = "add" *> skipSpace *> fmap ModifyList (takeTill isSpace) <*> fmap Insert takeText - parseRemoveList = + parseRemoveListItem = "remove" *> skipSpace *> fmap ModifyList (takeTill isSpace) <*> fmap Remove decimal - parseListList = "show" *> skipSpace *> fmap List takeText + parseUpdateListItem = + "update" + *> skipSpace + *> fmap ModifyList (takeTill isSpace) + <*> (fmap Modify decimal <* skipSpace <*> takeText) diff --git a/src/CofreeBot/Bot/Context.hs b/src/CofreeBot/Bot/Context.hs index 42cb829..156d39d 100644 --- a/src/CofreeBot/Bot/Context.hs +++ b/src/CofreeBot/Bot/Context.hs @@ -17,21 +17,30 @@ module CofreeBot.Bot.Context , SessionOutput(..) , sessionize , simplifySessionBot + + -- * Persistence + , persistentBot ) where -------------------------------------------------------------------------------- import CofreeBot.Bot +import CofreeBot.Utils ( readFileMaybe ) import CofreeBot.Utils.ListT ( emptyListT ) import Control.Applicative import qualified Control.Arrow as Arrow +import Control.Monad.IO.Class import Data.Attoparsec.Text import Data.Bifunctor ( Bifunctor(first) ) +import Data.Foldable import qualified Data.IntMap.Strict as IntMap import Data.IntMap.Strict ( IntMap ) +import Data.Map ( Map ) import Data.Profunctor ( second' ) import qualified Data.Text as T import Network.Matrix.Client +import System.Directory ( createDirectoryIfMissing ) +import System.Environment.XDG.BaseDir ( getUserCacheDir ) -------------------------------------------------------------------------------- @@ -149,3 +158,31 @@ simplifySessionBot tshow p (Bot bot) = Bot $ \s i -> do SessionStarted n -> "Session Started: '" <> T.pack (show n) <> "'." SessionEnded n -> "Session Ended: '" <> T.pack (show n) <> "'." InvalidSession n -> "Invalid Session: '" <> T.pack (show n) <> "'." + +-------------------------------------------------------------------------------- + +-- | Transform a standard 'Bot' with in-memory state to one which +-- persists its state to disk. +persistentBot + :: (MonadIO m, Show s, Read s, Monoid s) + => (i -> T.Text) + -> Bot m (Map T.Text s) i o + -> Bot m () i o +persistentBot parseKey (Bot bot) = Bot $ \() i -> do + let key = parseKey i + s <- liftIO $ readState key + (o, s') <- bot (fold s) i + liftIO $ saveState key s' + pure $ (o, ()) + +readState :: Read s => T.Text -> IO (Maybe s) +readState key = do + cache <- getUserCacheDir "cofree-bot" + s <- readFileMaybe $ cache <> "/" <> T.unpack key + pure $ fmap (read . T.unpack) s + +saveState :: Show s => T.Text -> s -> IO () +saveState key state = do + cache <- getUserCacheDir "cofree-bot" + createDirectoryIfMissing True cache + writeFile (cache <> "/" <> T.unpack key) (show state) diff --git a/src/CofreeBot/Utils.hs b/src/CofreeBot/Utils.hs index 7544d51..e7bea14 100644 --- a/src/CofreeBot/Utils.hs +++ b/src/CofreeBot/Utils.hs @@ -20,14 +20,19 @@ module CofreeBot.Utils -- * Misc distinguish , PointedChoice(..) + , readFileMaybe ) where ------------------------------------------------------------------------------- import Control.Applicative import Control.Arrow ( (&&&) ) +import Control.Exception import Data.Kind +import qualified Data.Text as T +import qualified Data.Text.IO as T import Data.These ( These ) +import System.IO.Error ( isDoesNotExistError ) ------------------------------------------------------------------------------- @@ -93,3 +98,10 @@ distinguish f x | f x = Right x class PointedChoice p where pleft :: p a b -> p (x \*/ a) (x \*/ b) pright :: p a b -> p (a \*/ x) (b \*/ x) + + +-------------------------------------------------------------------------------- + +readFileMaybe :: String -> IO (Maybe T.Text) +readFileMaybe path = fmap Just (T.readFile path) + `catch` \e -> if isDoesNotExistError e then pure Nothing else throwIO e