diff options
| -rw-r--r-- | src/Asset.hs | 3 | ||||
| -rw-r--r-- | src/Parser/Expr.hs | 19 | ||||
| -rw-r--r-- | src/Script/Expr.hs | 8 | ||||
| -rw-r--r-- | src/Script/Expr/Class.hs | 15 | ||||
| -rw-r--r-- | test/asset/expansion.et | 18 |
5 files changed, 49 insertions, 14 deletions
diff --git a/src/Asset.hs b/src/Asset.hs index 550438b..72ffd54 100644 --- a/src/Asset.hs +++ b/src/Asset.hs @@ -5,6 +5,7 @@ module Asset ( import Data.Text (Text) import Data.Text qualified as T +import Data.Typeable import Script.Expr.Class @@ -28,3 +29,5 @@ instance ExprType Asset where instance ExprType AssetPath where textExprType _ = "filepath" textExprValue = ("filepath:" <>) . textAssetPath + + exprExpansionConvTo = cast textAssetPath diff --git a/src/Parser/Expr.hs b/src/Parser/Expr.hs index 54f2757..bf94c2d 100644 --- a/src/Parser/Expr.hs +++ b/src/Parser/Expr.hs @@ -96,8 +96,8 @@ someExpansion = do , between (char '{') (char '}') someExpr ] -expressionExpansion :: ExprType a => Text -> (forall b. ExprType b => Expr b -> [ Maybe (Expr a) ]) -> TestParser (Expr a) -expressionExpansion tname conv = do +expressionExpansion :: forall a. ExprType a => Text -> TestParser (Expr a) +expressionExpansion tname = do off <- stateOffset <$> getParserState SomeExpr e <- someExpansion let err = do @@ -105,14 +105,10 @@ expressionExpansion tname conv = do [ tname, T.pack " expansion not defined for '", textExprType e, T.pack "'" ] return $ Undefined "expansion not defined for type" - maybe err return $ listToMaybe $ catMaybes $ conv e + maybe err (return . (<$> e)) $ listToMaybe $ catMaybes [ cast (id :: a -> a), exprExpansionConvTo, exprExpansionConvFrom ] stringExpansion :: TestParser (Expr Text) -stringExpansion = expressionExpansion (T.pack "string") $ \e -> - [ cast e - , fmap (T.pack . show @Integer) <$> cast e - , fmap (T.pack . show @Scientific) <$> cast e - ] +stringExpansion = expressionExpansion "string" numberLiteral :: TestParser SomeExpr numberLiteral = label "number" $ lexeme $ do @@ -158,12 +154,7 @@ regex = label "regular expression" $ lexeme $ do , anySingle >>= \c -> return (Pure $ RegexPart $ T.pack ['\\', c]) ] (s:) <$> inner - ,do e <- expressionExpansion (T.pack "regex") $ \e -> - [ cast e - , fmap RegexString <$> cast e - , fmap (RegexString . T.pack . show @Integer) <$> cast e - , fmap (RegexString . T.pack . show @Scientific) <$> cast e - ] + ,do e <- expressionExpansion (T.pack "regex") (e:) <$> inner ] parts <- inner diff --git a/src/Script/Expr.hs b/src/Script/Expr.hs index e8f6993..0c401e2 100644 --- a/src/Script/Expr.hs +++ b/src/Script/Expr.hs @@ -34,6 +34,8 @@ import Data.Foldable import Data.List import Data.Map (Map) import Data.Map qualified as M +import Data.Maybe +import Data.Scientific import Data.String import Data.Text (Text) import Data.Text qualified as T @@ -425,6 +427,12 @@ instance ExprType Regex where textExprType _ = T.pack "regex" textExprValue _ = T.pack "<regex>" + exprExpansionConvFrom = listToMaybe $ catMaybes + [ cast (RegexString) + , cast (RegexString . T.pack . show @Integer) + , cast (RegexString . T.pack . show @Scientific) + ] + regexCompile :: Text -> Either String Regex regexCompile src = either Left (Right . RegexCompiled src) $ RE.compile RE.defaultCompOpt RE.defaultExecOpt $ T.singleton '^' <> src <> T.singleton '$' diff --git a/src/Script/Expr/Class.hs b/src/Script/Expr/Class.hs index 64b4241..20a92b4 100644 --- a/src/Script/Expr/Class.hs +++ b/src/Script/Expr/Class.hs @@ -5,6 +5,7 @@ module Script.Expr.Class ( ExprEnumerator(..), ) where +import Data.Maybe import Data.Scientific import Data.Text (Text) import Data.Text qualified as T @@ -18,6 +19,12 @@ class Typeable a => ExprType a where recordMembers :: [(Text, RecordSelector a)] recordMembers = [] + exprExpansionConvTo :: ExprType b => Maybe (a -> b) + exprExpansionConvTo = Nothing + + exprExpansionConvFrom :: ExprType b => Maybe (b -> a) + exprExpansionConvFrom = Nothing + exprListUnpacker :: proxy a -> Maybe (ExprListUnpacker a) exprListUnpacker _ = Nothing @@ -36,12 +43,20 @@ instance ExprType Integer where textExprType _ = T.pack "integer" textExprValue x = T.pack (show x) + exprExpansionConvTo = listToMaybe $ catMaybes + [ cast (T.pack . show :: Integer -> Text) + ] + exprEnumerator _ = Just $ ExprEnumerator enumFromTo enumFromThenTo instance ExprType Scientific where textExprType _ = T.pack "number" textExprValue x = T.pack (show x) + exprExpansionConvTo = listToMaybe $ catMaybes + [ cast (T.pack . show :: Scientific -> Text) + ] + instance ExprType Bool where textExprType _ = T.pack "bool" textExprValue True = T.pack "true" diff --git a/test/asset/expansion.et b/test/asset/expansion.et new file mode 100644 index 0000000..d14f9a1 --- /dev/null +++ b/test/asset/expansion.et @@ -0,0 +1,18 @@ +def integer_var = 1 +def number_var = 1.3 +def string_var = "abc" +def regex_var = /a.c/ + +test VariableExpansion: + node n + shell as p on n: + echo "$integer_var" + echo "$number_var" + echo "$string_var" + echo "$string_var" + + expect from p: + /$integer_var/ + /$number_var/ + /$string_var/ + /$regex_var/ |