Attempt at an attoparsec parser, which I gave up on

Turns out error messages are important

nri-redis/nri-redis.cabal

@@ -65,6 +65,7 @@ library
   build-depends:
       aeson >=1.4.6.0 && <2.2
     , async >=2.2.2 && <2.3
+    , attoparsec >=0.13.0.0 && <0.15
     , base >=4.12.0.0 && <4.18
     , bytestring >=0.10.8.2 && <0.12
     , conduit >=1.3.0 && <1.4
@@ -126,6 +127,7 @@ test-suite tests
   build-depends:
       aeson >=1.4.6.0 && <2.2
     , async >=2.2.2 && <2.3
+    , attoparsec >=0.13.0.0 && <0.15
     , base >=4.12.0.0 && <4.18
     , bytestring >=0.10.8.2 && <0.12
     , conduit >=1.3.0 && <1.4

nri-redis/package.yaml

@@ -16,6 +16,7 @@ extra-doc-files:
 dependencies:
   - aeson >= 1.4.6.0 && < 2.2
   - async >=2.2.2 && <2.3
+  - attoparsec >= 0.13.0.0 && < 0.15
   - base >= 4.12.0.0 && < 4.18
   - bytestring >= 0.10.8.2 && < 0.12
   - conduit >= 1.3.0 && < 1.4

nri-redis/src/Redis/Script.hs

