phino 0.0.0.43 → 0.0.0.44

raw patch · 13 files changed

+168/−78 lines, 13 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• phino.cabal +2/−2
• src/CLI.hs +43/−11
• src/Dataize.hs +12/−3
• src/Deps.hs +42/−0
• src/Functions.hs +1/−1
• src/Misc.hs +4/−4
• src/Rewriter.hs +16/−15
• src/Rule.hs +1/−1
• src/Term.hs +0/−24
• test/CLISpec.hs +26/−10
• test/DataizeSpec.hs +4/−3
• test/FunctionsSpec.hs +1/−1
• test/RewriterSpec.hs +16/−3

@@ -1,7 +1,7 @@ cabal-version:      3.0  name:               phino-version:            0.0.0.43+version:            0.0.0.44 license:            MIT synopsis:           Command-Line Manipulator of 𝜑-Calculus Expressions description:        Please see the README on GitHub at <https://github.com/objectionary/phino#readme>@@ -35,7 +35,7 @@     Rule,     Dataize,     Functions,-    Term,+    Deps,     Misc,     Must,     Logger,

@@ -18,6 +18,7 @@ import Data.Maybe (isJust, isNothing) import Data.Version (showVersion) import Dataize (DataizeContext (DataizeContext), dataize)+import Deps (saveStep) import Functions (buildTerm) import qualified Functions import LaTeX (explainRules, programToLaTeX)@@ -28,12 +29,12 @@ import Options.Applicative import Parser (parseProgramThrows) import Paths_phino (version)-import Pretty (PrintMode (SALTY, SWEET), prettyBytes, prettyProgram', Encoding (UNICODE))+import Pretty (Encoding (UNICODE), PrintMode (SALTY, SWEET), prettyBytes, prettyProgram') import Rewriter (RewriteContext (RewriteContext), rewrite') import System.Exit (ExitCode (..), exitFailure) import System.IO (getContents') import Text.Printf (printf)-import XMIR (XmirContext (XmirContext), parseXMIRThrows, printXMIR, programToXMIR, xmirToPhi)+import XMIR (XmirContext (XmirContext), defaultXmirContext, parseXMIRThrows, printXMIR, programToXMIR, xmirToPhi) import Yaml (normalizationRules) import qualified Yaml as Y @@ -67,6 +68,7 @@     maxDepth :: Integer,     maxCycles :: Integer,     depthSensitive :: Bool,+    stepsDir :: Maybe FilePath,     inputFile :: Maybe FilePath   } @@ -94,6 +96,7 @@     maxCycles :: Integer,     inPlace :: Bool,     targetFile :: Maybe FilePath,+    stepsDir :: Maybe FilePath,     inputFile :: Maybe FilePath   } @@ -150,6 +153,9 @@ optTarget :: Parser (Maybe FilePath) optTarget = optional (strOption (long "target" <> short 't' <> metavar "FILE" <> help "File to save output to")) +optStepsDir :: Parser (Maybe FilePath)+optStepsDir = optional (strOption (long "steps-dir" <> metavar "FILE" <> help "Directory to save intermediate steps during rewriting/dataizing"))+ optShuffle :: Parser Bool optShuffle = switch (long "shuffle" <> help "Shuffle rules before applying") @@ -173,6 +179,7 @@             <*> optMaxDepth             <*> optMaxCycles             <*> optDepthSensitive+            <*> optStepsDir             <*> argInputFile         ) @@ -202,6 +209,7 @@             <*> optMaxCycles             <*> switch (long "in-place" <> help "Edit file in-place instead of printing to output")             <*> optTarget+            <*> optStepsDir             <*> argInputFile         ) @@ -243,11 +251,12 @@       validateOpts       logDebug (printf "Amount of rewriting cycles across all the rules: %d, per rule: %d" maxCycles maxDepth)       input <- readInput inputFile+      let xmirCtx = Just (XmirContext omitListing omitComments input)       rules' <- getRules normalize shuffle rules       program <- parseProgram input inputFormat-      rewritten <- rewrite' program rules' (RewriteContext program maxDepth maxCycles depthSensitive buildTerm must)+      rewritten <- rewrite' program rules' (context program xmirCtx)       logDebug (printf "Printing rewritten 𝜑-program as %s" (show outputFormat))-      prog <- printProgram rewritten outputFormat printMode input+      prog <- printProgram outputFormat printMode xmirCtx rewritten       output targetFile prog       where         validateOpts :: IO ()@@ -264,12 +273,6 @@           validateMaxDepth maxDepth           validateMaxCycles maxCycles           validateMust must-        printProgram :: Program -> IOFormat -> PrintMode -> String -> IO String-        printProgram prog PHI mode _ = pure (prettyProgram' prog mode UNICODE)-        printProgram prog XMIR _ listing = do-          xmir <- programToXMIR prog (XmirContext omitListing omitComments listing)-          pure (printXMIR xmir)-        printProgram prog LATEX mode _ = pure (programToLaTeX prog mode)         output :: Maybe FilePath -> String -> IO ()         output target prog = case (inPlace, target, inputFile) of           (True, _, Just file) -> do@@ -283,17 +286,36 @@           (False, Nothing, _) -> do             logDebug "The option '--target' is not specified, printing to console..."             putStrLn prog+        context :: Program -> Maybe XmirContext -> RewriteContext+        context program ctx =+          RewriteContext+            program+            maxDepth+            maxCycles+            depthSensitive+            buildTerm+            must+            (saveStep stepsDir (ioToExtension outputFormat) (printProgram outputFormat printMode ctx))     CmdDataize opts@OptsDataize {..} -> do       validateOpts       input <- readInput inputFile       prog <- parseProgram input inputFormat-      dataized <- dataize prog (DataizeContext prog maxDepth maxCycles depthSensitive buildTerm)+      dataized <- dataize prog (context prog)       maybe (throwIO CouldNotDataize) (putStrLn . prettyBytes) dataized       where         validateOpts :: IO ()         validateOpts = do           validateMaxDepth maxDepth           validateMaxCycles maxCycles+        context :: Program -> DataizeContext+        context program =+          DataizeContext+            program+            maxDepth+            maxCycles+            depthSensitive+            buildTerm+            (saveStep stepsDir (ioToExtension PHI) (printProgram PHI SWEET Nothing))     CmdExplain opts@OptsExplain {..} -> do       validateOpts       rules' <- getRules normalize shuffle rules@@ -342,6 +364,13 @@     parseProgram xmir XMIR = do       doc <- parseXMIRThrows xmir       xmirToPhi doc+    printProgram :: IOFormat -> PrintMode -> Maybe XmirContext -> Program -> IO String+    printProgram PHI mode _ prog = pure (prettyProgram' prog mode UNICODE)+    printProgram XMIR mode Nothing prog = printProgram XMIR mode (Just defaultXmirContext) prog+    printProgram XMIR _ (Just ctx) prog = do+      xmir <- programToXMIR prog ctx+      pure (printXMIR xmir)+    printProgram LATEX mode _ prog = pure (programToLaTeX prog mode)     getRules :: Bool -> Bool -> [FilePath] -> IO [Y.Rule]     getRules normalize shuffle rules = do       ordered <-@@ -373,3 +402,6 @@         logDebug (printf "The option '--target' is specified, printing to '%s'..." file)         writeFile file content         logInfo (printf "The command result was saved in '%s'" file)+    ioToExtension :: IOFormat -> String+    ioToExtension LATEX = "tex"+    ioToExtension format = show format

