From b27bbb421aa9806d1f3d6a524968a2f2df092b8e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Mon, 20 Feb 2023 22:28:55 +0100
Subject: Range enumeration syntax for lists

---
 src/Parser.hs | 31 +++++++++++++++++++++++++++----
 src/Test.hs   | 11 +++++++++++
 2 files changed, 38 insertions(+), 4 deletions(-)

(limited to 'src')

diff --git a/src/Parser.hs b/src/Parser.hs
index 9ba702b..0bc5995 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -75,7 +75,7 @@ osymbol str = void $ try $ (string (TL.pack str) <* notFollowedBy operatorChar)
 wsymbol str = void $ try $ (string (TL.pack str) <* notFollowedBy wordChar) <* sc
 
 operatorChar :: (MonadParsec e s m, Token s ~ Char) => m (Token s)
-operatorChar = satisfy $ (`elem` ['+', '-', '*', '/', '='])
+operatorChar = satisfy $ (`elem` ['.', '+', '-', '*', '/', '='])
 {-# INLINE operatorChar #-}
 
 localState :: TestParser a -> TestParser a
@@ -212,13 +212,36 @@ list :: TestParser SomeExpr
 list = label "list" $ do
     symbol "["
     SomeExpr x <- someExpr
+
+    let enumErr off = parseError $ FancyError off $ S.singleton $ ErrorFail $ T.unpack $
+            "list range enumeration not defined for '" <> textExprType x <> "'"
     choice
         [do symbol "]"
             return $ SomeExpr $ UnOp (:[]) x
-        ,do symbol ","
-            xs <- listOf typedExpr
+
+        ,do off <- stateOffset <$> getParserState
+            osymbol ".."
+            ExprEnumerator fromTo _ <- maybe (enumErr off) return $ exprEnumerator x
+            y <- typedExpr
             symbol "]"
-            return $ SomeExpr $ foldr (BinOp (:)) (Literal []) (x:xs)
+            return $ SomeExpr $ UnOp fromTo x `App` y
+
+        ,do symbol ","
+            y <- typedExpr
+
+            choice
+                [do off <- stateOffset <$> getParserState
+                    osymbol ".."
+                    ExprEnumerator _ fromThenTo <- maybe (enumErr off) return $ exprEnumerator x
+                    z <- typedExpr
+                    symbol "]"
+                    return $ SomeExpr $ UnOp fromThenTo x `App` y `App` z
+
+                ,do symbol ","
+                    xs <- listOf typedExpr
+                    symbol "]"
+                    return $ SomeExpr $ foldr (BinOp (:)) (Literal []) (x:y:xs)
+                ]
         ]
 
 data SomeExpr = forall a. ExprType a => SomeExpr (Expr a)
diff --git a/src/Test.hs b/src/Test.hs
index 6460daf..2acd7eb 100644
--- a/src/Test.hs
+++ b/src/Test.hs
@@ -9,6 +9,7 @@ module Test (
     SomeVarValue(..), fromSomeVarValue, textSomeVarValue,
     RecordSelector(..),
     ExprListUnpacker(..),
+    ExprEnumerator(..),
     Expr(..), eval, gatherVars,
 
     Regex(RegexPart, RegexString), regexMatch,
@@ -75,11 +76,16 @@ class Typeable a => ExprType a where
     exprListUnpacker :: proxy a -> Maybe (ExprListUnpacker a)
     exprListUnpacker _ = Nothing
 
+    exprEnumerator :: proxy a -> Maybe (ExprEnumerator a)
+    exprEnumerator _ = Nothing
+
 instance ExprType Integer where
     textExprType _ = T.pack "integer"
     textExprValue x = T.pack (show x)
     emptyVarValue = 0
 
+    exprEnumerator _ = Just $ ExprEnumerator enumFromTo enumFromThenTo
+
 instance ExprType Scientific where
     textExprType _ = T.pack "number"
     textExprValue x = T.pack (show x)
@@ -121,10 +127,13 @@ textSomeVarValue (SomeVarValue value) = textExprValue value
 
 data ExprListUnpacker a = forall e. ExprType e => ExprListUnpacker (a -> [e]) (Proxy a -> Proxy e)
 
+data ExprEnumerator a = ExprEnumerator (a -> a -> [a]) (a -> a -> a -> [a])
+
 
 data Expr a where
     Variable :: ExprType a => VarName -> Expr a
     Literal :: ExprType a => a -> Expr a
+    App :: Expr (a -> b) -> Expr a -> Expr b
     Concat :: [Expr Text] -> Expr Text
     Regex :: [Expr Regex] -> Expr Regex
     UnOp :: (b -> a) -> Expr b -> Expr a
@@ -134,6 +143,7 @@ data Expr a where
 eval :: MonadEval m => Expr a -> m a
 eval (Variable name) = fromSomeVarValue name =<< lookupVar name
 eval (Literal value) = return value
+eval (App f x) = eval f <*> eval x
 eval (Concat xs) = T.concat <$> mapM eval xs
 eval (Regex xs) = mapM eval xs >>= \case
     [re@RegexCompiled {}] -> return re
@@ -150,6 +160,7 @@ gatherVars = fmap (uniqOn fst . sortOn fst) . helper
     helper :: forall b. Expr b -> m [(VarName, SomeVarValue)]
     helper (Variable var) = (:[]) . (var,) <$> lookupVar var
     helper (Literal _) = return []
+    helper (App f x) = (++) <$> helper f <*> helper x
     helper (Concat es) = concat <$> mapM helper es
     helper (Regex es) = concat <$> mapM helper es
     helper (UnOp _ e) = helper e
-- 
cgit v1.2.3