diff --git a/phino.cabal b/phino.cabal --- a/phino.cabal +++ b/phino.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: phino -version: 0.0.0.48 +version: 0.0.0.49 license: MIT synopsis: Command-Line Manipulator of 𝜑-Calculus Expressions description: Please see the README on GitHub at @@ -40,6 +40,7 @@ Deps Encoding Functions + Hide LaTeX Lining Logger @@ -114,6 +115,7 @@ CSTSpec DataizeSpec FunctionsSpec + HideSpec MatcherSpec MergeSpec MiscSpec diff --git a/src/CLI.hs b/src/CLI.hs --- a/src/CLI.hs +++ b/src/CLI.hs @@ -9,10 +9,10 @@ module CLI (runCLI) where -import AST (Program (Program)) +import AST import Control.Exception (Exception (displayException), SomeException, handle, throw, throwIO) import Control.Exception.Base -import Control.Monad (when) +import Control.Monad (when, (>=>)) import Data.Char (toLower, toUpper) import Data.Functor ((<&>)) import Data.List (intercalate) @@ -23,6 +23,7 @@ import Encoding (Encoding (ASCII, UNICODE)) import Functions (buildTerm) import qualified Functions +import qualified Hide as H import LaTeX (LatexContext (LatexContext), explainRules, programToLaTeX, rewrittensToLatex) import Lining (LineFormat (MULTILINE, SINGLELINE)) import Logger @@ -31,8 +32,9 @@ import qualified Misc import Must (Must (..)) import Options.Applicative -import Parser (parseProgramThrows) +import Parser (parseExpressionThrows, parseProgramThrows) import Paths_phino (version) +import Printer (printExpression') import qualified Printer as P import Rewriter (RewriteContext (RewriteContext), Rewritten (..), rewrite') import Sugar @@ -47,7 +49,9 @@ { sugar :: SugarType, line :: LineFormat, xmirCtx :: XmirContext, - nonumber :: Bool + nonumber :: Bool, + expression :: Maybe String, + label :: Maybe String } data CmdException @@ -113,6 +117,9 @@ maxCycles :: Integer, inPlace :: Bool, sequence :: Bool, + expression :: Maybe String, + label :: Maybe String, + hide :: [String], targetFile :: Maybe FilePath, stepsDir :: Maybe FilePath, inputFile :: Maybe FilePath @@ -266,6 +273,9 @@ <*> optMaxCycles <*> switch (long "in-place" <> help "Edit file in-place instead of printing to output") <*> switch (long "sequence" <> help "Result output contains all intermediate 𝜑-programs concatenated with EOL") + <*> optional (strOption (long "expression" <> metavar "NAME" <> help "Name for 'phiExpression' element when rendering to LaTeX")) + <*> optional (strOption (long "label" <> metavar "NAME" <> help "Name for 'label' element when rendering to LaTeX")) + <*> many (strOption (long "hide" <> metavar "FQN" <> help "Location of object to exclude from result program after rewriting, must be a valid dispatch expression; e.g. Q.org.eolang")) <*> optTarget <*> optStepsDir <*> argInputFile @@ -317,6 +327,9 @@ CmdMerge OptsMerge {logLevel} -> logLevel in setLogLevel level +invalidCLIArguments :: String -> IO a +invalidCLIArguments msg = throwIO (InvalidCLIArguments msg) + runCLI :: [String] -> IO () runCLI args = handle handler $ do cmd <- handleParseResult (execParserPure defaultPrefs parserInfo args) @@ -324,14 +337,15 @@ case cmd of CmdRewrite OptsRewrite {..} -> do validateOpts + exclude <- traverse (parseExpressionThrows >=> canBeHidden) hide logDebug (printf "Amount of rewriting cycles across all the rules: %d, per rule: %d" maxCycles maxDepth) input <- readInput inputFile rules' <- getRules normalize shuffle rules program <- parseProgram input inputFormat let listing = if null rules' then const input else (\prog -> P.printProgram' prog (sugarType, UNICODE, flat)) xmirCtx = XmirContext omitListing omitComments listing - printProgCtx = PrintProgCtx sugarType flat xmirCtx nonumber - rewrittens <- rewrite' program rules' (context printProgCtx) + printProgCtx = PrintProgCtx sugarType flat xmirCtx nonumber expression label + rewrittens <- rewrite' program rules' (context printProgCtx) <&> (`H.hide` exclude) logDebug (printf "Printing rewritten 𝜑-program as %s" (show outputFormat)) progs <- printRewrittens printProgCtx rewrittens output targetFile progs @@ -340,13 +354,19 @@ validateOpts = do when (inPlace && isNothing inputFile) - (throwIO (InvalidCLIArguments "--in-place requires an input file")) + (invalidCLIArguments "--in-place requires an input file") when (inPlace && isJust targetFile) - (throwIO (InvalidCLIArguments "--in-place and --target cannot be used together")) + (invalidCLIArguments "--in-place and --target cannot be used together") when (nonumber && outputFormat /= LATEX) - (throwIO (InvalidCLIArguments "The --nonumber option can stay together with --output=latex only")) + (invalidCLIArguments "The --nonumber option can stay together with --output=latex only") + when + (isJust expression && outputFormat /= LATEX) + (invalidCLIArguments "The --expression option can stay together with --output=latex only") + when + (isJust label && outputFormat /= LATEX) + (invalidCLIArguments "The --label option can stay together with --output=latex only") validateMaxDepth maxDepth validateMaxCycles maxCycles validateMust must @@ -376,8 +396,20 @@ (saveStep stepsDir (ioToExtension outputFormat) (printProgram outputFormat ctx)) printRewrittens :: PrintProgramContext -> [Rewritten] -> IO String printRewrittens ctx rewrittens - | outputFormat == LATEX = pure (rewrittensToLatex rewrittens (LatexContext sugarType flat nonumber)) + | outputFormat == LATEX = pure (rewrittensToLatex rewrittens (LatexContext sugarType flat nonumber expression label)) | otherwise = mapM (printProgram outputFormat ctx . program) rewrittens <&> intercalate "\n" + canBeHidden :: Expression -> IO Expression + canBeHidden expr = canBeHidden' expr expr + where + canBeHidden' :: Expression -> Expression -> IO Expression + canBeHidden' exp@(ExDispatch ExGlobal _) _ = pure exp + canBeHidden' exp@(ExDispatch expr attr) full = canBeHidden' expr full >> pure exp + canBeHidden' _ full = + invalidCLIArguments + ( printf + "Only dispatch expression started with Φ (or Q) can be used in --hide, but given: %s" + (printExpression' full P.logPrintConfig) + ) CmdDataize OptsDataize {..} -> do validateOpts input <- readInput inputFile @@ -397,7 +429,7 @@ maxCycles depthSensitive buildTerm - (saveStep stepsDir (ioToExtension PHI) (printProgram PHI (PrintProgCtx sugarType flat defaultXmirContext False))) + (saveStep stepsDir (ioToExtension PHI) (printProgram PHI (PrintProgCtx sugarType flat defaultXmirContext False Nothing Nothing))) CmdExplain OptsExplain {..} -> do validateOpts rules' <- getRules normalize shuffle rules @@ -416,7 +448,7 @@ prog <- merge progs let listing = const (P.printProgram' prog (sugarType, UNICODE, flat)) xmirCtx = XmirContext omitListing omitComments listing - printProgCtx = PrintProgCtx sugarType flat xmirCtx False + printProgCtx = PrintProgCtx sugarType flat xmirCtx False Nothing Nothing prog' <- printProgram outputFormat printProgCtx prog output targetFile prog' where @@ -431,15 +463,15 @@ validateXmirOptions outputFormat omitListing omitComments = do when (outputFormat /= XMIR && omitListing) - (throwIO (InvalidCLIArguments "--omit-listing can be used only with --output-format=xmir")) + (invalidCLIArguments "--omit-listing can be used only with --output-format=xmir") when (outputFormat /= XMIR && omitComments) - (throwIO (InvalidCLIArguments "--omit-comments can be used only with --output-format=xmir")) + (invalidCLIArguments "--omit-comments can be used only with --output-format=xmir") validateIntArgument :: Integer -> (Integer -> Bool) -> String -> IO () validateIntArgument num cmp msg = when (cmp num) - (throwIO (InvalidCLIArguments msg)) + (invalidCLIArguments msg) validateMaxDepth :: Integer -> IO () validateMaxDepth depth = validateIntArgument depth (<= 0) "--max-depth must be positive" validateMaxCycles :: Integer -> IO () @@ -453,10 +485,8 @@ case (minVal, maxVal) of (Just min, Just max) | min > max -> - throwIO - ( InvalidCLIArguments - (printf "--must range invalid: minimum (%d) is greater than maximum (%d)" min max) - ) + invalidCLIArguments + (printf "--must range invalid: minimum (%d) is greater than maximum (%d)" min max) _ -> pure () readInput :: Maybe FilePath -> IO String readInput inputFile' = case inputFile' of @@ -474,7 +504,7 @@ printProgram :: IOFormat -> PrintProgramContext -> Program -> IO String printProgram PHI PrintProgCtx {..} prog = pure (P.printProgram' prog (sugar, UNICODE, line)) printProgram XMIR PrintProgCtx {..} prog = programToXMIR prog xmirCtx <&> printXMIR - printProgram LATEX PrintProgCtx {..} prog = pure (programToLaTeX prog (LatexContext sugar line nonumber)) + printProgram LATEX PrintProgCtx {..} prog = pure (programToLaTeX prog (LatexContext sugar line nonumber expression label)) getRules :: Bool -> Bool -> [FilePath] -> IO [Y.Rule] getRules normalize shuffle rules = do ordered <- diff --git a/src/CST.hs b/src/CST.hs --- a/src/CST.hs +++ b/src/CST.hs @@ -14,6 +14,12 @@ import Data.List (intercalate) import Misc +data LCB = LCB | BIG_LCB + deriving (Eq, Show) + +data RCB = RCB | BIG_RCB + deriving (Eq, Show) + data LSB = LSB | LSB' deriving (Eq, Show) @@ -62,9 +68,26 @@ data EOL = EOL | NO_EOL deriving (Eq, Show) -data BYTES = BT_EMPTY | BT_ONE String | BT_MANY [String] +data BYTES + = BT_EMPTY + | BT_ONE String + | BT_MANY [String] + | BT_META META deriving (Eq, Show) +data META + = MT_EXPRESSION {rest :: String} + | MT_EXPRESSION' {rest :: String} + | MT_ATTRIBUTE {rest :: String} + | MT_ATTRIBUTE' {rest :: String} + | MT_BINDING {rest :: String} + | MT_BINDING' {rest :: String} + | MT_BYTES {rest :: String} + | MT_BYTES' {rest :: String} + | MT_TAIL {rest :: String} + | MT_FUNCTION {rest :: String} + deriving (Eq, Show) + data TAB = TAB {indent :: Integer} | TAB' @@ -75,7 +98,7 @@ deriving (Eq, Show) data PROGRAM - = PR_SWEET {expr :: EXPRESSION} + = PR_SWEET {lcb :: LCB, expr :: EXPRESSION, rcb :: RCB} | PR_SALTY {global :: GLOBAL, arrow :: ARROW, expr :: EXPRESSION} deriving (Eq, Show) @@ -84,18 +107,24 @@ | PA_VOID {attr :: ATTRIBUTE, arrow :: ARROW, void :: VOID} | PA_LAMBDA {func :: String} | PA_LAMBDA' {func :: String} -- ASCII version of PA_LAMBDA + | PA_META_LAMBDA {meta :: META} + | PA_META_LAMBDA' {meta :: META} -- ASCII version of PA_META_LAMBDA' | PA_DELTA {bytes :: BYTES} | PA_DELTA' {bytes :: BYTES} -- ASCII version of PA_DELTA + | PA_META_DELTA {meta :: META} + | PA_META_DELTA' {meta :: META} -- ASCII version of PA_META_DELTA deriving (Eq, Show) data BINDING = BI_PAIR {pair :: PAIR, bindings :: BINDINGS, tab :: TAB} | BI_EMPTY {tab :: TAB} + | BI_META {meta :: META, bindings :: BINDINGS, tab :: TAB} deriving (Eq, Show) data BINDINGS = BDS_PAIR {eol :: EOL, tab :: TAB, pair :: PAIR, bindings :: BINDINGS} | BDS_EMPTY {tab :: TAB} + | BDS_META {eol :: EOL, tab :: TAB, meta :: META, bindings :: BINDINGS} deriving (Eq, Show) -- Arguments for application with default α attributes @@ -120,6 +149,8 @@ | EX_APPLICATION' {expr :: EXPRESSION, eol :: EOL, tab :: TAB, args :: APP_ARG, eol' :: EOL, tab' :: TAB} | EX_STRING {str :: String, tab :: TAB} | EX_NUMBER {num :: Either Integer Double, tab :: TAB} + | EX_META {meta :: META} + | EX_META_TAIL {expr :: EXPRESSION, meta :: META} deriving (Eq, Show) data ATTRIBUTE @@ -129,6 +160,7 @@ | AT_PHI {phi :: PHI} | AT_LAMBDA {lambda :: LAMBDA} | AT_DELTA {delta :: DELTA} + | AT_META {meta :: META} deriving (Eq, Show) programToCST :: Program -> PROGRAM @@ -144,11 +176,13 @@ toCST :: a -> Integer -> b instance ToCST Program PROGRAM where - toCST (Program expr) tabs = PR_SWEET (toCST expr tabs) + toCST (Program expr) tabs = PR_SWEET LCB (toCST expr tabs) RCB instance ToCST Expression EXPRESSION where toCST ExGlobal _ = EX_GLOBAL Φ toCST ExThis _ = EX_XI XI + toCST (ExMeta mt) _ = EX_META (MT_EXPRESSION (tail mt)) + toCST (ExMetaTail expr mt) tabs = EX_META_TAIL (toCST expr tabs) (MT_TAIL (tail mt)) toCST ExTermination _ = EX_TERMINATION DEAD toCST (ExFormation [BiVoid AtRho]) _ = toCST (ExFormation []) 0 toCST (ExFormation []) _ = EX_FORMATION LSB NO_EOL NO_TAB (BI_EMPTY NO_TAB) NO_EOL NO_TAB RSB @@ -174,14 +208,14 @@ toCST (ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang")) _ = EX_DEF_PACKAGE Φ̇ toCST (ExDispatch ExThis attr) tabs = EX_ATTR (toCST attr tabs) toCST (ExDispatch expr attr) tabs = EX_DISPATCH (toCST expr tabs) (toCST attr tabs) - toCST app@(ExApplication (ExApplication expr tau) tau') tabs = - let (expr', taus, exprs) = complexApplication app + toCST app@(ExApplication _ _) tabs = + let (expr, taus, exprs) = complexApplication app next = tabs + 1 - expr'' = toCST expr' tabs :: EXPRESSION + expr'' = toCST expr tabs :: EXPRESSION in if null exprs then EX_APPLICATION - (toCST expr' tabs) + (toCST expr tabs) EOL (TAB next) (toCST (reverse taus) next) @@ -189,7 +223,7 @@ (TAB tabs) else EX_APPLICATION' - (toCST expr' tabs) + (toCST expr tabs) EOL (TAB next) (toCST (reverse exprs) next) @@ -216,9 +250,6 @@ _ -> (before, taus', []) complexApplication (ExApplication expr (BiTau (AtAlpha 0) expr')) = (expr, [BiTau (AtAlpha 0) expr'], [expr']) complexApplication (ExApplication expr tau) = (expr, [tau], []) - toCST (ExApplication expr tau) tabs = - let next = tabs + 1 - in EX_APPLICATION (toCST expr tabs) EOL (TAB next) (toCST [tau] next) EOL (TAB tabs) instance ToCST [Expression] APP_ARG where toCST (expr : exprs) tabs = APP_ARG (toCST expr tabs) (toCST exprs tabs) @@ -229,10 +260,12 @@ instance ToCST [Binding] BINDING where toCST [] tabs = BI_EMPTY (TAB tabs) + toCST (BiMeta mt : bds) tabs = BI_META (MT_BINDING (tail mt)) (toCST bds tabs) (TAB tabs) toCST (bd : bds) tabs = BI_PAIR (toCST bd tabs) (toCST bds tabs) (TAB tabs) instance ToCST [Binding] BINDINGS where toCST [] tabs = BDS_EMPTY (TAB tabs) + toCST (BiMeta mt : bds) tabs = BDS_META EOL (TAB tabs) (MT_BINDING (tail mt)) (toCST bds tabs) toCST (bd : bds) tabs = BDS_PAIR EOL (TAB tabs) (toCST bd tabs) (toCST bds tabs) instance ToCST Binding PAIR where @@ -240,11 +273,13 @@ toCST (BiVoid attr) tabs = PA_VOID (toCST attr tabs) ARROW EMPTY toCST (BiDelta bts) tabs = PA_DELTA (toCST bts tabs) toCST (BiLambda func) _ = PA_LAMBDA func + toCST (BiMetaLambda mt) _ = PA_META_LAMBDA (MT_FUNCTION (tail mt)) instance ToCST Bytes BYTES where toCST BtEmpty _ = BT_EMPTY toCST (BtOne byte) _ = BT_ONE byte toCST (BtMany bts) _ = BT_MANY bts + toCST (BtMeta mt) _ = BT_META (MT_BYTES (tail mt)) instance ToCST Attribute ATTRIBUTE where toCST (AtLabel label) _ = AT_LABEL label @@ -253,6 +288,7 @@ toCST AtRho _ = AT_RHO RHO toCST AtDelta _ = AT_DELTA DELTA toCST AtLambda _ = AT_LAMBDA LAMBDA + toCST (AtMeta mt) _ = AT_META (MT_ATTRIBUTE (tail mt)) class HasEOL a where hasEOL :: a -> Bool diff --git a/src/Encoding.hs b/src/Encoding.hs --- a/src/Encoding.hs +++ b/src/Encoding.hs @@ -19,7 +19,7 @@ instance ToASCII PROGRAM where toASCII PR_SALTY {..} = PR_SALTY Q ARROW' (toASCII expr) - toASCII PR_SWEET {..} = PR_SWEET (toASCII expr) + toASCII PR_SWEET {..} = PR_SWEET lcb (toASCII expr) rcb instance ToASCII EXPRESSION where toASCII EX_GLOBAL {..} = EX_GLOBAL Q @@ -31,14 +31,18 @@ toASCII EX_DISPATCH {..} = EX_DISPATCH (toASCII expr) (toASCII attr) toASCII EX_APPLICATION {..} = EX_APPLICATION (toASCII expr) eol tab (toASCII bindings) eol' tab' toASCII EX_APPLICATION' {..} = EX_APPLICATION' (toASCII expr) eol tab (toASCII args) eol' tab' + toASCII EX_META {..} = EX_META (MT_EXPRESSION' (rest meta)) + toASCII EX_META_TAIL {..} = EX_META_TAIL (toASCII expr) (MT_TAIL (rest meta)) toASCII expr = expr instance ToASCII BINDING where toASCII BI_PAIR {..} = BI_PAIR (toASCII pair) (toASCII bindings) tab + toASCII BI_META {..} = BI_META (MT_BINDING' (rest meta)) (toASCII bindings) tab toASCII bd = bd instance ToASCII BINDINGS where toASCII BDS_PAIR {..} = BDS_PAIR eol tab (toASCII pair) (toASCII bindings) + toASCII BDS_META {..} = BDS_META eol tab (MT_BINDING' (rest meta)) (toASCII bindings) toASCII bds = bds instance ToASCII APP_ARG where @@ -53,10 +57,13 @@ toASCII PA_VOID {..} = PA_VOID (toASCII attr) ARROW' QUESTION toASCII PA_LAMBDA {..} = PA_LAMBDA' func toASCII PA_DELTA {..} = PA_DELTA' bytes + toASCII PA_META_LAMBDA {..} = PA_META_LAMBDA' meta + toASCII PA_META_DELTA {..} = PA_META_DELTA' (MT_BYTES' (rest meta)) toASCII pair = pair instance ToASCII ATTRIBUTE where toASCII AT_ALPHA {..} = AT_ALPHA ALPHA' idx toASCII AT_PHI {..} = AT_PHI AT toASCII AT_RHO {..} = AT_RHO CARET + toASCII AT_META {..} = AT_META (MT_ATTRIBUTE' (rest meta)) toASCII attr = attr diff --git a/src/Hide.hs b/src/Hide.hs new file mode 100644 --- /dev/null +++ b/src/Hide.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE RecordWildCards #-} + +-- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com +-- SPDX-License-Identifier: MIT + +module Hide (hide, hide') where + +import AST +import Logger (logDebug) +import Misc +import Printer (logPrintConfig, printExpression') +import Rewriter +import Text.Printf (printf) + +fqnToAttrs :: Expression -> [Attribute] +fqnToAttrs = reverse . fqnToAttrs' + where + fqnToAttrs' :: Expression -> [Attribute] + fqnToAttrs' (ExDispatch ExGlobal attr) = [attr] + fqnToAttrs' (ExDispatch expr attr) = attr : fqnToAttrs' expr + fqnToAttrs' expr = [] + +hide' :: Program -> [Expression] -> Program +hide' prog [] = prog +hide' (Program expr@(ExFormation _)) (fqn : rest) = hide' (Program (hiddenFormation expr (fqnToAttrs fqn))) rest + where + hiddenFormation :: Expression -> [Attribute] -> Expression + hiddenFormation (ExFormation bds) [attr] = + let bds' = [bd | bd <- bds, attributeFromBinding bd /= Just attr] + in ExFormation bds' + hiddenFormation (ExFormation bds) attrs = ExFormation (hiddenBindings bds attrs) + where + hiddenBindings :: [Binding] -> [Attribute] -> [Binding] + hiddenBindings [] _ = [] + hiddenBindings (bd@(BiTau attr form@(ExFormation _)) : bds) attrs@(attr' : rest) + | attr == attr' = BiTau attr (hiddenFormation form rest) : bds + | otherwise = bd : hiddenBindings bds attrs + hiddenBindings bds _ = bds + hiddenFormation expr attr = expr +hide' prog (fqn : rest) = prog + +hide :: [Rewritten] -> [Expression] -> [Rewritten] +hide [] _ = [] +hide (Rewritten {..} : rest) exprs = Rewritten (hide' program exprs) maybeRule : hide rest exprs diff --git a/src/LaTeX.hs b/src/LaTeX.hs --- a/src/LaTeX.hs +++ b/src/LaTeX.hs @@ -23,7 +23,9 @@ data LatexContext = LatexContext { sugar :: SugarType, line :: LineFormat, - nonumber :: Bool + nonumber :: Bool, + expression :: Maybe String, + label :: Maybe String } renderToLatex :: Program -> LatexContext -> String @@ -34,10 +36,16 @@ phiquation LatexContext {nonumber = False} = "phiquation" rewrittensToLatex :: [Rewritten] -> LatexContext -> String -rewrittensToLatex rewrittens ctx = +rewrittensToLatex rewrittens ctx@LatexContext {..} = let equation = phiquation ctx in concat [ printf "\\begin{%s}\n" equation, + case label of + Just lbl -> printf "\\label{%s}\n" lbl + _ -> "", + case expression of + Just expr -> printf "\\phiExpression{%s} " expr + _ -> "", intercalate "\n \\leadsto " ( map @@ -69,11 +77,14 @@ "}" ] +piped :: String -> String +piped str = "|" <> str <> "|" + class ToLaTeX a where toLaTeX :: a -> a instance ToLaTeX PROGRAM where - toLaTeX PR_SWEET {..} = PR_SWEET (toLaTeX expr) + toLaTeX PR_SWEET {..} = PR_SWEET BIG_LCB (toLaTeX expr) BIG_RCB toLaTeX PR_SALTY {..} = PR_SALTY global arrow (toLaTeX expr) instance ToLaTeX EXPRESSION where @@ -81,14 +92,11 @@ toLaTeX EX_FORMATION {..} = EX_FORMATION lsb eol tab (toLaTeX binding) eol' tab' rsb toLaTeX EX_APPLICATION {..} = EX_APPLICATION (toLaTeX expr) eol tab (toLaTeX bindings) eol' tab' toLaTeX EX_APPLICATION' {..} = EX_APPLICATION' (toLaTeX expr) eol tab (toLaTeX args) eol' tab' - toLaTeX EX_DISPATCH{..} = EX_DISPATCH (toLaTeX expr) (toLaTeX attr) + toLaTeX EX_DISPATCH {..} = EX_DISPATCH (toLaTeX expr) (toLaTeX attr) toLaTeX expr = expr instance ToLaTeX ATTRIBUTE where toLaTeX AT_LABEL {..} = AT_LABEL (piped (toLaTeX label)) - where - piped :: String -> String - piped str = "|" <> str <> "|" toLaTeX attr = attr instance ToLaTeX BINDING where @@ -101,7 +109,8 @@ instance ToLaTeX PAIR where toLaTeX PA_DELTA {..} = PA_DELTA' bytes - toLaTeX PA_LAMBDA {..} = PA_LAMBDA' func + toLaTeX PA_LAMBDA {..} = PA_LAMBDA' (piped (toLaTeX func)) + toLaTeX PA_LAMBDA' {..} = PA_LAMBDA' (piped (toLaTeX func)) toLaTeX PA_VOID {..} = PA_VOID (toLaTeX attr) arrow void toLaTeX PA_TAU {..} = PA_TAU (toLaTeX attr) arrow (toLaTeX expr) toLaTeX pair = pair @@ -122,6 +131,7 @@ '$' -> "\\char36{}" <> escapeUnprintedChars rest '@' -> "\\char64{}" <> escapeUnprintedChars rest '^' -> "\\char94{}" <> escapeUnprintedChars rest + '_' -> "\\char95{}" <> escapeUnprintedChars rest _ -> ch : escapeUnprintedChars rest -- @todo #114:30min Implement LaTeX conversion for rules. diff --git a/src/Lining.hs b/src/Lining.hs --- a/src/Lining.hs +++ b/src/Lining.hs @@ -20,7 +20,7 @@ instance ToSingleLine PROGRAM where toSingleLine PR_SALTY {..} = PR_SALTY global arrow (toSingleLine expr) - toSingleLine PR_SWEET {..} = PR_SWEET (toSingleLine expr) + toSingleLine PR_SWEET {..} = PR_SWEET lcb (toSingleLine expr) rcb instance ToSingleLine EXPRESSION where toSingleLine EX_FORMATION {lsb, binding = bd@BI_EMPTY {..}, rsb} = EX_FORMATION lsb NO_EOL NO_TAB bd NO_EOL NO_TAB rsb @@ -32,10 +32,12 @@ instance ToSingleLine BINDING where toSingleLine BI_PAIR {..} = BI_PAIR (toSingleLine pair) (toSingleLine bindings) TAB' + toSingleLine BI_META {..} = BI_META meta (toSingleLine bindings) TAB' toSingleLine bd = bd instance ToSingleLine BINDINGS where toSingleLine BDS_PAIR {..} = BDS_PAIR NO_EOL TAB' (toSingleLine pair) (toSingleLine bindings) + toSingleLine BDS_META {..} = BDS_META NO_EOL TAB' meta (toSingleLine bindings) toSingleLine bds = bds instance ToSingleLine PAIR where diff --git a/src/Render.hs b/src/Render.hs --- a/src/Render.hs +++ b/src/Render.hs @@ -25,6 +25,14 @@ instance Render Char where render ch = [ch] +instance Render LCB where + render LCB = "{" + render BIG_LCB = "\\Big\\{" + +instance Render RCB where + render RCB = "}" + render BIG_RCB = "\\Big\\}" + instance Render LSB where render LSB = "⟦" render LSB' = "[[" @@ -90,6 +98,18 @@ render (BT_ONE bte) = render bte <> "-" render (BT_MANY bts) = intercalate "-" bts +instance Render META where + render MT_EXPRESSION {..} = '𝑒' : rest + render MT_EXPRESSION' {..} = "!e" <> rest + render MT_ATTRIBUTE {..} = '𝜏' : rest + render MT_ATTRIBUTE' {..} = "!a" <> rest + render MT_BINDING {..} = '𝐵' : rest + render MT_BINDING' {..} = "!B" <> rest + render MT_BYTES {..} = 'δ' : rest + render MT_BYTES' {..} = "!d" <> rest + render MT_TAIL {..} = "!t" <> rest + render MT_FUNCTION {..} = "!F" <> rest + instance Render ALPHA where render ALPHA = "α" render ALPHA' = "~" @@ -100,7 +120,7 @@ render NO_TAB = "" instance Render PROGRAM where - render PR_SWEET {..} = "{" <> render expr <> "}" + render PR_SWEET {..} = render lcb <> render expr <> render rcb render PR_SALTY {..} = render global <> render SPACE <> render arrow <> render SPACE <> render expr instance Render PAIR where @@ -110,14 +130,20 @@ render PA_VOID {..} = render attr <> render SPACE <> render arrow <> render SPACE <> render void render PA_DELTA {..} = render DELTA <> render SPACE <> render DASHED_ARROW <> render SPACE <> render bytes render PA_DELTA' {..} = "D> " <> render bytes + render PA_META_LAMBDA {..} = render LAMBDA <> render SPACE <> render DASHED_ARROW <> render SPACE <> render meta + render PA_META_LAMBDA' {..} = render "L> " <> render meta + render PA_META_DELTA {..} = render DELTA <> render SPACE <> render DASHED_ARROW <> render SPACE <> render meta + render PA_META_DELTA' {..} = render "D> " <> render meta instance Render BINDINGS where render BDS_EMPTY {..} = "" render BDS_PAIR {..} = render COMMA <> render eol <> render tab <> render pair <> render bindings + render BDS_META {..} = render COMMA <> render eol <> render tab <> render meta <> render bindings instance Render BINDING where - render BI_PAIR {..} = render pair <> render bindings render BI_EMPTY {..} = "" + render BI_PAIR {..} = render pair <> render bindings + render BI_META {..} = render meta <> render bindings instance Render APP_ARG where render APP_ARG {..} = render expr <> render args @@ -142,6 +168,8 @@ render EX_APPLICATION' {..} = render expr <> "(" <> render eol <> render tab <> render args <> render eol' <> render tab' <> ")" render EX_STRING {..} = '"' : render str <> "\"" render EX_NUMBER {..} = either show show num + render EX_META {..} = render meta + render EX_META_TAIL {..} = render expr <> " * " <> render meta instance Render ATTRIBUTE where render AT_LABEL {..} = label @@ -150,3 +178,4 @@ render AT_PHI {..} = render phi render AT_LAMBDA {..} = render lambda render AT_DELTA {..} = render delta + render AT_META {..} = render meta diff --git a/src/Rule.hs b/src/Rule.hs --- a/src/Rule.hs +++ b/src/Rule.hs @@ -271,10 +271,6 @@ logDebug "Extra substitutions have been built" pure (catMaybes res) --- @todo #432:30min Fix log for not matched pattern. Right now we print --- the name of the rule if pattern is not matched. It would be better to print --- the pattern itself. To achieve that we should extend CST so it supports meta --- attributes, expressions and so on. Don't forget to remove the puzzle matchProgramWithRule :: Program -> Y.Rule -> RuleContext -> IO [Subst] matchProgramWithRule program rule ctx = let ptn = Y.pattern rule @@ -282,7 +278,7 @@ name = fromMaybe "unknown" (Y.name rule) in if null matched then do - logDebug (printf "Pattern from rule '%s' was not matched" name) + logDebug (printf "Pattern from rule '%s' was not matched:\n%s" name (printExpression' ptn logPrintConfig)) pure [] else do when' <- meetMaybeCondition (Y.when rule) matched ctx diff --git a/test/CLISpec.hs b/test/CLISpec.hs --- a/test/CLISpec.hs +++ b/test/CLISpec.hs @@ -181,6 +181,24 @@ ["rewrite", "--omit-comments", "--output=phi"] ["--omit-comments"] + it "with --expression and --output != latex" $ + withStdin "{[[]]}" $ + testCLIFailed + ["rewrite", "--expression=foo", "--output=phi"] + ["--expression option can stay together with --output=latex only"] + + it "with --label and --output != latex" $ + withStdin "{[[]]}" $ + testCLIFailed + ["rewrite", "--label=foo", "--output=phi"] + ["--label option can stay together with --output=latex only"] + + it "with wrong --hide option" $ + withStdin "{[[]]}" $ + testCLIFailed + ["rewrite", "--hide=Q.x(Q.y)"] + ["[ERROR]: Invalid set of arguments: Only dispatch expression", "but given: Φ.x( Φ.y )"] + it "saves steps to dir with --steps-dir" $ do let dir = "test-steps-temp" dirExists <- doesDirectoryExist dir @@ -253,20 +271,21 @@ ["", ""] it "rewrites as LaTeX" $ - withStdin "Q -> [[ x -> QQ.z(y -> 5), q -> T, w -> $, ^ -> Q, @ -> 1, y -> \"H$@^M\"]]" $ + withStdin "Q -> [[ x_o -> QQ.z(y -> 5), q$ -> T, w -> $, ^ -> Q, @ -> 1, y -> \"H$@^M\", L> Fu_nc ]]" $ testCLISucceeded ["rewrite", "--output=latex", "--sweet"] [ "\\begin{phiquation}", - "{[[", - " |x| -> QQ.|z|(", - " |y| -> 5", - " ),", - " |q| -> T,", - " |w| -> $,", - " ^ -> Q,", - " @ -> 1,", - " |y| -> \"H$@^M\"", - "]]}", + "\\Big\\{[[\n", + " |x\\char95{}o| -> QQ.|z|(\n", + " |y| -> 5\n", + " ),\n", + " |q\\char36{}| -> T,\n", + " |w| -> $,\n", + " ^ -> Q,\n", + " @ -> 1,\n", + " |y| -> \"H$@^M\",\n", + " L> |Fu\\char95{}nc|\n", + "]]\\Big\\}", "\\end{phiquation}" ] @@ -275,10 +294,28 @@ testCLISucceeded ["rewrite", "--output=latex", "--sweet", "--nonumber", "--flat"] [ "\\begin{phiquation*}", - "{[[ |x| -> 5 ]]}", + "\\Big\\{[[ |x| -> 5 ]]\\Big\\}", "\\end{phiquation*}" ] + it "rewrite as LaTeX with expression name" $ + withStdin "Q -> [[ x -> 5 ]]" $ + testCLISucceeded + ["rewrite", "--output=latex", "--sweet", "--flat", "--expression=foo"] + [ "\\begin{phiquation}", + "\\phiExpression{foo} \\Big\\{[[ |x| -> 5 ]]\\Big\\}", + "\\end{phiquation}" + ] + + it "rewrite as LaTeX with label name" $ + withStdin "Q -> [[ x -> 5 ]]" $ + testCLISucceeded + ["rewrite", "--output=latex", "--sweet", "--flat", "--label=foo"] + [ "\\begin{phiquation}\n\\label{foo}\n", + "\\Big\\{[[ |x| -> 5 ]]\\Big\\}\n", + "\\end{phiquation}" + ] + it "rewrites with XMIR as input" $ withStdin "" $ testCLISucceeded @@ -338,9 +375,9 @@ ] [ unlines [ "\\begin{phiquation}", - "{[[ |x| -> \"foo\" ]]} \\leadsto_{\\nameref{r:first}}", - " \\leadsto {Q.|x|( |y| -> \"foo\" )} \\leadsto_{\\nameref{r:second}}", - " \\leadsto {[[ |x| -> \"foo\" ]]}", + "\\Big\\{[[ |x| -> \"foo\" ]]\\Big\\} \\leadsto_{\\nameref{r:first}}", + " \\leadsto \\Big\\{Q.|x|( |y| -> \"foo\" )\\Big\\} \\leadsto_{\\nameref{r:second}}", + " \\leadsto \\Big\\{[[ |x| -> \"foo\" ]]\\Big\\}", "\\end{phiquation}" ] ] @@ -443,6 +480,18 @@ "⟧}" ] ] + + it "hides default package" $ + withStdin "{[[ org -> [[ eolang -> [[ number -> [[]] ]]]], x -> 42 ]]}" $ + testCLISucceeded + ["rewrite", "--sweet", "--flat", "--hide=Q.org"] + ["{⟦ x ↦ 42 ⟧}"] + + it "hides several FQNs" $ + withStdin "{[[ org -> [[ eolang -> Q.x, yegor256 -> Q.y ]], x -> 42 ]]}" $ + testCLISucceeded + ["rewrite", "--sweet", "--flat", "--hide=Q.org.eolang", "--hide=Q.org.yegor256"] + ["{⟦ org ↦ ⟦⟧, x ↦ 42 ⟧}"] it "prints in line with --flat" $ withStdin "Q -> [[ x -> 5, y -> \"hey\", z -> [[ w -> [[ ]] ]] ]]" $ diff --git a/test/CSTSpec.hs b/test/CSTSpec.hs --- a/test/CSTSpec.hs +++ b/test/CSTSpec.hs @@ -33,9 +33,10 @@ spec = do describe "builds valid CST" $ forM_ - [ ("Q -> Q", PR_SWEET (EX_GLOBAL Φ)), + [ ("Q -> Q", PR_SWEET LCB (EX_GLOBAL Φ) RCB), ( "{[[ x -> Q.y ]]}", PR_SWEET + LCB ( EX_FORMATION LSB EOL @@ -45,6 +46,7 @@ (TAB 0) RSB ) + RCB ) ] ( \(prog, cst) -> it prog $ do diff --git a/test/HideSpec.hs b/test/HideSpec.hs new file mode 100644 --- /dev/null +++ b/test/HideSpec.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE RecordWildCards #-} +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} + +-- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com +-- SPDX-License-Identifier: MIT + +module HideSpec where + +import Control.Monad +import Data.Aeson +import Data.Yaml qualified as Yaml +import GHC.Generics (Generic) +import Hide (hide) +import Misc +import Parser (parseExpressionThrows, parseProgramThrows) +import Rewriter +import System.FilePath +import Test.Hspec +import Yaml (normalizationRules) + +data YamlPack = YamlPack + { program :: String, + hidden :: String, + result :: String + } + deriving (Generic, Show, FromJSON) + +yamlPack :: FilePath -> IO YamlPack +yamlPack = Yaml.decodeFileThrow + +spec :: Spec +spec = + describe "hide packs" $ do + let resources = "test-resources/hide-packs" + rule = head normalizationRules + packs <- runIO (allPathsIn resources) + + forM_ + packs + ( \pth -> it (makeRelative resources pth) $ do + YamlPack {..} <- yamlPack pth + prog <- parseProgramThrows program + expr <- parseExpressionThrows hidden + res <- parseProgramThrows result + let [Rewritten {program = prog'}] = hide [Rewritten prog (Just rule)] [expr] + prog' `shouldBe` res + )