@@ -10,11 +10,11 @@ import Builder (contextualize) import Control.Exception (throwIO) import Data.List (partition)+import Deps (BuildTermFunc, SaveStepFunc) import Misc import Must (Must (..)) import Rewriter (RewriteContext (RewriteContext), rewrite') import Rule (RuleContext (RuleContext), isNF)-import Term (BuildTermFunc) import Text.Printf (printf) import XMIR (XmirContext (XmirContext)) import Yaml (normalizationRules)@@ -24,11 +24,20 @@     _maxDepth :: Integer,     _maxCycles :: Integer,     _depthSensitive :: Bool,-    _buildTerm :: BuildTermFunc+    _buildTerm :: BuildTermFunc,+    _saveStep :: SaveStepFunc   }  switchContext :: DataizeContext -> RewriteContext-switchContext DataizeContext {..} = RewriteContext _program _maxDepth _maxCycles _depthSensitive _buildTerm MtDisabled+switchContext DataizeContext {..} =+  RewriteContext+    _program+    _maxDepth+    _maxCycles+    _depthSensitive+    _buildTerm+    MtDisabled+    _saveStep  maybeBinding :: (Binding -> Bool) -> [Binding] -> (Maybe Binding, [Binding]) maybeBinding _ [] = (Nothing, [])

@@ -0,0 +1,42 @@+-- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com+-- SPDX-License-Identifier: MIT++-- The main goal of this module is breaking cyclic dependency:+-- Dataize -> Functions -> Rewriter -> Dataize+-- Here we provide custom type BuildTermFunc and add it to+-- RewriteContext and DataizeContext. Now Dataize and Rewrite depends+-- only on Term module. This allows us to use Rewriter and Dataize in+-- Functions module because Rewriter does not depend on Functions anymore.+module Deps where++import Ast+import Logger (logDebug)+import Matcher+import System.Directory (createDirectoryIfMissing)+import System.FilePath+import Text.Printf (printf)+import Yaml++data Term+  = TeExpression Expression+  | TeAttribute Attribute+  | TeBytes Bytes+  | TeBindings [Binding]++type BuildTermMethod = [ExtraArgument] -> Subst -> Program -> IO Term++type BuildTermFunc = String -> BuildTermMethod++type SaveStepFunc = Program -> Integer -> IO ()++saveStep :: Maybe FilePath -> String -> (Program -> IO String) -> SaveStepFunc+saveStep Nothing _ _ _ _ = pure ()+saveStep (Just dir) ext print' prog step = do+  createDirectoryIfMissing True dir+  let path = dir </> printf "%05d.%s" step ext+  content <- print' prog+  writeFile path content+  logDebug (printf "Saved step '%d' to '%s'" step path)++dontSaveStep :: SaveStepFunc+dontSaveStep = saveStep Nothing "" (\_ -> pure "")

@@ -24,7 +24,7 @@ import Random (randomString) import Regexp import System.Random (randomRIO)-import Term+import Deps import Text.Printf (printf) import qualified Yaml as Y 

@@ -67,8 +67,8 @@   show DirectoryDoesNotExist {..} = printf "Directory '%s' does not exist" dir  -- Minimal matcher function (required for view pattern)-matchDataoObject :: Expression -> Maybe (String, Bytes)-matchDataoObject+matchDataObject :: Expression -> Maybe (String, Bytes)+matchDataObject   ( ExApplication       (ExDispatch (ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang")) (AtLabel label))       ( BiTau@@ -82,7 +82,7 @@             )         )     ) = Just (label, bts)-matchDataoObject _ = Nothing+matchDataObject _ = Nothing  pattern DataString :: Bytes -> Expression pattern DataString bts = DataObject "string" bts@@ -91,7 +91,7 @@ pattern DataNumber bts = DataObject "number" bts  pattern DataObject :: String -> Bytes -> Expression-pattern DataObject label bts <- (matchDataoObject -> Just (label, bts))+pattern DataObject label bts <- (matchDataObject -> Just (label, bts))   where     DataObject label bts =       ExApplication

@@ -15,6 +15,7 @@ import qualified Data.Map.Strict as M import Data.Maybe (catMaybes, fromMaybe, isJust) import qualified Data.Set as Set+import Deps import Logger (logDebug) import Matcher (MetaValue (MvAttribute, MvBindings, MvBytes, MvExpression), Subst (Subst), combine, combineMany, defaultScope, matchProgram, substEmpty, substSingle) import Misc (ensuredFile)@@ -24,7 +25,6 @@ import Replacer (ReplaceProgramContext (ReplaceProgramContext), ReplaceProgramThrowsFunc, replaceProgramFastThrows, replaceProgramThrows) import Rule (RuleContext (RuleContext), matchProgramWithRule) import qualified Rule as R-import Term import Text.Printf import Yaml (ExtraArgument (..)) import qualified Yaml as Y@@ -35,7 +35,8 @@     _maxCycles :: Integer,     _depthSensitive :: Bool,     _buildTerm :: BuildTermFunc,-    _must :: Must+    _must :: Must,+    _saveStep :: SaveStepFunc   }  data RewriteException@@ -117,34 +118,33 @@     hasMetaBindings = foldl (\acc bd -> acc || isMetaBinding bd) False tryBuildAndReplaceFast ptn res substs ctx = buildAndReplace' ptn res substs replaceProgramThrows ctx -rewrite :: Program -> [Y.Rule] -> Set.Set Program -> RewriteContext -> IO (Program, Set.Set Program)-rewrite program [] progs _ = pure (program, progs)-rewrite program (rule : rest) progs ctx = do+rewrite :: Program -> [Y.Rule] -> Set.Set Program -> Integer -> RewriteContext -> IO (Program, Set.Set Program)+rewrite program [] progs _ _ = pure (program, progs)+rewrite program (rule : rest) progs iteration ctx@RewriteContext {..} = do   (prog, _progs) <- _rewrite program 1 progs-  rewrite prog rest _progs ctx+  rewrite prog rest _progs iteration ctx   where     _rewrite :: Program -> Integer -> Set.Set Program -> IO (Program, Set.Set Program)     _rewrite prog count progs' =       let ruleName = fromMaybe "unknown" (Y.name rule)           ptn = Y.pattern rule           res = Y.result rule-          depth = _maxDepth ctx-       in if count - 1 == depth+       in if count - 1 == _maxDepth             then do-              logDebug (printf "Max amount of rewriting cycles (%d) for rule '%s' has been reached, rewriting is stopped" depth ruleName)-              if _depthSensitive ctx-                then throwIO (StoppedOnLimit "max-depth" depth)+              logDebug (printf "Max amount of rewriting cycles (%d) for rule '%s' has been reached, rewriting is stopped" _maxDepth ruleName)+              if _depthSensitive+                then throwIO (StoppedOnLimit "max-depth" _maxDepth)                 else pure (prog, progs')             else do-              logDebug (printf "Starting rewriting cycle for rule '%s': %d out of %d" ruleName count depth)-              matched <- R.matchProgramWithRule prog rule (RuleContext (_program ctx) (_buildTerm ctx))+              logDebug (printf "Starting rewriting cycle for rule '%s': %d out of %d" ruleName count _maxDepth)+              matched <- R.matchProgramWithRule prog rule (RuleContext _program _buildTerm)               if null matched                 then do                   logDebug (printf "Rule '%s' does not match, rewriting is stopped" ruleName)                   pure (prog, progs')                 else do                   logDebug (printf "Rule '%s' has been matched, applying..." ruleName)-                  prog' <- tryBuildAndReplaceFast ptn res matched (ReplaceProgramContext prog depth)+                  prog' <- tryBuildAndReplaceFast ptn res matched (ReplaceProgramContext prog _maxDepth)                   if prog == prog'                     then do                       logDebug (printf "Applied '%s', no changes made" ruleName)@@ -160,6 +160,7 @@                                 (countNodes prog)                                 (countNodes prog')                             )+                          _saveStep prog' (((iteration - 1) * _maxDepth) + count)                           _rewrite prog' (count + 1) (Set.insert prog' progs)  rewrite' :: Program -> [Y.Rule] -> RewriteContext -> IO Program@@ -181,7 +182,7 @@                 else pure prog             else do               logDebug (printf "Starting rewriting cycle for all rules: %d out of %d" count cycles)-              (rewritten, progs') <- rewrite prog rules progs ctx+              (rewritten, progs') <- rewrite prog rules progs count ctx               if rewritten == prog                 then do                   logDebug "Rewriting is stopped since it has no effect"

@@ -21,7 +21,7 @@ import Misc (allPathsIn, btsToUnescapedStr) import Pretty (prettyAttribute, prettyBytes, prettyExpression, prettyExpression', prettySubsts, prettyBinding) import Regexp (match)-import Term (BuildTermFunc, Term (..))+import Deps (BuildTermFunc, Term (..)) import Text.Printf (printf) import Yaml (normalizationRules) import qualified Yaml as Y

@@ -1,24 +0,0 @@--- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com--- SPDX-License-Identifier: MIT---- The main goal of this module is breaking cyclic dependency:--- Dataize -> Functions -> Rewriter -> Dataize--- Here we provide custom type BuildTermFunc and add it to--- RewriteContext and DataizeContext. Now Dataize and Rewrite depends--- only on Term module. This allows us to use Rewriter and Dataize in--- Functions module because Rewriter does not depend on Functions anymore.-module Term where-  -import Yaml-import Matcher-import Ast--data Term-  = TeExpression Expression-  | TeAttribute Attribute-  | TeBytes Bytes-  | TeBindings [Binding]--type BuildTermMethod = [ExtraArgument] -> Subst -> Program -> IO Term--type BuildTermFunc = String -> BuildTermMethod

@@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -Wno-unused-do-bind #-}  -- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com -- SPDX-License-Identifier: MIT@@ -8,12 +9,12 @@  import CLI (runCLI) import Control.Exception-import Control.Monad (forM_, unless)+import Control.Monad (forM_, unless, when) import Data.List (isInfixOf) import Data.Version (showVersion) import GHC.IO.Handle import Paths_phino (version)-import System.Directory (removeFile)+import System.Directory (doesDirectoryExist, doesFileExist, listDirectory, removeDirectoryRecursive, removeFile) import System.Exit (ExitCode (ExitFailure)) import System.IO import Test.Hspec@@ -153,14 +154,29 @@             ["rewrite", "--rule=test-resources/cli/first.yaml", "--rule=test-resources/cli/second.yaml", "--max-depth=1", "--max-cycles=3"]             ["it seems rewriting is looping"] -    it "with wrong attribute and valid error message" $-      testCLIFailed-        ["rewrite", "test-resources/cli/with-$this-attribute.phi"]-        [ "[ERROR]: Couldn't parse given phi program, cause: program:10:13:",-          "10 |             $this ↦ ⟦⟧",-          "   |             ^^",-          "unexpected \"$t\""-        ]+      it "with wrong attribute and valid error message" $+        testCLIFailed+          ["rewrite", "test-resources/cli/with-$this-attribute.phi"]+          [ "[ERROR]: Couldn't parse given phi program, cause: program:10:13:",+            "10 |             $this ↦ ⟦⟧",+            "   |             ^^",+            "unexpected \"$t\""+          ]++    it "saves steps to dir with --steps-dir" $ do+      let dir = "test-steps-temp"+      dirExists <- doesDirectoryExist dir+      when dirExists (removeDirectoryRecursive dir)+      withStdin "Q -> [[ x -> \"hello\"]]" $ do+        testCLISucceeded+          ["rewrite", "--rule=test-resources/cli/infinite.yaml", "--max-cycles=2", "--max-depth=2", "--steps-dir=" ++ dir, "--sweet"]+          ["hello_hi_hi"]+        (`shouldBe` True) <$> doesDirectoryExist dir+        files <- listDirectory dir+        length files `shouldBe` 4+        (`shouldBe` True) <$> doesFileExist (dir ++ "/00001.phi")+        (`shouldBe` True) <$> doesFileExist (dir ++ "/00003.phi")+        removeDirectoryRecursive dir      it "desugares without any rules flag from file" $       testCLISucceeded

@@ -5,13 +5,14 @@  import Ast import Control.Monad-import Dataize (dataize, dataize', morph, DataizeContext (DataizeContext))+import Dataize (DataizeContext (DataizeContext), dataize, dataize', morph)+import Deps (dontSaveStep)+import Functions (buildTerm) import Parser (parseProgramThrows) import Test.Hspec-import Functions (buildTerm)  defaultDataizeContext :: Program -> DataizeContext-defaultDataizeContext prog = DataizeContext prog 25 1 False buildTerm+defaultDataizeContext prog = DataizeContext prog 25 1 False buildTerm dontSaveStep  test :: (Eq a, Show a) => (Expression -> DataizeContext -> IO (Maybe a)) -> [(String, Expression, Expression, Maybe a)] -> Spec test func useCases =

@@ -10,7 +10,7 @@ import Matcher (MetaValue (MvBindings), Subst (Subst)) import Misc (uniqueBindings') import Pretty (prettyExpression')-import Term (Term (TeBindings))+import Deps (Term (TeBindings)) import Test.Hspec (Spec, describe, it, shouldBe) import Text.Printf (printf) import Yaml (ExtraArgument (ArgBinding))

@@ -12,12 +12,13 @@ import Data.Aeson import Data.Char (isSpace) import Data.Yaml qualified as Yaml+import Deps (dontSaveStep) import Functions (buildTerm) import GHC.Generics import Misc (allPathsIn, ensuredFile)-import Must (Must(..))+import Must (Must (..)) import Parser (parseProgramThrows)-import Pretty (PrintMode (SWEET), prettyProgram', Encoding (UNICODE))+import Pretty (Encoding (UNICODE), PrintMode (SWEET), prettyProgram') import Rewriter (RewriteContext (RewriteContext), rewrite') import System.FilePath (makeRelative, replaceExtension, (</>)) import Test.Hspec (Spec, describe, expectationFailure, it, pending, runIO)@@ -97,7 +98,19 @@                   if normalize'                     then pure normalizationRules                     else pure []-              rewritten <- rewrite' program rules' (RewriteContext program repeat' repeat' False buildTerm must')+              rewritten <-+                rewrite'+                  program+                  rules'+                  ( RewriteContext+                      program+                      repeat'+                      repeat'+                      False+                      buildTerm+                      must'+                      dontSaveStep+                  )               result' <- parseProgramThrows (output pack)               unless (rewritten == result') $                 expectationFailure