Adds named lists.

app/Main.hs

@@ -46,7 +46,7 @@ bot process =
         /.\ magic8BallBot'
         /.\ updogMatrixBot
         /.\ liftSimpleBot jitsiBot
-        /.\ liftSimpleBot listBot
+        /.\ liftSimpleBot listsBot
 
 cliMain :: IO ()
 cliMain = withProcessWait_ ghciConfig $ \process -> do

src/CofreeBot/Bot/Behaviors.hs

@@ -16,7 +16,7 @@ import           CofreeBot.Bot.Behaviors.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
-import           CofreeBot.Bot.Behaviors.Lists as Lists

src/CofreeBot/Bot/Behaviors/Lists.hs

@@ -1,45 +1,72 @@
--- | A Bot Behavior for managing todo lists
+-- | A Bot Behavior for managing lists
 module CofreeBot.Bot.Behaviors.Lists
-  ( listBot
-  , TodoAction(..)
+  ( listsBot
   ) where
 
 --------------------------------------------------------------------------------
 
 import           CofreeBot.Bot
 import           CofreeBot.Utils                ( indistinct )
 import           Control.Applicative
+import           Data.Attoparsec.ByteString.Char8
+                                                ( isSpace )
 import           Data.Attoparsec.Text
 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.Profunctor
 import qualified Data.Text                     as T
 
 --------------------------------------------------------------------------------
 
-data TodoAction = Create T.Text | Modify Int T.Text | Remove Int | List
+data ListItemAction = Insert T.Text | Modify Int T.Text | Remove Int
 
-listBot' :: Monad m => Bot m (IntMap T.Text) TodoAction T.Text
-listBot' = Bot $ \s -> \case
-  Create todo ->
+data ListAction = CreateList T.Text | ModifyList T.Text ListItemAction | RemoveList T.Text | List 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)
-  List          -> pure (T.pack $ show s, s)
 
 freshKey :: IntMap a -> Int
 freshKey state = case IntMap.lookupMax state of
   Nothing     -> 0
   Just (k, _) -> k + 1
 
-listBot :: Monad m => Bot m (IntMap T.Text) T.Text T.Text
-listBot = dimap (parseOnly parseAction) indistinct $ emptyBot \/ listBot'
+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
+    case Map.lookup name s of
+      Nothing -> do
+        let t = IntMap.empty
+        (_, t') <- runBot listItemBot t action
+        pure ("List Created", Map.insert name t' s)
+      Just t -> do
+        (_, t') <- runBot listItemBot t action
+        pure ("Entry Modified", Map.insert name t' s)
+  RemoveList 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
+listsBot = dimap (parseOnly parseListAction) indistinct $ emptyBot \/ listsBot'
 
-parseAction :: Parser TodoAction
-parseAction = parseAdd <|> parseRemove <|> parseModify <|> parseList
+parseListAction :: Parser ListAction
+parseListAction =
+  parseCreateList <|> parseModifyList <|> parseRemoveList <|> parseListList
  where
-  parseAdd    = "create-todo:" *> skipSpace *> fmap Create takeText
-  parseRemove = "remove-todo:" *> skipSpace *> fmap Remove decimal
-  parseModify =
-    "modify-todo:" *> skipSpace *> fmap (Modify) decimal <* space <*> takeText
-  parseList = "list-todos" *> pure List
+  parseCreateList = "create" *> skipSpace *> fmap CreateList (takeTill isSpace)
+  parseModifyList =
+    "add"
+      *>  skipSpace
+      *>  fmap ModifyList (takeTill isSpace)
+      <*> fmap Insert     takeText
+  parseRemoveList =
+    "remove"
+      *>  skipSpace
+      *>  fmap ModifyList (takeTill isSpace)
+      <*> fmap Remove     decimal
+  parseListList = "show" *> skipSpace *> fmap List takeText