phino 0.0.0.21 → 0.0.0.22

raw patch · 6 files changed

+75/−40 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• phino.cabal +2/−1
• src/Condition.hs +11/−1
• src/Functions.hs +8/−35
• src/Random.hs +45/−0
• src/Rewriter.hs +2/−2
• src/Yaml.hs +7/−1

@@ -1,7 +1,7 @@ cabal-version:      3.0  name:               phino-version:            0.0.0.21+version:            0.0.0.22 license:            MIT synopsis:           Command-Line Manipulator of 𝜑-Calculus Expressions description:        Please see the README on GitHub at <https://github.com/objectionary/phino#readme>@@ -40,6 +40,7 @@     Logger,     Regexp,     Pretty,+    Random,     XMIR   hs-source-dirs: src   other-modules:

@@ -6,7 +6,7 @@ module Condition where  import Ast-import Builder (buildAttribute, buildBinding)+import Builder (buildAttribute, buildBinding, buildExpression, buildExpressionThrows, buildBindingThrows) import Control.Exception (SomeException (SomeException), evaluate) import Control.Exception.Base (try) import Data.Aeson (FromJSON)@@ -147,6 +147,16 @@   (TeBytes tgt) <- buildTermFromFunction "dataize" [Y.ArgExpression expr] subst (Program expr)   matched <- match (B.pack pat) (B.pack (btsToUnescapedStr tgt))   pure [subst | matched]+meetCondition' (Y.PartOf exp bd) subst = do+  (exp', _) <- buildExpressionThrows exp subst+  bds <- buildBindingThrows bd subst+  pure [subst | partOf exp' bds]+  where+    partOf :: Expression -> [Binding] -> Bool+    partOf expr [] = False+    partOf expr (BiTau _ (ExFormation bds) : rest) = partOf expr rest || partOf expr bds+    partOf expr (BiTau _ expr' : rest) = expr == expr' || partOf expr rest+    partOf expr (bd : rest) = partOf expr rest  -- For each substitution check if it meetCondition to given condition -- If substitution does not meet the condition - it's thrown out

