In-Memory Todo List Bot Behavior

app/Main.hs

@@ -39,17 +39,17 @@ bot process =
           simplifySessionBot printCalcOutput statementP $
             sessionize mempty $
               calculatorBot
-      helloBot = helloMatrixBot
       coinFlipBot' = liftSimpleBot $ simplifyCoinFlipBot coinFlipBot
       ghciBot' = liftSimpleBot $ ghciBot process
       magic8BallBot' = liftSimpleBot $ simplifyMagic8BallBot magic8BallBot
    in calcBot
         /.\ coinFlipBot'
-        /.\ helloBot
+        /.\ helloMatrixBot
         /.\ ghciBot'
         /.\ magic8BallBot'
         /.\ updogMatrixBot
         /.\ liftSimpleBot jitsiBot
+        /.\ liftSimpleBot listsBot
 
 cliMain :: FilePath -> IO ()
 cliMain xdgCache = withProcessWait_ ghciConfig $ \process -> do

cofree-bot.cabal

@@ -81,6 +81,7 @@ library
     CofreeBot.Bot.Behaviors.Hello
     CofreeBot.Bot.Behaviors.Jitsi
     CofreeBot.Bot.Behaviors.Jitsi.Dictionary
+    CofreeBot.Bot.Behaviors.Lists
     CofreeBot.Bot.Behaviors.Magic8Ball
     CofreeBot.Bot.Behaviors.Updog
     CofreeBot.Bot.Context

src/CofreeBot/Bot.hs

@@ -55,9 +55,6 @@ import CofreeBot.Utils
 import CofreeBot.Utils.ListT
 import Control.Arrow qualified as Arrow
 import Control.Exception
-  ( catch,
-    throwIO,
-  )
 import Control.Lens
   ( ifolded,
     view,
@@ -82,9 +79,9 @@ import Data.These
 import Network.Matrix.Client
 import Network.Matrix.Client.Lens
 import System.Directory (createDirectoryIfMissing)
+import System.Directory.Internal.Prelude (isDoesNotExistError)
 import System.FilePath
 import System.IO
-import System.IO.Error (isDoesNotExistError)
 import System.Random
 
 --------------------------------------------------------------------------------

src/CofreeBot/Bot/Behaviors.hs

@@ -6,6 +6,7 @@ module CofreeBot.Bot.Behaviors
     module Jitsi,
     module Magic8Ball,
     module Updog,
+    module Lists,
   )
 where
 
@@ -14,5 +15,6 @@ import CofreeBot.Bot.Behaviors.CoinFlip as CoinFlip
 import CofreeBot.Bot.Behaviors.GHCI as GHCI
 import CofreeBot.Bot.Behaviors.Hello as Hello
 import CofreeBot.Bot.Behaviors.Jitsi as Jitsi
+import CofreeBot.Bot.Behaviors.Lists as Lists
 import CofreeBot.Bot.Behaviors.Magic8Ball as Magic8Ball
 import CofreeBot.Bot.Behaviors.Updog as Updog

src/CofreeBot/Bot/Behaviors/Lists.hs

@@ -0,0 +1,114 @@
+-- | A Bot Behavior for managing lists
+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
+import CofreeBot.Utils (indistinct)
+import Control.Applicative
+import Control.Monad (void)
+import Data.Attoparsec.ByteString.Char8
+  ( isSpace,
+  )
+import Data.Attoparsec.Text
+import Data.IntMap.Strict (IntMap)
+import Data.IntMap.Strict qualified as IntMap
+import Data.Map.Strict (Map)
+import Data.Map.Strict qualified as Map
+import Data.Maybe (fromMaybe)
+import Data.Profunctor
+import Data.Text qualified as T
+
+--------------------------------------------------------------------------------
+
+data ListItemAction = Insert T.Text | Modify Int T.Text | Remove Int
+
+data ListAction = CreateList T.Text | ModifyList T.Text ListItemAction | DeleteList T.Text | ShowList T.Text
+
+listItemBot :: Monad m => Bot m (IntMap T.Text) ListItemAction T.Text
+listItemBot = Bot $ \s -> \case
+  Insert todo ->
+    let k = freshKey s in pure ("Entry added", IntMap.insert k todo s)
+  Modify k todo -> pure ("Entry updated", IntMap.insert k todo s)
+  Remove k -> pure ("Entry deleted", IntMap.delete k s)
+
+freshKey :: IntMap a -> Int
+freshKey state = case IntMap.lookupMax state of
+  Nothing -> 0
+  Just (k, _) -> k + 1
+
+listsBot' :: Monad m => Bot m (Map T.Text (IntMap T.Text)) ListAction T.Text
+listsBot' = Bot $ \s -> \case
+  CreateList name -> pure ("List Created", Map.insert name mempty s)
+  ModifyList name action -> do
+    let t = fromMaybe IntMap.empty $ Map.lookup name s
+    t' <- fmap snd $ runBot listItemBot t action
+    pure ("List Updated", Map.insert name t' s)
+  DeleteList name -> pure ("List deleted", Map.delete name s)
+  ShowList name -> pure (prettyListM name $ Map.lookup name s, s)
+
+prettyList :: T.Text -> IntMap T.Text -> T.Text
+prettyList name list = name <> ":\n" <> foldr (\(i, x) acc -> T.pack (show i) <> ". " <> x <> "\n" <> acc) mempty (IntMap.toList list)
+
+prettyListM :: T.Text -> Maybe (IntMap T.Text) -> T.Text
+prettyListM name = \case
+  Nothing -> "List '" <> name <> "' not found."
+  Just l -> prettyList name l
+
+listsBot :: Monad m => Bot m (Map T.Text (IntMap T.Text)) T.Text T.Text
+listsBot = dimap (parseOnly parseListAction) indistinct $ emptyBot \/ listsBot'
+
+parseListAction :: Parser ListAction
+parseListAction =
+  parseCreateList
+    <|> parseDeleteList
+    <|> parseAddListItem
+    <|> parseRemoveListItem
+    <|> parseUpdateListItem
+    <|> parseShowList
+  where
+    parseName = ("📝" <|> "list") *> skipSpace *> takeTill isSpace
+    parseCreateList = do
+      name <- parseName
+      skipSpace
+      void $ "➕" <|> "create"
+      skipSpace
+      pure (CreateList name)
+    parseDeleteList = do
+      name <- parseName
+      skipSpace
+      void $ "➖" <|> "delete"
+      skipSpace
+      pure (DeleteList name)
+    parseShowList = do
+      name <- parseName
+      pure (ShowList name)
+    parseAddListItem = do
+      name <- parseName
+      skipSpace
+      void ("📝" <|> "add")
+      skipSpace
+      item <- takeText
+      pure (ModifyList name (Insert item))
+    parseRemoveListItem = do
+      name <- parseName
+      skipSpace
+      void ("✔️" <|> "remove")
+      skipSpace
+      key <- decimal
+      pure (ModifyList name (Remove key))
+    parseUpdateListItem = do
+      name <- parseName
+      skipSpace
+      void "update"
+      skipSpace
+      key <- decimal
+      skipSpace
+      item <- takeText
+      pure (ModifyList name (Modify key item))