phino 0.0.0.42 → 0.0.0.43
raw patch · 7 files changed
+235/−202 lines, 7 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
+ Ast: instance GHC.Classes.Ord Ast.Binding
+ Ast: instance GHC.Classes.Ord Ast.Bytes
+ Ast: instance GHC.Classes.Ord Ast.Expression
+ Ast: instance GHC.Classes.Ord Ast.Program
- Rewriter: rewrite :: Program -> [Rule] -> RewriteContext -> IO Program
+ Rewriter: rewrite :: Program -> [Rule] -> Set Program -> RewriteContext -> IO (Program, Set Program)
Files
- phino.cabal +1/−1
- src/Ast.hs +6/−6
- src/Parser.hs +34/−20
- src/Pretty.hs +1/−1
- src/Rewriter.hs +37/−33
- src/XMIR.hs +23/−32
- test/CLISpec.hs +133/−109
phino.cabal view
@@ -1,7 +1,7 @@ cabal-version: 3.0 name: phino-version: 0.0.0.42+version: 0.0.0.43 license: MIT synopsis: Command-Line Manipulator of 𝜑-Calculus Expressions description: Please see the README on GitHub at <https://github.com/objectionary/phino#readme>
src/Ast.hs view
@@ -10,18 +10,18 @@ import GHC.Generics (Generic) newtype Program = Program Expression -- Q -> expr- deriving (Eq, Show)+ deriving (Eq, Ord, Show) data Expression- = ExFormation [Binding] -- [bindings]- | ExThis+ = ExFormation [Binding] -- [[ bindings ]]+ | ExThis -- $ | ExGlobal -- Q | ExTermination -- T | ExMeta String -- !e | ExApplication Expression Binding -- expr(attr -> expr) | ExDispatch Expression Attribute -- expr.attr | ExMetaTail Expression String -- expr * !t- deriving (Eq, Show, Generic)+ deriving (Eq, Ord, Show, Generic) data Binding = BiTau Attribute Expression -- attr -> expr@@ -30,14 +30,14 @@ | BiVoid Attribute -- attr ↦ ? | BiLambda String -- λ ⤍ Function | BiMetaLambda String -- λ ⤍ !F- deriving (Eq, Show, Generic)+ deriving (Eq, Ord, Show, Generic) data Bytes = BtEmpty -- -- | BtOne String -- 1F- | BtMany [String] -- 00-01-02-...04 | BtMeta String -- !b- deriving (Eq, Show, Generic)+ deriving (Eq, Ord, Show, Generic) data Attribute = AtLabel String -- attr
src/Parser.hs view
@@ -22,18 +22,14 @@ import Ast import Control.Exception (Exception, throwIO) import Control.Monad (guard)-import Control.Monad.IO.Class (MonadIO (liftIO))-import Data.Char (isAsciiLower, isDigit, isLower)-import Data.List (intercalate)+import Data.Char (isAsciiLower, isDigit) import Data.Scientific (toRealFloat)-import Data.Sequence (mapWithIndex)-import Data.Text.Internal.Fusion.Size (lowerBound) import Data.Void-import GHC.Char (chr)+import GHC.Char import Misc-import Numeric (readHex)+import Numeric import Text.Megaparsec-import Text.Megaparsec.Char (alphaNumChar, char, digitChar, hexDigitChar, letterChar, lowerChar, space1, string, upperChar)+import Text.Megaparsec.Char import qualified Text.Megaparsec.Char.Lexer as L import Text.Printf (printf) @@ -212,13 +208,17 @@ number = do sign <- optional (choice [char '-', char '+']) unsigned <- lexeme L.scientific- let num =- toRealFloat- ( case sign of- Just '-' -> negate unsigned- _ -> unsigned- )- return (DataNumber (numToBts num))+ return+ ( DataNumber+ ( numToBts+ ( toRealFloat+ ( case sign of+ Just '-' -> negate unsigned+ _ -> unsigned+ )+ )+ )+ ) tauBinding :: Parser Attribute -> Parser Binding tauBinding attr = do@@ -229,13 +229,21 @@ BiTau attr' <$> expression, do _ <- symbol "("- voids <- map BiVoid <$> void' `sepBy` symbol ","- _ <- symbol ")"+ voids <-+ choice+ [ rb >> return [],+ do+ voids' <- map BiVoid <$> void' `sepBy1` symbol ","+ rb >> return voids'+ ] _ <- arrow bs <- formationBindings bds <- validatedBindings (voids ++ bs) return (BiTau attr' (ExFormation (withVoidRho bds))) ]+ where+ rb :: Parser String+ rb = symbol ")" metaBinding :: Parser Binding metaBinding = BiMeta <$> meta' 'B' "𝐵"@@ -324,9 +332,15 @@ formationBindings :: Parser [Binding] formationBindings = do _ <- choice [symbol "[[", symbol "⟦"]- bs <- binding `sepBy` symbol ","- _ <- choice [symbol "]]", symbol "⟧"]- return bs+ choice+ [ rsb >> return [],+ do+ bs <- binding `sepBy1` symbol ","+ rsb >> return bs+ ]+ where+ rsb :: Parser String+ rsb = choice [symbol "]]", symbol "⟧"] -- head part of expression -- 1. formation
src/Pretty.hs view
@@ -149,7 +149,7 @@ complexApplication (ExApplication expr (BiTau (AtAlpha 0) expr')) = (expr, [BiTau (AtAlpha 0) expr'], [expr']) complexApplication (ExApplication expr tau) = (expr, [tau], []) --- >>> render (Formatted (SWEET, ExFormation [BiVoid AtRho]))+-- >>> render (Formatted (SWEET, UNICODE, ExFormation [BiVoid AtRho])) -- "\10214\10215" instance Pretty (Formatted Expression) where pretty (Formatted (SWEET, UNICODE, ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang"))) = pretty "Φ̇"
src/Rewriter.hs view
@@ -14,12 +14,13 @@ import Data.Foldable (foldlM) import qualified Data.Map.Strict as M import Data.Maybe (catMaybes, fromMaybe, isJust)+import qualified Data.Set as Set import Logger (logDebug) import Matcher (MetaValue (MvAttribute, MvBindings, MvBytes, MvExpression), Subst (Subst), combine, combineMany, defaultScope, matchProgram, substEmpty, substSingle) import Misc (ensuredFile) import Must (Must (..), exceedsUpperBound, inRange) import Parser (parseProgram, parseProgramThrows)-import Pretty (PrintMode (SWEET), prettyAttribute, prettyBytes, prettyExpression, prettyExpression', prettyProgram, prettyProgram', prettySubsts)+import Pretty (Encoding (UNICODE), PrintMode (SWEET), prettyAttribute, prettyBytes, prettyExpression, prettyExpression', prettyProgram, prettyProgram', prettySubsts) import Replacer (ReplaceProgramContext (ReplaceProgramContext), ReplaceProgramThrowsFunc, replaceProgramFastThrows, replaceProgramThrows) import Rule (RuleContext (RuleContext), matchProgramWithRule) import qualified Rule as R@@ -41,6 +42,7 @@ = MustBeGoing {must :: Must, count :: Integer} | MustStopBefore {must :: Must, count :: Integer} | StoppedOnLimit {flag :: String, limit :: Integer}+ | LoopingRewriting {prog :: String, rule :: String, step :: Integer} deriving (Exception) instance Show RewriteException where@@ -61,6 +63,12 @@ "With option --depth-sensitive it's expected rewriting iterations amount does not reach the limit: --%s=%d" flag limit+ show LoopingRewriting {..} =+ printf+ "On rewriting step '%d' of rule '%s' we got the same program as we got at one of the previous step, it seems rewriting is looping\nProgram: %s"+ step+ rule+ prog -- Build pattern and result expression and replace patterns to results in given program buildAndReplace' :: Expression -> Expression -> [Subst] -> ReplaceProgramThrowsFunc -> ReplaceProgramContext -> IO Program@@ -109,14 +117,14 @@ hasMetaBindings = foldl (\acc bd -> acc || isMetaBinding bd) False tryBuildAndReplaceFast ptn res substs ctx = buildAndReplace' ptn res substs replaceProgramThrows ctx -rewrite :: Program -> [Y.Rule] -> RewriteContext -> IO Program-rewrite program [] _ = pure program-rewrite program (rule : rest) ctx = do- prog <- _rewrite program 1- rewrite prog rest 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+ (prog, _progs) <- _rewrite program 1 progs+ rewrite prog rest _progs ctx where- _rewrite :: Program -> Integer -> IO Program- _rewrite prog count =+ _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@@ -126,43 +134,39 @@ 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)- else pure prog+ 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)) if null matched then do logDebug (printf "Rule '%s' does not match, rewriting is stopped" ruleName)- pure prog+ pure (prog, progs') else do logDebug (printf "Rule '%s' has been matched, applying..." ruleName) prog' <- tryBuildAndReplaceFast ptn res matched (ReplaceProgramContext prog depth) if prog == prog' then do logDebug (printf "Applied '%s', no changes made" ruleName)- pure prog- else do- logDebug- ( printf- "Applied '%s' (%d nodes -> %d nodes)"- ruleName- (countNodes prog)- (countNodes prog')- )- _rewrite prog' (count + 1)+ pure (prog, progs')+ else+ if Set.member prog' progs+ then throwIO (LoopingRewriting (prettyProgram' prog' SWEET UNICODE) ruleName count)+ else do+ logDebug+ ( printf+ "Applied '%s' (%d nodes -> %d nodes)"+ ruleName+ (countNodes prog)+ (countNodes prog')+ )+ _rewrite prog' (count + 1) (Set.insert prog' progs) --- @todo #169:30min Memorize previous rewritten programs. Right now in order not to--- get an infinite recursion during rewriting we just count have many times we apply--- rewriting rules. If we reach given amount - we just stop. It's not idiomatic and may--- not work on big programs. We need to introduce some mechanism which would memorize--- all rewritten program on each step and if on some step we get the program that have already--- been memorized - we fail because we got into infinite recursion. Ofc we should keep counting--- rewriting cycles if program just only grows on each rewriting. rewrite' :: Program -> [Y.Rule] -> RewriteContext -> IO Program-rewrite' prog rules ctx = _rewrite prog 1+rewrite' prog rules ctx = _rewrite prog 1 Set.empty where- _rewrite :: Program -> Integer -> IO Program- _rewrite prog count = do+ _rewrite :: Program -> Integer -> Set.Set Program -> IO Program+ _rewrite prog count progs = do let cycles = _maxCycles ctx must = _must ctx current = count - 1@@ -177,11 +181,11 @@ else pure prog else do logDebug (printf "Starting rewriting cycle for all rules: %d out of %d" count cycles)- rewritten <- rewrite prog rules ctx+ (rewritten, progs') <- rewrite prog rules progs ctx if rewritten == prog then do- logDebug "No rule matched, rewriting is stopped"+ logDebug "Rewriting is stopped since it has no effect" if not (inRange must current) then throwIO (MustBeGoing must current) else pure rewritten- else _rewrite rewritten (count + 1)+ else _rewrite rewritten (count + 1) progs'
src/XMIR.hs view
@@ -88,24 +88,15 @@ object :: [(String, String)] -> [Node] -> Node object attrs children = NodeElement (element "o" attrs children) --- @todo #278:30min Remove xmirAttributure and replace to prettyAttribute. Right now XMIR does not--- support "ρ" and "φ" in @base and @name attributes. When it's done, we should also generate--- such valid XMIR. To achieve that we should get rid of xmirAttribute function and use prettyAttribute--- instead. Also we should use "@" in formationBinding. Don't forget to remove the puzzle.-xmirAttribute :: Attribute -> String-xmirAttribute AtPhi = "@"-xmirAttribute AtRho = "^"-xmirAttribute other = prettyAttribute other- expression :: Expression -> XmirContext -> IO (String, [Node])-expression ExThis _ = pure ("$", [])-expression ExGlobal _ = pure ("Q", [])+expression ExThis _ = pure (prettyExpression ExThis, [])+expression ExGlobal _ = pure (prettyExpression ExGlobal, []) expression (ExFormation bds) ctx = do nested <- nestedBindings bds ctx pure ("", nested) expression (ExDispatch expr attr) ctx = do (base, children) <- expression expr ctx- let attr' = xmirAttribute attr+ let attr' = prettyAttribute attr if null base then pure ('.' : attr', [object [] children]) else@@ -115,10 +106,10 @@ expression (DataNumber bytes) XmirContext {..} = let bts = object- [("as", prettyAttribute (AtAlpha 0)), ("base", "Q.org.eolang.bytes")]+ [("as", prettyAttribute (AtAlpha 0)), ("base", "Φ.org.eolang.bytes")] [object [] [NodeContent (T.pack (prettyBytes bytes))]] in pure- ( "Q.org.eolang.number",+ ( "Φ.org.eolang.number", if omitComments then [bts] else@@ -129,10 +120,10 @@ expression (DataString bytes) XmirContext {..} = let bts = object- [("as", prettyAttribute (AtAlpha 0)), ("base", "Q.org.eolang.bytes")]+ [("as", prettyAttribute (AtAlpha 0)), ("base", "Φ.org.eolang.bytes")] [object [] [NodeContent (T.pack (prettyBytes bytes))]] in pure- ( "Q.org.eolang.string",+ ( "Φ.org.eolang.string", if omitComments then [bts] else@@ -143,7 +134,7 @@ expression (ExApplication expr (BiTau attr texpr)) ctx = do (base, children) <- expression expr ctx (base', children') <- expression texpr ctx- let as = xmirAttribute attr+ let as = prettyAttribute attr attrs = if null base' then [("as", as)]@@ -161,12 +152,12 @@ pure (Just (object [("name", label), ("base", base)] children)) formationBinding (BiTau AtPhi expr) ctx = do (base, children) <- expression expr ctx- pure (Just (object [("name", "@"), ("base", base)] children))+ pure (Just (object [("name", show AtPhi), ("base", base)] children)) formationBinding (BiTau AtRho _) _ = pure Nothing formationBinding (BiDelta bytes) _ = pure (Just (NodeContent (T.pack (prettyBytes bytes))))-formationBinding (BiLambda func) _ = pure (Just (object [("name", "λ")] []))+formationBinding (BiLambda func) _ = pure (Just (object [("name", show AtLambda)] [])) formationBinding (BiVoid AtRho) _ = pure Nothing-formationBinding (BiVoid AtPhi) _ = pure (Just (object [("name", "@"), ("base", "∅")] []))+formationBinding (BiVoid AtPhi) _ = pure (Just (object [("name", show AtPhi), ("base", "∅")] [])) formationBinding (BiVoid (AtLabel label)) _ = pure (Just (object [("name", label), ("base", "∅")] [])) formationBinding binding _ = throwIO (UnsupportedBinding binding) @@ -389,13 +380,13 @@ case name of "λ" -> pure (BiLambda (intercalate "_" ("L" : reverse fqn))) ('α' : _) -> throwIO (InvalidXMIRFormat "Formation child @name can't start with α" cur)- "@" -> pure (BiTau AtPhi (ExFormation (withVoidRho bds)))+ "φ" -> pure (BiTau AtPhi (ExFormation (withVoidRho bds))) _ -> pure (BiTau (AtLabel name) (ExFormation (withVoidRho bds))) | otherwise = do name <- getAttr "name" cur base <- getAttr "base" cur attr <- case name of- "@" -> pure AtPhi+ "φ" -> pure AtPhi ('α' : _) -> throwIO (InvalidXMIRFormat "Formation child @name can't start with α" cur) _ -> pure (AtLabel name) case base of@@ -421,17 +412,17 @@ attr <- toAttr rest cur let disp = ExDispatch expr attr xmirToApplication disp (tail args) fqn- "$" ->+ "ξ" -> if null (cur C.$/ C.element (toName "o")) then pure ExThis- else throwIO (InvalidXMIRFormat "Application of '$' is illegal in XMIR" cur)- "Q" ->+ else throwIO (InvalidXMIRFormat "Application of 'ξ' is illegal in XMIR" cur)+ "Φ" -> if null (cur C.$/ C.element (toName "o")) then pure ExGlobal- else throwIO (InvalidXMIRFormat "Application of 'Q' is illegal in XMIR" cur)- 'Q' : '.' : rest -> xmirToExpression' ExGlobal "Q" rest cur fqn- '$' : '.' : rest -> xmirToExpression' ExThis "$" rest cur fqn- _ -> throwIO (InvalidXMIRFormat "The @base attribute must be either ['∅'|'Q'] or start with ['Q.'|'$.'|'.']" cur)+ else throwIO (InvalidXMIRFormat "Application of 'Φ' is illegal in XMIR" cur)+ 'Φ' : '.' : rest -> xmirToExpression' ExGlobal "Φ" rest cur fqn+ 'ξ' : '.' : rest -> xmirToExpression' ExThis "ξ" rest cur fqn+ _ -> throwIO (InvalidXMIRFormat "The @base attribute must be either ['∅'|'Φ'] or start with ['Φ.'|'ξ.'|'.']" cur) | otherwise = do bds <- mapM (`xmirToFormationBinding` fqn) (cur C.$/ C.element (toName "o")) >>= uniqueBindings' pure (ExFormation (withVoidRho bds))@@ -478,7 +469,7 @@ as <- getAttr "as" cur attr <- toAttr as cur case attr of- AtRho -> throwIO (InvalidXMIRFormat "The '^' in @as attribute is illegal in XMIR" cur)+ AtRho -> throwIO (InvalidXMIRFormat "The 'ρ' in @as attribute is illegal in XMIR" cur) other -> pure other | otherwise = pure (AtAlpha idx) @@ -488,8 +479,8 @@ case TR.readMaybe rest' :: Maybe Integer of Just idx -> pure (AtAlpha idx) Nothing -> throwIO (InvalidXMIRFormat "The attribute started with 'α' must be followed by integer" cur)- "@" -> pure AtPhi- "^" -> pure AtRho+ "φ" -> pure AtPhi+ "ρ" -> pure AtRho _ | head attr `notElem` ['a' .. 'z'] -> throwIO (InvalidXMIRFormat (printf "The attribute '%s' must start with ['a'..'z']" attr) cur) | '.' `elem` attr -> throwIO (InvalidXMIRFormat "Attribute can't contain dots" cur)
test/CLISpec.hs view
@@ -69,9 +69,9 @@ (openTempFile "." pattern) (\(path, _) -> removeFile path) -testCLI :: [String] -> [String] -> Expectation-testCLI args outputs = do- (out, _) <- withStdout (try (runCLI args) :: IO (Either ExitCode ()))+testCLI' :: [String] -> [String] -> Either ExitCode () -> Expectation+testCLI' args outputs exit = do+ (out, result) <- withStdout (try (runCLI args) :: IO (Either ExitCode ())) forM_ outputs ( \output ->@@ -79,43 +79,104 @@ expectationFailure ("Expected that output contains:\n" ++ output ++ "\nbut got:\n" ++ out) )+ result `shouldBe` exit -testCLIFailed :: [String] -> String -> Expectation-testCLIFailed args output = do- (out, result) <- withStdout (try (runCLI args) :: IO (Either ExitCode ()))- out `shouldContain` output- result `shouldBe` Left (ExitFailure 1)+testCLISucceeded :: [String] -> [String] -> Expectation+testCLISucceeded args outputs = testCLI' args outputs (Right ()) +testCLIFailed :: [String] -> [String] -> Expectation+testCLIFailed args outputs = testCLI' args outputs (Left (ExitFailure 1))+ spec :: Spec spec = do it "prints version" $- testCLI ["--version"] [showVersion version]+ testCLISucceeded ["--version"] [showVersion version] it "prints help" $- testCLI+ testCLISucceeded ["--help"] ["Phino - CLI Manipulator of 𝜑-Calculus Expressions", "Usage:"] it "prints debug info with --log-level=DEBUG" $ withStdin "Q -> [[]]" $- testCLI ["rewrite", "--log-level=DEBUG"] ["[DEBUG]:"]+ testCLISucceeded ["rewrite", "--log-level=DEBUG"] ["[DEBUG]:"] - describe "rewrites" $ do+ describe "rewriting" $ do+ describe "fails" $ do+ it "with --input=latex" $+ withStdin "" $+ testCLIFailed+ ["rewrite", "--input=latex"]+ ["The value 'latex' can't be used for '--input' option"]++ it "with negative --max-depth" $+ withStdin "" $+ testCLIFailed+ ["rewrite", "--max-depth=-1"]+ ["--max-depth must be positive"]++ it "with --normalize and --must=1" $+ withStdin "Q -> [[ x -> [[ y -> 5 ]].y ]].x" $+ testCLIFailed+ ["rewrite", "--max-depth=2", "--normalize", "--must=1"]+ ["it's expected rewriting cycles to be in range [1], but rewriting has already reached 2"]++ it "when --in-place is used without input file" $+ withStdin "Q -> [[ ]]" $+ testCLIFailed+ ["rewrite", "--in-place"]+ ["--in-place requires an input file"]++ it "when --in-place is used with --target" $+ withTempFile "inplaceXXXXXX.phi" $ \(path, h) -> do+ hPutStr h "Q -> [[ ]]"+ hClose h+ testCLIFailed+ ["rewrite", "--in-place", "--target=output.phi", path]+ ["--in-place and --target cannot be used together"]++ it "with --depth-sensitive" $+ withStdin "Q -> [[ x -> \"x\"]]" $+ testCLIFailed+ ["rewrite", "--depth-sensitive", "--max-depth=1", "--max-cycles=1", "--rule=test-resources/cli/infinite.yaml"]+ ["[ERROR]: With option --depth-sensitive it's expected rewriting iterations amount does not reach the limit: --max-depth=1"]++ it "on --sweet and --output=xmir together" $+ withStdin "Q -> [[ ]]" $+ testCLIFailed+ ["rewrite", "--sweet", "--output=xmir"]+ ["The --sweet and --output=xmir can't stay together"]++ it "with looping rules" $+ withStdin "Q -> [[ x -> \"0\" ]]" $+ testCLIFailed+ ["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 "desugares without any rules flag from file" $- testCLI+ testCLISucceeded ["rewrite", "test-resources/cli/desugar.phi"] ["Φ ↦ ⟦\n foo ↦ Φ.org.eolang,\n ρ ↦ ∅\n⟧"] it "desugares with without any rules flag from stdin" $ withStdin "{[[foo ↦ QQ]]}" $- testCLI ["rewrite"] ["Φ ↦ ⟦\n foo ↦ Φ.org.eolang,\n ρ ↦ ∅\n⟧"]+ testCLISucceeded ["rewrite"] ["Φ ↦ ⟦\n foo ↦ Φ.org.eolang,\n ρ ↦ ∅\n⟧"] it "rewrites with single rule" $ withStdin "{T(x -> Q.y)}" $- testCLI ["rewrite", "--rule=resources/dc.yaml"] ["Φ ↦ ⊥"]+ testCLISucceeded ["rewrite", "--rule=resources/dc.yaml"] ["Φ ↦ ⊥"] it "normalizes with --normalize flag" $- testCLI+ testCLISucceeded ["rewrite", "--normalize", "test-resources/cli/normalize.phi"] [ unlines [ "Φ ↦ ⟦",@@ -130,17 +191,9 @@ ] ] - it "fails with --input=latex" $- withStdin "" $- testCLIFailed ["rewrite", "--input=latex"] "The value 'latex' can't be used for '--input' option"-- it "fails with negative --max-depth" $- withStdin "" $- testCLIFailed ["rewrite", "--max-depth=-1"] "--max-depth must be positive"- it "normalizes from stdin" $ withStdin "Φ ↦ ⟦ a ↦ ⟦ b ↦ ∅ ⟧ (b ↦ [[ ]]) ⟧" $- testCLI+ testCLISucceeded ["rewrite", "--normalize"] [ unlines [ "Φ ↦ ⟦",@@ -155,19 +208,19 @@ it "rewrites with --sweet flag" $ withStdin "Q -> [[ x -> 5]]" $- testCLI+ testCLISucceeded ["rewrite", "--sweet"] ["{⟦\n x ↦ 5\n⟧}"] it "rewrites as XMIR" $ withStdin "Q -> [[ x -> Q.y ]]" $- testCLI+ testCLISucceeded ["rewrite", "--output=xmir"]- ["<?xml version=\"1.0\" encoding=\"UTF-8\"?>", "<object", " <o base=\"Q.y\" name=\"x\"/>"]+ ["<?xml version=\"1.0\" encoding=\"UTF-8\"?>", "<object", " <o base=\"Φ.y\" name=\"x\"/>"] it "rewrites as LaTeX" $ withStdin "Q -> [[ x -> QQ.z(y -> 5), q -> T, w -> $, ^ -> Q, @ -> 1, y -> \"H$@^M\"]]" $- testCLI+ testCLISucceeded ["rewrite", "--output=latex", "--sweet"] [ "\\documentclass{article}", "\\usepackage{eolang}",@@ -188,8 +241,8 @@ ] it "rewrites with XMIR as input" $- withStdin "<object><o name=\"app\"><o name=\"x\" base=\"Q.number\"/></o></object>" $- testCLI+ withStdin "<object><o name=\"app\"><o name=\"x\" base=\"Φ.number\"/></o></object>" $+ testCLISucceeded ["rewrite", "--input=xmir", "--sweet"] [ unlines [ "{⟦",@@ -202,80 +255,77 @@ it "rewrites as XMIR with omit-listing flag" $ withStdin "Q -> [[ x -> Q.y ]]" $- testCLI+ testCLISucceeded ["rewrite", "--output=xmir", "--omit-listing"]- ["<?xml version=\"1.0\" encoding=\"UTF-8\"?>", "<object", "<listing>1 line(s)</listing>", " <o base=\"Q.y\" name=\"x\"/>"]+ ["<?xml version=\"1.0\" encoding=\"UTF-8\"?>", "<object", "<listing>1 line(s)</listing>", " <o base=\"Φ.y\" name=\"x\"/>"] it "does not fail on exactly 1 rewriting" $ withStdin "{⟦ t ↦ ⟦ x ↦ \"foo\" ⟧ ⟧}" $- testCLI+ testCLISucceeded ["rewrite", "--rule=test-resources/cli/simple.yaml", "--must=1", "--sweet"] ["x ↦ \"bar\""] - it "fails with --normalize and --must=1" $- withStdin "Q -> [[ x -> [[ y -> 5 ]].y ]].x" $- testCLIFailed ["rewrite", "--max-depth=2", "--normalize", "--must=1"] "it's expected rewriting cycles to be in range [1], but rewriting has already reached 2"- describe "must range tests" $ do+ describe "fails" $ do+ it "when cycles exceed range ..1" $+ withStdin "Q -> [[ x -> [[ y -> 5 ]].y ]].x" $+ testCLIFailed+ ["rewrite", "--max-depth=2", "--normalize", "--must=..1"]+ ["it's expected rewriting cycles to be in range [..1], but rewriting has already reached 2"]++ it "when cycles below range 2.." $+ withStdin "{⟦ t ↦ ⟦ x ↦ \"foo\" ⟧ ⟧}" $+ testCLIFailed+ ["rewrite", "--rule=test-resources/cli/simple.yaml", "--must=2.."]+ ["it's expected rewriting cycles to be in range [2..], but rewriting stopped after 1"]++ it "with invalid range 5..3" $+ withStdin "Q -> [[ ]]" $+ testCLIFailed+ ["rewrite", "--must=5..3"]+ ["cannot parse value `5..3'"]++ it "with negative in range -1..5" $+ withStdin "Q -> [[ ]]" $+ testCLIFailed+ ["rewrite", "--must=-1..5"]+ ["cannot parse value `-1..5'"]++ it "with malformed range syntax" $+ withStdin "Q -> [[ ]]" $+ testCLIFailed+ ["rewrite", "--must=3...5"]+ ["cannot parse value `3...5'"]+ it "accepts range ..5 (0 to 5 cycles)" $ withStdin "Q -> [[ ]]" $- testCLI ["rewrite", "--must=..5", "--sweet"] ["{⟦⟧}"]+ testCLISucceeded ["rewrite", "--must=..5", "--sweet"] ["{⟦⟧}"] it "accepts range 0..0 (exactly 0 cycles)" $ withStdin "Q -> [[ ]]" $- testCLI ["rewrite", "--must=0..0", "--sweet"] ["{⟦⟧}"]+ testCLISucceeded ["rewrite", "--must=0..0", "--sweet"] ["{⟦⟧}"] it "accepts range 1..1 (exactly 1 cycle)" $ withStdin "{⟦ t ↦ ⟦ x ↦ \"foo\" ⟧ ⟧}" $- testCLI+ testCLISucceeded ["rewrite", "--rule=test-resources/cli/simple.yaml", "--must=1..1", "--sweet"] ["x ↦ \"bar\""] it "accepts range 1..3 when 1 cycle happens" $ withStdin "{⟦ t ↦ ⟦ x ↦ \"foo\" ⟧ ⟧}" $- testCLI+ testCLISucceeded ["rewrite", "--rule=test-resources/cli/simple.yaml", "--must=1..3", "--sweet"] ["x ↦ \"bar\""] it "accepts range 0.. (0 or more)" $ withStdin "Q -> [[ ]]" $- testCLI ["rewrite", "--must=0..", "--sweet"] ["{⟦⟧}"]-- it "fails when cycles exceed range ..1" $- withStdin "Q -> [[ x -> [[ y -> 5 ]].y ]].x" $- testCLIFailed- ["rewrite", "--max-depth=2", "--normalize", "--must=..1"]- "it's expected rewriting cycles to be in range [..1], but rewriting has already reached 2"-- it "fails when cycles below range 2.." $- withStdin "{⟦ t ↦ ⟦ x ↦ \"foo\" ⟧ ⟧}" $- testCLIFailed- ["rewrite", "--rule=test-resources/cli/simple.yaml", "--must=2.."]- "it's expected rewriting cycles to be in range [2..], but rewriting stopped after 1"-- it "fails with invalid range 5..3" $- withStdin "Q -> [[ ]]" $- testCLIFailed- ["rewrite", "--must=5..3"]- "cannot parse value `5..3'"-- it "fails with negative in range -1..5" $- withStdin "Q -> [[ ]]" $- testCLIFailed- ["rewrite", "--must=-1..5"]- "cannot parse value `-1..5'"-- it "fails with malformed range syntax" $- withStdin "Q -> [[ ]]" $- testCLIFailed- ["rewrite", "--must=3...5"]- "cannot parse value `3...5'"+ testCLISucceeded ["rewrite", "--must=0..", "--sweet"] ["{⟦⟧}"] it "prints to target file" $ withStdin "Q -> [[ ]]" $ withTempFile "targetXXXXXX.tmp" $ \(path, h) -> do hClose h- testCLI+ testCLISucceeded ["rewrite", "--sweet", printf "--target=%s" path] [printf "The command result was saved in '%s'" path] content <- readFile path@@ -285,29 +335,15 @@ withTempFile "inplaceXXXXXX.phi" $ \(path, h) -> do hPutStr h "Q -> [[ x -> \"foo\" ]]" hClose h- testCLI+ testCLISucceeded ["rewrite", "--rule=test-resources/cli/simple.yaml", "--in-place", "--sweet", path] [printf "The file '%s' was modified in-place" path] content <- readFile path content `shouldBe` "{⟦\n x ↦ \"bar\"\n⟧}" - it "fails when --in-place is used without input file" $- withStdin "Q -> [[ ]]" $- testCLIFailed- ["rewrite", "--in-place"]- "--in-place requires an input file"-- it "fails when --in-place is used with --target" $- withTempFile "inplaceXXXXXX.phi" $ \(path, h) -> do- hPutStr h "Q -> [[ ]]"- hClose h- testCLIFailed- ["rewrite", "--in-place", "--target=output.phi", path]- "--in-place and --target cannot be used together"- it "rewrites with cycles" $ withStdin "Q -> [[ x -> \"x\" ]]" $- testCLI+ testCLISucceeded ["rewrite", "--sweet", "--rule=test-resources/cli/infinite.yaml", "--max-depth=1", "--max-cycles=2"] [ unlines [ "{⟦",@@ -316,47 +352,35 @@ ] ] - it "fails with --depth-sensitive" $- withStdin "Q -> [[ x -> \"x\"]]" $- testCLIFailed- ["rewrite", "--depth-sensitive", "--max-depth=1", "--max-cycles=1", "--rule=test-resources/cli/infinite.yaml"]- "[ERROR]: With option --depth-sensitive it's expected rewriting iterations amount does not reach the limit: --max-depth=1"-- it "fails on --sweet and --output=xmir together" $- withStdin "Q -> [[ ]]" $- testCLIFailed- ["rewrite", "--sweet", "--output=xmir"]- "The --sweet and --output=xmir can't stay together"- describe "dataize" $ do it "dataizes simple program" $ withStdin "Q -> [[ D> 01- ]]" $- testCLI ["dataize"] ["01-"]+ testCLISucceeded ["dataize"] ["01-"] it "fails to dataize" $ withStdin "Q -> [[ ]]" $- testCLIFailed ["dataize"] "[ERROR]: Could not dataize given program"+ testCLIFailed ["dataize"] ["[ERROR]: Could not dataize given program"] describe "explain" $ do it "explains single rule" $- testCLI+ testCLISucceeded ["explain", "--rule=resources/copy.yaml"] ["\\documentclass{article}", "\\usepackage{amsmath}", "\\begin{document}", "\\rule{COPY}", "\\end{document}"] it "explains multiple rules" $- testCLI+ testCLISucceeded ["explain", "--rule=resources/copy.yaml", "--rule=resources/alpha.yaml"] ["\\documentclass{article}", "\\rule{COPY}", "\\rule{ALPHA}"] it "explains normalization rules" $- testCLI+ testCLISucceeded ["explain", "--normalize"] ["\\documentclass{article}", "\\begin{document}", "\\end{document}"] it "fails with no rules specified" $ testCLIFailed ["explain"]- "Either --rule or --normalize must be specified"+ ["Either --rule or --normalize must be specified"] it "writes to target file" $ bracket@@ -364,7 +388,7 @@ (\(path, _) -> removeFile path) ( \(path, h) -> do hClose h- testCLI+ testCLISucceeded ["explain", "--normalize", printf "--target=%s" path] [printf "was saved in '%s'" path] content <- readFile path