@@ -19,16 +19,13 @@ import Misc import Numeric (showHex) import Pretty+import Random (randomString) import Regexp import System.Random (randomRIO) import Term import Text.Printf (printf) import Yaml -randomStrings :: IORef (Set String)-{-# NOINLINE randomStrings #-}-randomStrings = unsafePerformIO (newIORef Data.Set.empty)- argToStrBytes :: ExtraArgument -> Subst -> Program -> IO String argToStrBytes (ArgBytes bytes) subst _ = do   bts <- buildBytesThrows bytes subst@@ -50,7 +47,8 @@ buildTermFromFunction "scope" _ _ _ = throwIO (userError "Function scope() requires exactly 1 argument as expression") buildTermFromFunction "random-tau" args subst _ = do   attrs <- argsToAttrs args-  pure (TeAttribute (AtLabel (randomTau 0 attrs)))+  tau <- randomTau attrs+  pure (TeAttribute (AtLabel tau))   where     argsToAttrs :: [ExtraArgument] -> IO [String]     argsToAttrs [] = pure []@@ -74,11 +72,10 @@             BiLambda _ -> AtLambda             BiVoid attr -> attr        in prettyAttribute attr : attrsFromBindings bds-    randomTau :: Integer -> [String] -> String-    randomTau idx attrs =-      let cactoos = "a🌵"-          tau = if idx == 0 then cactoos else cactoos ++ show idx-       in if tau `elem` attrs then randomTau (idx + 1) attrs else tau+    randomTau :: [String] -> IO String+    randomTau attrs = do+      tau <- randomString "a🌵%d"+      if tau `elem` attrs then randomTau attrs else pure tau buildTermFromFunction "dataize" [ArgBytes bytes] subst _ = do   bts <- buildBytesThrows bytes subst   pure (TeBytes bts)@@ -115,31 +112,7 @@ buildTermFromFunction "sed" _ _ _ = throwIO (userError "Function sed() requires exactly 2 dataizable arguments") buildTermFromFunction "random-string" [arg] subst prog = do   pat <- argToStrBytes arg subst prog-  set <- readIORef randomStrings-  str <- regenerate pat set+  str <- randomString pat   pure (TeExpression (DataString (strToBts str)))-  where-    regenerate :: String -> Set String -> IO String-    regenerate pat set = do-      next <- randomString pat-      if next `Data.Set.member` set-        then regenerate pat set-        else do-          modifyIORef' randomStrings (Data.Set.insert next)-          pure next-    randomString :: String -> IO String-    randomString [] = pure []-    randomString ('%' : ch : rest) = do-      rep <- case ch of-        'x' -> replicateM 8 $ do-          v <- randomRIO (0, 15)-          pure (intToDigit v)-        'd' -> show <$> randomRIO (0 :: Int, 9999)-        _ -> pure ['%', ch]-      next <- randomString rest-      pure (rep ++ next)-    randomString (ch : rest) = do-      rest' <- randomString rest-      pure (ch : rest') buildTermFromFunction "random-string" _ _ _ = throwIO (userError "Function random-string() requires exactly 1 dataizable argument") buildTermFromFunction func _ _ _ = throwIO (userError (printf "Function %s() is not supported or does not exist" func))

@@ -0,0 +1,45 @@+-- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com+-- SPDX-License-Identifier: MIT++module Random (randomString) where++import Control.Monad (replicateM)+import Data.Char (intToDigit)+import Data.IORef (IORef, modifyIORef', newIORef, readIORef)+import Data.Set (Set)+import qualified Data.Set as Set+import GHC.IO (unsafePerformIO)+import System.Random (randomRIO)++strings :: IORef (Set String)+{-# NOINLINE strings #-}+strings = unsafePerformIO (newIORef Set.empty)++generate :: String -> IO String+generate [] = pure []+generate ('%' : ch : rest) = do+  rep <- case ch of+    'x' -> replicateM 8 $ do+      v <- randomRIO (0, 15)+      pure (intToDigit v)+    'd' -> show <$> randomRIO (0 :: Int, 9999)+    _ -> pure ['%', ch]+  next <- generate rest+  pure (rep ++ next)+generate (ch : rest) = do+  rest' <- generate rest+  pure (ch : rest')++regenerate :: String -> Set String -> IO String+regenerate pat set = do+  next <- generate pat+  if next `Set.member` set+    then regenerate pat set+    else do+      modifyIORef' strings (Set.insert next)+      pure next++randomString :: String -> IO String+randomString pat = do+  set <- readIORef strings+  regenerate pat set

@@ -14,10 +14,10 @@ import Data.Maybe (catMaybes, fromMaybe, isJust) import Debug.Trace (trace) import Logger (logDebug)-import Matcher (MetaValue (MvAttribute, MvBindings, MvExpression, MvBytes), Subst (Subst), combine, combineMany, defaultScope, matchProgram, substEmpty, substSingle)+import Matcher (MetaValue (MvAttribute, MvBindings, MvBytes, MvExpression), Subst (Subst), combine, combineMany, defaultScope, matchProgram, substEmpty, substSingle) import Misc (ensuredFile) import Parser (parseProgram, parseProgramThrows)-import Pretty (PrintMode (SWEET), prettyAttribute, prettyExpression, prettyExpression', prettyProgram, prettyProgram', prettySubsts, prettyBytes)+import Pretty import Replacer (replaceProgram, replaceProgramThrows) import Term import Text.Printf

@@ -97,7 +97,12 @@                 vals <- v .: "matches"                 case vals of                   [pat, exp] -> Matches <$> parseJSON pat <*> parseJSON exp-                  _ -> fail "'matches' expects exactly two arguments"+                  _ -> fail "'matches' expects exactly two arguments",+              do+                vals <- v .: "part-of"+                case vals of+                  [exp, bd] -> PartOf <$> parseJSON exp <*> parseJSON bd+                  _ -> fail "'part-of' expects exactly two arguments"             ]       ) @@ -143,6 +148,7 @@   | NF Expression   | XI Expression   | Matches String Expression+  | PartOf Expression Binding   deriving (Generic, Show)  data ExtraArgument