@@ -1,14 +1,13 @@
-{-# LANGUAGE TemplateHaskell #-}
-
-module Redis.Script (Script(..), script, evalString, mapKeys, keysTouchedByScript, paramNames, paramValues) where
+module Redis.Script (Script (..), script, evalString, mapKeys, keysTouchedByScript, paramNames, paramValues, parser, ScriptExpression (..)) where
 
+import Data.Attoparsec.Text (Parser, char,choice, inClass, many1', skipSpace, takeWhile1, (<?>), endOfInput)
+import qualified Data.Attoparsec.Text as Attoparsec
 import qualified Language.Haskell.TH as TH
 import qualified Language.Haskell.TH.Quote as QQ
-import Data.ByteString (ByteString)
+-- import Control.Applicative ((<|>))
 import qualified Set
-import Data.Text.Encoding (encodeUtf8)
+import Prelude (pure)
 import qualified Prelude
-import qualified Database.Redis
 
 data Script result = Script
   { -- | The Lua script to be executed
@@ -17,7 +16,8 @@ data Script result = Script
     params :: Log.Secret [Param],
     -- | The script string as extracted from a `script` quasi quote.
     quasiQuotedString :: Text
-  } deriving (Eq, Show)
+  }
+  deriving (Eq, Show)
 
 data Param = Param
   { kind :: ParamKind,
@@ -40,9 +40,39 @@ script =
 
 qqScript :: Prelude.String -> TH.ExpQ
 qqScript scriptWithVars = do
-  -- let bs = encodeUtf8 (Text.fromList scriptWithVars)
   let str = Text.fromList scriptWithVars
-  [|Script str [] str|]
+  let _expr = Attoparsec.parseOnly parser str
+  -- let parsedScript = case expr str of
+  --       Left err -> Prelude.error <| "Failed to parse script: " ++ err
+  --       Right parsed ->
+  -- [|parsedScript|]
+  Debug.todo "qqScript"
+
+data ScriptExpression
+  = ScriptText Text
+  | ScriptVariable Text
+  deriving (Show, Eq)
+
+parser :: Parser (List ScriptExpression)
+parser = do
+  result <- many1' (choice [parseText, parseVariable]) <?> "Expected at least one"
+  endOfInput
+  pure <| result
+
+parseText :: Parser ScriptExpression
+parseText = do
+  text <- takeWhile1 ('$' /=) <?> "Expected text"
+  pure <| ScriptText text
+
+parseVariable :: Parser ScriptExpression
+parseVariable = do
+  _ <- char '$' <?> "Expected '$'"
+  _ <- char '{' <?> "Expected '{'"
+  skipSpace <?> "Expected space after '{'"
+  name <- (takeWhile1 (not << inClass "${}"))
+    <?> "No '$', '{' or '}' allowed in interpolated expression. Note: I'm a simple parser and I don't support records inside ${}."
+  _ <- char '}' <?> "Expected '}' after: ${" ++ Text.toList name
+  pure <| ScriptVariable <| Text.trim name
 
 -- | EVAL script numkeys [key [key ...]] [arg [arg ...]]
 evalString :: Script a -> Text
@@ -62,12 +92,12 @@ paramNames script' =
   script'
     |> params
     |> Log.unSecret
-    |> List.map (\param -> name param)
+    |> List.map name
 
 -- | Get the parameter values in the script
 paramValues :: Script a -> List Text
 paramValues script' =
   script'
     |> params
     |> Log.unSecret
-    |> List.map (\param -> value param)
+    |> List.map value

nri-redis/test/Helpers.hs

@@ -30,11 +30,10 @@ getHandlers = do
 -- > foo
 -- >   bar
 -- >   baz
--- 
+--
 -- In GHC 8.10.x (and possibly GHC 9.0.x?) `srcLocEndLine` and `srcLocEndCol`
 -- would correspond to the `z` at the end of `baz`.  Unfortunately, in GHC 9.2.x
 -- it corresponds to the second `o` at the end of `foo`.
-
 goldenResultsDir :: Text
 #if __GLASGOW_HASKELL__ >= 902
 goldenResultsDir = "test/golden-results-9.2"

nri-redis/test/Spec.hs

@@ -1,6 +1,7 @@
 import qualified Conduit
 import Helpers
 import qualified Spec.Redis
+import qualified Spec.Redis.Script
 import qualified Spec.Settings
 import qualified Test
 import qualified Prelude
@@ -12,5 +13,6 @@ main =
       <| Test.describe
         "nri-redis"
         [ Spec.Redis.tests testHandlers,
-          Spec.Settings.tests
+          Spec.Settings.tests,
+          Spec.Redis.Script.tests
         ]

nri-redis/test/Spec/Redis/Script.hs

@@ -0,0 +1,49 @@
+module Spec.Redis.Script (tests) where
+
+import qualified Data.Attoparsec.Text as Attoparsec
+import Data.Either (Either (..))
+import qualified Expect
+import Redis.Script
+import qualified Test
+
+tests :: Test.Test
+tests =
+  Test.describe
+    "Redis.Script"
+    [ Test.describe "parser" parserTests
+    ]
+
+parserTests :: List Test.Test
+parserTests =
+  [ Test.test "1 word" <| \_ ->
+      (Attoparsec.parseOnly parser "Jabuticaba")
+        |> Expect.equal (Right [ScriptText "Jabuticaba"]),
+    Test.test "3 words" <| \_ ->
+      (Attoparsec.parseOnly parser "Picolé de Jabuticaba")
+        |> Expect.equal (Right [ScriptText "Picolé de Jabuticaba"]),
+    Test.test "1 value" <| \_ ->
+      (Attoparsec.parseOnly parser "${value}")
+        |> Expect.equal (Right [ScriptVariable "value"]),
+    Test.test "function application" <| \_ ->
+      (Attoparsec.parseOnly parser "${func arg1 arg2}")
+        |> Expect.equal (Right [ScriptVariable "func arg1 arg2"]),
+    Test.test "text and variables" <| \_ ->
+      (Attoparsec.parseOnly parser "some text ${value} some more text ${ anotherValue }")
+        |> Expect.equal
+          ( Right
+              [ ScriptText "some text ",
+                ScriptVariable "value",
+                ScriptText " some more text ",
+                ScriptVariable "anotherValue"
+              ]
+          ),
+    Test.only <| Test.test "ERROR: nested ${}" <| \_ -> do
+      (Attoparsec.parseOnly parser "asdasd ${ ${ value } }")
+        |> Expect.equal (Left "Expected at least one > No '$', '{' or '}' allowed in interpolated expression. Note: I'm a simple parser and I don't support records inside ${}.: Failed reading: takeWhile1"),
+    Test.test "ERROR: misplaced ${ inside ${}" <| \_ -> do
+      (Attoparsec.parseOnly parser "${ v$alue }")
+        |> Expect.equal (Left "Expected at least one > Expected '}' after: ${v > '}': Failed reading: satisfy"),
+    Test.test "ERROR: misplaced ${ inside ${}" <| \_ -> do
+      (Attoparsec.parseOnly parser "${ v{alue }")
+        |> Expect.equal (Left "Expected at least one > Expected '}' after: ${v > '}': Failed reading: satisfy")
+  ]