(#801) Simplify the syntax of Custom Command DSL

There are no variable anymore. Only function calls.

Author: rexim

HyperNerd.cabal

@@ -168,6 +168,7 @@ executable Fuzzy
                      , random
                      , aeson
                      , bytestring
+                     , process
 
   hs-source-dirs:      src
 
@@ -243,6 +244,7 @@ test-suite HyperNerdTest
                      , Bot.PollTest
                      , Bot.Friday
                      , Bot.FridayTest
+                     , Bot.ExprTest
                      , Bot.GitHub
                      , Data.Maybe.Extra
                      , Data.Time.Extra

src/Bot/Expr.hs

@@ -13,7 +13,6 @@ data Expr
   = TextExpr T.Text
   | FunCallExpr T.Text
                 [Expr]
-  | VarExpr T.Text
   deriving (Eq, Show)
 
 type NameTable = ()
@@ -28,38 +27,47 @@ stringLiteral = do
   _ <- charP '"'
   return $ TextExpr value
 
-funcallarg :: Parser Expr
-funcallarg = funcall <|> var <|> stringLiteral
+funCallArg :: Parser Expr
+funCallArg = funCall <|> stringLiteral
 
-funcall :: Parser Expr
-funcall = do
-  _ <- charP '%'
-  name <- symbol
-  _ <- whitespaces >> charP '(' >> whitespaces
+funCallArgList :: Parser [Expr]
+funCallArgList = do
+  _ <- charP '(' <* whitespaces
   args <-
-    sepBy funcallarg (whitespaces >> charP ',' >> whitespaces) <|> return []
+    sepBy funCallArg (whitespaces >> charP ',' >> whitespaces) <|> return []
   _ <- whitespaces >> charP ')'
+  return args
+
+funCall :: Parser Expr
+funCall = do
+  name <- charP '%' *> symbol
+  args <- funCallArgList <|> return []
   return $ FunCallExpr name args
 
 whitespaces :: Parser T.Text
 whitespaces = takeWhileP isSpace
 
-var :: Parser Expr
-var = charP '%' *> (VarExpr <$> symbol) <* charP '%'
-
 textBlock :: Parser Expr
 textBlock =
   Parser $ \input ->
     case T.uncons input of
       Nothing -> Left EOF
-      Just ('%', _) -> Left (SyntaxError "Text block does not start with %")
+      Just ('%', input') ->
+        return $ fmap (TextExpr . T.cons '%') $ swap $ T.span (/= '%') input'
       _ -> return $ fmap TextExpr $ swap $ T.span (/= '%') input
 
 expr :: Parser Expr
-expr = funcall <|> var <|> textBlock
+expr = funCall <|> textBlock
 
 exprs :: Parser [Expr]
-exprs = many expr
+exprs = normalizeExprs <$> many expr
+  where
+    normalizeExprs :: [Expr] -> [Expr]
+    normalizeExprs [] = []
+    normalizeExprs (TextExpr t1:TextExpr t2:rest) =
+      normalizeExprs (TextExpr (t1 <> t2) : rest)
+    normalizeExprs (x:rest) = x : normalizeExprs rest
+
 -- TODO(#600): interpretExprs is not implemented
 -- interpretExprs :: NameTable -> [Expr] -> Effect T.Text
 -- interpretExprs = undefined

test/Bot/ExprTest.hs

@@ -0,0 +1,33 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+module Bot.ExprTest where
+
+import Test.HUnit
+import Bot.Expr
+import HyperNerd.Parser
+import qualified Data.Text as T
+
+spec :: Test
+spec =
+  TestLabel "Parsing Custom Command DSL" $
+  TestList $
+  map
+    (\(input, expected) ->
+       TestCase $
+       assertEqual
+         ("Cannot parse `" <> input <> "` as Custom Command DSL")
+         expected
+         (runParser exprs $ T.pack input))
+    [ ("Hello world", Right ("", [TextExpr "Hello world"]))
+    , ("%Hello world", Right ("", [FunCallExpr "Hello" [], TextExpr " world"]))
+    , ("%Helloworld", Right ("", [FunCallExpr "Helloworld" []]))
+    , ("%Hello()world", Right ("", [FunCallExpr "Hello" [], TextExpr "world"]))
+    , ( "%Hello()%world"
+      , Right ("", [FunCallExpr "Hello" [], FunCallExpr "world" []]))
+    , ( "%Hello ()%world"
+      , Right
+          ("", [FunCallExpr "Hello" [], TextExpr " ()", FunCallExpr "world" []]))
+    , ( "% Hello ()%world"
+      , Right ("", [TextExpr "% Hello ()", FunCallExpr "world" []]))
+    , ("%%%%%%", Right ("", [TextExpr "%%%%%%"]))
+    ]

test/Test.hs

@@ -14,6 +14,7 @@ import qualified Bot.LinksTest
 import qualified Bot.LogTest
 import qualified Bot.PollTest
 import qualified Bot.TwitchTest
+import qualified Bot.ExprTest
 import qualified CommandTest
 import qualified Data.Time.ExtraTest
 import qualified Sqlite.EntityPersistenceTest
@@ -30,6 +31,7 @@ main = do
       , Bot.PollTest.spec
       , Bot.TwitchTest.spec
       , Bot.FridayTest.spec
+      , Bot.ExprTest.spec
       , CommandTest.spec
       , Sqlite.EntityPersistenceTest.spec
       , Data.Time.ExtraTest.spec