{- |
Description: Examples for edit patterns used in our evaluation.
License: GNU LGPLv3
Maintainer: paul.bittner@uni-ulm.de

This module provides 'Example's to reproduce each edit pattern we inspected in the evaluation
of feature trace recording (Section 5 in our paper).
As each pattern describes a possible /type/ of edit and not an edit itself, each example shows
one possible instance for a pattern (not the pattern itself as this is not possible).
For some patterns, we thus /have to/ show multiple examples as described in the paper.
Most notably, distinguishing between the case when no feature traces are present (/in general/ case)
and the case when an optional outer scope of the edit code fragment is already mapped to the target feature mapping.
-}
module EditPatterns where

import Example
import SimpleJava
import UUID ( UUID )
import Control.Monad.State ( State )
import System.Terminal
import Feature
import FeatureTrace
import NullPropositions
import FeatureTraceRecording
import FeatureColour
import Edits
import AST
import Propositions
import Tree
import Data.Maybe (fromJust)

-- | A dummy feature that is edited in each example.
-- We name it @m@ (mapping) here according to the variable used in the paper.
feature_m :: Feature
feature_m :: Feature
feature_m = Feature -> Feature
toFeature "m"

-- | Another dummy feature that can be edited.
feature_FOO :: Feature
feature_FOO :: Feature
feature_FOO = Feature -> Feature
toFeature "FOO"

-- | Name for the 'AST' root of each example instance.
-- We use file nodes to represent the roots of the 'AST's.
rootName :: String
rootName :: Feature
rootName = "some file"

-- | Describe the feature mapping of a node with the given name as text.
buildPCName :: String -> FeatureFormula -> String
buildPCName :: Feature -> FeatureFormula -> Feature
buildPCName nodename :: Feature
nodename f :: FeatureFormula
f = " (with \""Feature -> Feature -> Feature
forall a. [a] -> [a] -> [a]
++Feature
nodenameFeature -> Feature -> Feature
forall a. [a] -> [a] -> [a]
++"\" mapped to "Feature -> Feature -> Feature
forall a. [a] -> [a] -> [a]
++(FeatureFormula -> Feature
forall a. Show a => Maybe a -> Feature
NullPropositions.prettyPrint FeatureFormula
f)Feature -> Feature -> Feature
forall a. [a] -> [a] -> [a]
++")"

-- | Colours for features and feature formulas used in the pattern examples.
featurecolours :: MonadColorPrinter m => FeatureFormulaColourPalette m
featurecolours :: FeatureFormulaColourPalette m
featurecolours p :: FeatureFormula
p
    | FeatureFormula
p FeatureFormula -> FeatureFormula -> Bool
forall a. Eq a => a -> a -> Bool
== (PropositionalFormula Feature -> FeatureFormula
forall a. a -> Maybe a
Just (PropositionalFormula Feature -> FeatureFormula)
-> PropositionalFormula Feature -> FeatureFormula
forall a b. (a -> b) -> a -> b
$ PropositionalFormula Feature -> PropositionalFormula Feature
forall a. PropositionalFormula a -> PropositionalFormula a
PNot (PropositionalFormula Feature -> PropositionalFormula Feature)
-> PropositionalFormula Feature -> PropositionalFormula Feature
forall a b. (a -> b) -> a -> b
$ Feature -> PropositionalFormula Feature
forall a. a -> PropositionalFormula a
PVariable (Feature -> PropositionalFormula Feature)
-> Feature -> PropositionalFormula Feature
forall a b. (a -> b) -> a -> b
$ Feature
feature_m) = Color m
forall (m :: * -> *). MonadColorPrinter m => Color m
magenta
    | FeatureFormula
p FeatureFormula -> FeatureFormula -> Bool
forall a. Eq a => a -> a -> Bool
== (PropositionalFormula Feature -> FeatureFormula
forall a. a -> Maybe a
Just (PropositionalFormula Feature -> FeatureFormula)
-> PropositionalFormula Feature -> FeatureFormula
forall a b. (a -> b) -> a -> b
$ Feature -> PropositionalFormula Feature
forall a. a -> PropositionalFormula a
PVariable (Feature -> PropositionalFormula Feature)
-> Feature -> PropositionalFormula Feature
forall a b. (a -> b) -> a -> b
$ Feature
feature_m) = Color m
forall (m :: * -> *). MonadColorPrinter m => Color m
green
    | FeatureFormula
p FeatureFormula -> FeatureFormula -> Bool
forall a. Eq a => a -> a -> Bool
== (PropositionalFormula Feature -> FeatureFormula
forall a. a -> Maybe a
Just (PropositionalFormula Feature -> FeatureFormula)
-> PropositionalFormula Feature -> FeatureFormula
forall a b. (a -> b) -> a -> b
$ Feature -> PropositionalFormula Feature
forall a. a -> PropositionalFormula a
PVariable (Feature -> PropositionalFormula Feature)
-> Feature -> PropositionalFormula Feature
forall a b. (a -> b) -> a -> b
$ Feature
feature_FOO) = Color m
forall (m :: * -> *). MonadColorPrinter m => Color m
yellow
    | Bool
otherwise = Color m
forall (m :: * -> *). MonadColorPrinter m => Color m
white

-- | 'AST' representing an empty file.
emptyfile :: State UUID SSJavaAST
emptyfile :: State UUID SSJavaAST
emptyfile = Tree (StateT UUID Identity (Node SimpleJavaGrammar Feature))
-> State UUID SSJavaAST
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Tree (StateT UUID Identity (Node SimpleJavaGrammar Feature))
 -> State UUID SSJavaAST)
-> Tree (StateT UUID Identity (Node SimpleJavaGrammar Feature))
-> State UUID SSJavaAST
forall a b. (a -> b) -> a -> b
$ Feature
-> [Tree (StateT UUID Identity (Node SimpleJavaGrammar Feature))]
-> Tree (StateT UUID Identity (Node SimpleJavaGrammar Feature))
sjava_file Feature
rootName []

-- | 'AST' representing the source code in the /then/ branch of a preprocessor annotation.
code_then :: State UUID SSJavaAST
code_then :: State UUID SSJavaAST
code_then = Tree (StateT UUID Identity (Node SimpleJavaGrammar Feature))
-> State UUID SSJavaAST
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Tree (StateT UUID Identity (Node SimpleJavaGrammar Feature))
 -> State UUID SSJavaAST)
-> Tree (StateT UUID Identity (Node SimpleJavaGrammar Feature))
-> State UUID SSJavaAST
forall a b. (a -> b) -> a -> b
$ Tree (StateT UUID Identity (Node SimpleJavaGrammar Feature))
-> Tree (StateT UUID Identity (Node SimpleJavaGrammar Feature))
sjava_exprstatement (Tree (StateT UUID Identity (Node SimpleJavaGrammar Feature))
 -> Tree (StateT UUID Identity (Node SimpleJavaGrammar Feature)))
-> Tree (StateT UUID Identity (Node SimpleJavaGrammar Feature))
-> Tree (StateT UUID Identity (Node SimpleJavaGrammar Feature))
forall a b. (a -> b) -> a -> b
$ Feature
-> [Tree (StateT UUID Identity (Node SimpleJavaGrammar Feature))]
-> Tree (StateT UUID Identity (Node SimpleJavaGrammar Feature))
sjava_funccall "codeThenCase" []

-- | 'AST' representing the source code in the /else/ branch of a preprocessor annotation.
code_else :: State UUID SSJavaAST
code_else :: State UUID SSJavaAST
code_else = Tree (StateT UUID Identity (Node SimpleJavaGrammar Feature))
-> State UUID SSJavaAST
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Tree (StateT UUID Identity (Node SimpleJavaGrammar Feature))
 -> State UUID SSJavaAST)
-> Tree (StateT UUID Identity (Node SimpleJavaGrammar Feature))
-> State UUID SSJavaAST
forall a b. (a -> b) -> a -> b
$ Tree (StateT UUID Identity (Node SimpleJavaGrammar Feature))
-> Tree (StateT UUID Identity (Node SimpleJavaGrammar Feature))
sjava_exprstatement (Tree (StateT UUID Identity (Node SimpleJavaGrammar Feature))
 -> Tree (StateT UUID Identity (Node SimpleJavaGrammar Feature)))
-> Tree (StateT UUID Identity (Node SimpleJavaGrammar Feature))
-> Tree (StateT UUID Identity (Node SimpleJavaGrammar Feature))
forall a b. (a -> b) -> a -> b
$ Feature
-> [Tree (StateT UUID Identity (Node SimpleJavaGrammar Feature))]
-> Tree (StateT UUID Identity (Node SimpleJavaGrammar Feature))
sjava_funccall "codeElseCase" []

-- | 'AST' representing a method 'void foo()'.
somefunction :: State UUID SSJavaAST
somefunction :: State UUID SSJavaAST
somefunction = Tree (StateT UUID Identity (Node SimpleJavaGrammar Feature))
-> State UUID SSJavaAST
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Tree (StateT UUID Identity (Node SimpleJavaGrammar Feature))
 -> State UUID SSJavaAST)
-> Tree (StateT UUID Identity (Node SimpleJavaGrammar Feature))
-> State UUID SSJavaAST
forall a b. (a -> b) -> a -> b
$ Feature
-> Feature
-> [(Feature, Feature)]
-> [Tree (StateT UUID Identity (Node SimpleJavaGrammar Feature))]
-> Tree (StateT UUID Identity (Node SimpleJavaGrammar Feature))
sjava_methoddef "void" "foo" [] []

{- |
Create an 'Example' for a specific pattern.
Calls 'createPatternExampleWithStartTrace' and defaults its first argument to an empty feature trace that assigns /null/ to every node ('emptyTrace').
-}
createPatternExample :: (MonadColorPrinter m) => String -> SSJavaAST -> History SimpleJavaGrammar String -> Example m SimpleJavaGrammar String
createPatternExample :: Feature
-> SSJavaAST
-> History SimpleJavaGrammar Feature
-> Example m SimpleJavaGrammar Feature
createPatternExample = FeatureTrace SimpleJavaGrammar Feature
-> Feature
-> SSJavaAST
-> History SimpleJavaGrammar Feature
-> Example m SimpleJavaGrammar Feature
forall (m :: * -> *).
MonadColorPrinter m =>
FeatureTrace SimpleJavaGrammar Feature
-> Feature
-> SSJavaAST
-> History SimpleJavaGrammar Feature
-> Example m SimpleJavaGrammar Feature
createPatternExampleWithStartTrace FeatureTrace SimpleJavaGrammar Feature
forall g a. FeatureTrace g a
emptyTrace

{-
Create an 'Example' for a specific pattern.
Arguments are
* the initial feature trace (e.g., 'emptyTrace'),
* the name of the pattern,
* the 'AST' that represents the initial version of the source code, and
* a sequence of edits to apply to the given 'AST' when running the example.
-}
createPatternExampleWithStartTrace :: (MonadColorPrinter m) => FeatureTrace SimpleJavaGrammar String -> String -> SSJavaAST -> History SimpleJavaGrammar String -> Example m SimpleJavaGrammar String
createPatternExampleWithStartTrace :: FeatureTrace SimpleJavaGrammar Feature
-> Feature
-> SSJavaAST
-> History SimpleJavaGrammar Feature
-> Example m SimpleJavaGrammar Feature
createPatternExampleWithStartTrace startTrace :: FeatureTrace SimpleJavaGrammar Feature
startTrace name :: Feature
name start :: SSJavaAST
start edits :: History SimpleJavaGrammar Feature
edits =
    Example :: forall (m :: * -> *) g a.
Feature
-> Version g a
-> History g a
-> FeatureFormulaColourPalette m
-> Example m g a
Example {
        name :: Feature
Example.name = Feature
name,
        colours :: FeatureFormulaColourPalette m
colours = FeatureFormulaColourPalette m
forall (m :: * -> *).
MonadColorPrinter m =>
FeatureFormulaColourPalette m
featurecolours,
        startVersion :: Version SimpleJavaGrammar Feature
startVersion = (FeatureTrace SimpleJavaGrammar Feature
startTrace, SSJavaAST
start),
        history :: History SimpleJavaGrammar Feature
history = History SimpleJavaGrammar Feature
edits
    }

{- |
'Example' instance of the /AddIfdef/ pattern in general case.
-}
addIfdef :: (MonadColorPrinter m) => State UUID (Example m SimpleJavaGrammar String)
addIfdef :: State UUID (Example m SimpleJavaGrammar Feature)
addIfdef = do
    SSJavaAST
start <- State UUID SSJavaAST
emptyfile
    SSJavaAST
lcd <- State UUID SSJavaAST
code_then
    Example m SimpleJavaGrammar Feature
-> State UUID (Example m SimpleJavaGrammar Feature)
forall (m :: * -> *) a. Monad m => a -> m a
return (Example m SimpleJavaGrammar Feature
 -> State UUID (Example m SimpleJavaGrammar Feature))
-> Example m SimpleJavaGrammar Feature
-> State UUID (Example m SimpleJavaGrammar Feature)
forall a b. (a -> b) -> a -> b
$ Feature
-> SSJavaAST
-> History SimpleJavaGrammar Feature
-> Example m SimpleJavaGrammar Feature
forall (m :: * -> *).
MonadColorPrinter m =>
Feature
-> SSJavaAST
-> History SimpleJavaGrammar Feature
-> Example m SimpleJavaGrammar Feature
createPatternExample "AddIfdef (general case)" SSJavaAST
start
        [(SSJavaAST -> UUID -> UUID -> Edit SimpleJavaGrammar Feature
forall a g. Eq a => AST g a -> UUID -> UUID -> Edit g a
edit_ins_tree SSJavaAST
lcd (SSJavaAST -> UUID
forall g a. AST g a -> UUID
uuidOf SSJavaAST
start) 0, PropositionalFormula Feature -> FeatureFormula
forall a. a -> Maybe a
Just (PropositionalFormula Feature -> FeatureFormula)
-> PropositionalFormula Feature -> FeatureFormula
forall a b. (a -> b) -> a -> b
$ Feature -> PropositionalFormula Feature
forall a. a -> PropositionalFormula a
PVariable Feature
feature_m)]

{- |
'Example' instance of the /AddIfdef/ pattern when an outer optional scope is already mapped to the target feature mapping.
-}
addIfdefWithPC :: (MonadColorPrinter m) => State UUID (Example m SimpleJavaGrammar String)
addIfdefWithPC :: State UUID (Example m SimpleJavaGrammar Feature)
addIfdefWithPC = do
    Example m SimpleJavaGrammar Feature
plainAddIfdef <- State UUID (Example m SimpleJavaGrammar Feature)
forall (m :: * -> *).
MonadColorPrinter m =>
State UUID (Example m SimpleJavaGrammar Feature)
addIfdef
    let (startTrace :: FeatureTrace SimpleJavaGrammar Feature
startTrace, startAST :: SSJavaAST
startAST) = Example m SimpleJavaGrammar Feature
-> Version SimpleJavaGrammar Feature
forall (m :: * -> *) g a. Example m g a -> Version g a
startVersion Example m SimpleJavaGrammar Feature
plainAddIfdef
        fileNode :: Node SimpleJavaGrammar Feature
fileNode = SSJavaAST -> Node SimpleJavaGrammar Feature
forall a. Tree a -> a
element (SSJavaAST -> Node SimpleJavaGrammar Feature)
-> SSJavaAST -> Node SimpleJavaGrammar Feature
forall a b. (a -> b) -> a -> b
$ Maybe SSJavaAST -> SSJavaAST
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe SSJavaAST -> SSJavaAST) -> Maybe SSJavaAST -> SSJavaAST
forall a b. (a -> b) -> a -> b
$ SimpleJavaGrammar -> SSJavaAST -> Maybe SSJavaAST
forall g a. Eq g => g -> AST g a -> Maybe (AST g a)
findByGrammarType SimpleJavaGrammar
SJava_File SSJavaAST
startAST
        ultraFormula :: FeatureFormula
ultraFormula = PropositionalFormula Feature -> FeatureFormula
forall a. a -> Maybe a
Just (PropositionalFormula Feature -> FeatureFormula)
-> PropositionalFormula Feature -> FeatureFormula
forall a b. (a -> b) -> a -> b
$ Feature -> PropositionalFormula Feature
forall a. a -> PropositionalFormula a
PVariable Feature
feature_m
    Example m SimpleJavaGrammar Feature
-> State UUID (Example m SimpleJavaGrammar Feature)
forall (m :: * -> *) a. Monad m => a -> m a
return (Example m SimpleJavaGrammar Feature
 -> State UUID (Example m SimpleJavaGrammar Feature))
-> Example m SimpleJavaGrammar Feature
-> State UUID (Example m SimpleJavaGrammar Feature)
forall a b. (a -> b) -> a -> b
$ Example m SimpleJavaGrammar Feature
plainAddIfdef{
        name :: Feature
Example.name = "AddIfdef"Feature -> Feature -> Feature
forall a. [a] -> [a] -> [a]
++(Feature -> FeatureFormula -> Feature
buildPCName (Node SimpleJavaGrammar Feature -> Feature
forall g a. Node g a -> a
value Node SimpleJavaGrammar Feature
fileNode) FeatureFormula
ultraFormula),
        startVersion :: Version SimpleJavaGrammar Feature
startVersion = (\v :: Node SimpleJavaGrammar Feature
v -> if Node SimpleJavaGrammar Feature
v Node SimpleJavaGrammar Feature
-> Node SimpleJavaGrammar Feature -> Bool
forall a. Eq a => a -> a -> Bool
== Node SimpleJavaGrammar Feature
fileNode then FeatureFormula
ultraFormula else (FeatureTrace SimpleJavaGrammar Feature
startTrace Node SimpleJavaGrammar Feature
v), SSJavaAST
startAST),
        history :: History SimpleJavaGrammar Feature
history = (\(edit :: Edit SimpleJavaGrammar Feature
edit, fc :: FeatureFormula
fc) -> (Edit SimpleJavaGrammar Feature
edit, FeatureFormula
forall a. Maybe a
Nothing)) ((Edit SimpleJavaGrammar Feature, FeatureFormula)
 -> (Edit SimpleJavaGrammar Feature, FeatureFormula))
-> History SimpleJavaGrammar Feature
-> History SimpleJavaGrammar Feature
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Example m SimpleJavaGrammar Feature
-> History SimpleJavaGrammar Feature
forall (m :: * -> *) g a. Example m g a -> History g a
history Example m SimpleJavaGrammar Feature
plainAddIfdef
    }

{- |
'Example' instance of the /AddIfdefElse/ pattern in general case.
As /AddIfdefElse/ has to be reproduced using two variants, we need two different examples here, one for the /then/-branch and one for the /else/-branch.
This is the 'Example' of the /then/ branch.
-}
addIfdefElse_IfBranch :: (MonadColorPrinter m) => State UUID (Example m SimpleJavaGrammar String)
addIfdefElse_IfBranch :: State UUID (Example m SimpleJavaGrammar Feature)
addIfdefElse_IfBranch = State UUID (Example m SimpleJavaGrammar Feature)
forall (m :: * -> *).
MonadColorPrinter m =>
State UUID (Example m SimpleJavaGrammar Feature)
addIfdef State UUID (Example m SimpleJavaGrammar Feature)
-> (Example m SimpleJavaGrammar Feature
    -> State UUID (Example m SimpleJavaGrammar Feature))
-> State UUID (Example m SimpleJavaGrammar Feature)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ifbranch :: Example m SimpleJavaGrammar Feature
ifbranch -> Example m SimpleJavaGrammar Feature
-> State UUID (Example m SimpleJavaGrammar Feature)
forall (m :: * -> *) a. Monad m => a -> m a
return Example m SimpleJavaGrammar Feature
ifbranch {name :: Feature
Example.name = "AddIfdefElse (if branch) (general case)"}

{- |
'Example' instance of the /AddIfdefElse/ pattern when an outer optional scope is already mapped to the target feature mapping.
As /AddIfdefElse/ has to be reproduced using two variants, we need two different examples here, one for the /then/-branch and one for the /else/-branch.
This is the 'Example' of the /then/ branch.
-}
addIfdefElse_IfBranchWithPC :: (MonadColorPrinter m) => State UUID (Example m SimpleJavaGrammar String)
addIfdefElse_IfBranchWithPC :: State UUID (Example m SimpleJavaGrammar Feature)
addIfdefElse_IfBranchWithPC = State UUID (Example m SimpleJavaGrammar Feature)
forall (m :: * -> *).
MonadColorPrinter m =>
State UUID (Example m SimpleJavaGrammar Feature)
addIfdefWithPC State UUID (Example m SimpleJavaGrammar Feature)
-> (Example m SimpleJavaGrammar Feature
    -> State UUID (Example m SimpleJavaGrammar Feature))
-> State UUID (Example m SimpleJavaGrammar Feature)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ifbranch :: Example m SimpleJavaGrammar Feature
ifbranch -> Example m SimpleJavaGrammar Feature
-> State UUID (Example m SimpleJavaGrammar Feature)
forall (m :: * -> *) a. Monad m => a -> m a
return Example m SimpleJavaGrammar Feature
ifbranch {name :: Feature
Example.name = "AddIfdefElse (if branch)"Feature -> Feature -> Feature
forall a. [a] -> [a] -> [a]
++(Feature -> FeatureFormula -> Feature
buildPCName Feature
rootName (FeatureFormula -> Feature) -> FeatureFormula -> Feature
forall a b. (a -> b) -> a -> b
$ PropositionalFormula Feature -> FeatureFormula
forall a. a -> Maybe a
Just (PropositionalFormula Feature -> FeatureFormula)
-> PropositionalFormula Feature -> FeatureFormula
forall a b. (a -> b) -> a -> b
$ Feature -> PropositionalFormula Feature
forall a. a -> PropositionalFormula a
PVariable Feature
feature_m)}

{- |
'Example' instance of the /AddIfdefElse/ pattern in general case.
As /AddIfdefElse/ has to be reproduced using two variants, we need two different examples here, one for the /then/-branch and one for the /else/-branch.
This is the 'Example' of the /else/ branch.
-}
addIfdefElse_ElseBranch :: (MonadColorPrinter m) => State UUID (Example m SimpleJavaGrammar String)
addIfdefElse_ElseBranch :: State UUID (Example m SimpleJavaGrammar Feature)
addIfdefElse_ElseBranch = do
    SSJavaAST
start <- State UUID SSJavaAST
emptyfile
    SSJavaAST
alert <- State UUID SSJavaAST
code_else
    Example m SimpleJavaGrammar Feature
-> State UUID (Example m SimpleJavaGrammar Feature)
forall (m :: * -> *) a. Monad m => a -> m a
return (Example m SimpleJavaGrammar Feature
 -> State UUID (Example m SimpleJavaGrammar Feature))
-> Example m SimpleJavaGrammar Feature
-> State UUID (Example m SimpleJavaGrammar Feature)
forall a b. (a -> b) -> a -> b
$ Feature
-> SSJavaAST
-> History SimpleJavaGrammar Feature
-> Example m SimpleJavaGrammar Feature
forall (m :: * -> *).
MonadColorPrinter m =>
Feature
-> SSJavaAST
-> History SimpleJavaGrammar Feature
-> Example m SimpleJavaGrammar Feature
createPatternExample "AddIfdefElse (else branch) (general case)" SSJavaAST
start
        [(SSJavaAST -> UUID -> UUID -> Edit SimpleJavaGrammar Feature
forall a g. Eq a => AST g a -> UUID -> UUID -> Edit g a
edit_ins_tree SSJavaAST
alert (SSJavaAST -> UUID
forall g a. AST g a -> UUID
uuidOf SSJavaAST
start) 0, PropositionalFormula Feature -> FeatureFormula
forall a. a -> Maybe a
Just (PropositionalFormula Feature -> FeatureFormula)
-> PropositionalFormula Feature -> FeatureFormula
forall a b. (a -> b) -> a -> b
$ PropositionalFormula Feature -> PropositionalFormula Feature
forall a. PropositionalFormula a -> PropositionalFormula a
PNot (PropositionalFormula Feature -> PropositionalFormula Feature)
-> PropositionalFormula Feature -> PropositionalFormula Feature
forall a b. (a -> b) -> a -> b
$ Feature -> PropositionalFormula Feature
forall a. a -> PropositionalFormula a
PVariable Feature
feature_m)]

{- |
'Example' instance of the /AddIfdefElse/ pattern when an outer optional scope is already mapped to the target feature mapping.
As /AddIfdefElse/ has to be reproduced using two variants, we need two different examples here, one for the /then/-branch and one for the /else/-branch.
This is the 'Example' of the /else/ branch.
-}
addIfdefElse_ElseBranchWithPC :: (MonadColorPrinter m) => State UUID (Example m SimpleJavaGrammar String)
addIfdefElse_ElseBranchWithPC :: State UUID (Example m SimpleJavaGrammar Feature)
addIfdefElse_ElseBranchWithPC = do
    SSJavaAST
start <- State UUID SSJavaAST
emptyfile
    SSJavaAST
alert <- State UUID SSJavaAST
code_else
    let context :: FeatureFormula
context = PropositionalFormula Feature -> FeatureFormula
forall a. a -> Maybe a
Just (PropositionalFormula Feature -> FeatureFormula)
-> PropositionalFormula Feature -> FeatureFormula
forall a b. (a -> b) -> a -> b
$ PropositionalFormula Feature -> PropositionalFormula Feature
forall a. PropositionalFormula a -> PropositionalFormula a
PNot (PropositionalFormula Feature -> PropositionalFormula Feature)
-> PropositionalFormula Feature -> PropositionalFormula Feature
forall a b. (a -> b) -> a -> b
$ Feature -> PropositionalFormula Feature
forall a. a -> PropositionalFormula a
PVariable Feature
feature_m
    Example m SimpleJavaGrammar Feature
-> State UUID (Example m SimpleJavaGrammar Feature)
forall (m :: * -> *) a. Monad m => a -> m a
return (Example m SimpleJavaGrammar Feature
 -> State UUID (Example m SimpleJavaGrammar Feature))
-> Example m SimpleJavaGrammar Feature
-> State UUID (Example m SimpleJavaGrammar Feature)
forall a b. (a -> b) -> a -> b
$ FeatureTrace SimpleJavaGrammar Feature
-> Feature
-> SSJavaAST
-> History SimpleJavaGrammar Feature
-> Example m SimpleJavaGrammar Feature
forall (m :: * -> *).
MonadColorPrinter m =>
FeatureTrace SimpleJavaGrammar Feature
-> Feature
-> SSJavaAST
-> History SimpleJavaGrammar Feature
-> Example m SimpleJavaGrammar Feature
createPatternExampleWithStartTrace
        (\v :: Node SimpleJavaGrammar Feature
v -> if Node SimpleJavaGrammar Feature
v Node SimpleJavaGrammar Feature
-> Node SimpleJavaGrammar Feature -> Bool
forall a. Eq a => a -> a -> Bool
== (SSJavaAST -> Node SimpleJavaGrammar Feature
forall a. Tree a -> a
element SSJavaAST
start) then FeatureFormula
context else FeatureFormula
forall a. Maybe a
Nothing)
        ("AddIfdefElse (else branch)"Feature -> Feature -> Feature
forall a. [a] -> [a] -> [a]
++(Feature -> FeatureFormula -> Feature
buildPCName (Node SimpleJavaGrammar Feature -> Feature
forall g a. Node g a -> a
value (Node SimpleJavaGrammar Feature -> Feature)
-> Node SimpleJavaGrammar Feature -> Feature
forall a b. (a -> b) -> a -> b
$ SSJavaAST -> Node SimpleJavaGrammar Feature
forall a. Tree a -> a
element SSJavaAST
start) FeatureFormula
context))
        SSJavaAST
start
        [(SSJavaAST -> UUID -> UUID -> Edit SimpleJavaGrammar Feature
forall a g. Eq a => AST g a -> UUID -> UUID -> Edit g a
edit_ins_tree SSJavaAST
alert (SSJavaAST -> UUID
forall g a. AST g a -> UUID
uuidOf SSJavaAST
start) 0, FeatureFormula
forall a. Maybe a
Nothing)]

{- |
'Example' instance of the /AddIfdefWrapElse/ pattern.
-}
addIfdefWrapElse :: (MonadColorPrinter m) => State UUID (Example m SimpleJavaGrammar String)
addIfdefWrapElse :: State UUID (Example m SimpleJavaGrammar Feature)
addIfdefWrapElse = do
    SSJavaAST
file <- State UUID SSJavaAST
emptyfile
    SSJavaAST
lcd <- State UUID SSJavaAST
code_then
    SSJavaAST
alert <- State UUID SSJavaAST
code_else
    -- The start tree already has the alert line in it.
    let start :: SSJavaAST
start = (Edit SimpleJavaGrammar Feature -> SSJavaAST -> SSJavaAST
forall g a. Edit g a -> AST g a -> AST g a
run (Edit SimpleJavaGrammar Feature -> SSJavaAST -> SSJavaAST)
-> Edit SimpleJavaGrammar Feature -> SSJavaAST -> SSJavaAST
forall a b. (a -> b) -> a -> b
$ SSJavaAST -> UUID -> UUID -> Edit SimpleJavaGrammar Feature
forall a g. Eq a => AST g a -> UUID -> UUID -> Edit g a
edit_ins_tree SSJavaAST
alert (SSJavaAST -> UUID
forall g a. AST g a -> UUID
uuidOf SSJavaAST
file) 0) SSJavaAST
file in
        Example m SimpleJavaGrammar Feature
-> State UUID (Example m SimpleJavaGrammar Feature)
forall (m :: * -> *) a. Monad m => a -> m a
return (Example m SimpleJavaGrammar Feature
 -> State UUID (Example m SimpleJavaGrammar Feature))
-> Example m SimpleJavaGrammar Feature
-> State UUID (Example m SimpleJavaGrammar Feature)
forall a b. (a -> b) -> a -> b
$ Feature
-> SSJavaAST
-> History SimpleJavaGrammar Feature
-> Example m SimpleJavaGrammar Feature
forall (m :: * -> *).
MonadColorPrinter m =>
Feature
-> SSJavaAST
-> History SimpleJavaGrammar Feature
-> Example m SimpleJavaGrammar Feature
createPatternExample "AddIfdefWrapElse" SSJavaAST
start
        (History SimpleJavaGrammar Feature
 -> Example m SimpleJavaGrammar Feature)
-> History SimpleJavaGrammar Feature
-> Example m SimpleJavaGrammar Feature
forall a b. (a -> b) -> a -> b
$ [Edit SimpleJavaGrammar Feature]
-> [FeatureFormula] -> History SimpleJavaGrammar Feature
forall a b. [a] -> [b] -> [(a, b)]
zip [
            UUID -> Edit SimpleJavaGrammar Feature
forall a g. Eq a => UUID -> Edit g a
edit_del_tree (UUID -> Edit SimpleJavaGrammar Feature)
-> UUID -> Edit SimpleJavaGrammar Feature
forall a b. (a -> b) -> a -> b
$ SSJavaAST -> UUID
forall g a. AST g a -> UUID
uuidOf SSJavaAST
alert,
            SSJavaAST -> UUID -> UUID -> Edit SimpleJavaGrammar Feature
forall a g. Eq a => AST g a -> UUID -> UUID -> Edit g a
edit_ins_tree SSJavaAST
lcd (SSJavaAST -> UUID
forall g a. AST g a -> UUID
uuidOf SSJavaAST
file) 0
        ]
        [
            PropositionalFormula Feature -> FeatureFormula
forall a. a -> Maybe a
Just (PropositionalFormula Feature -> FeatureFormula)
-> PropositionalFormula Feature -> FeatureFormula
forall a b. (a -> b) -> a -> b
$ Feature -> PropositionalFormula Feature
forall a. a -> PropositionalFormula a
PVariable Feature
feature_m,
            PropositionalFormula Feature -> FeatureFormula
forall a. a -> Maybe a
Just (PropositionalFormula Feature -> FeatureFormula)
-> PropositionalFormula Feature -> FeatureFormula
forall a b. (a -> b) -> a -> b
$ Feature -> PropositionalFormula Feature
forall a. a -> PropositionalFormula a
PVariable Feature
feature_m
        ]

{- |
'Example' instance of the /AddIfdefWrapThen/ pattern.
-}
addIfdefWrapThen :: (MonadColorPrinter m) => State UUID (Example m SimpleJavaGrammar String)
addIfdefWrapThen :: State UUID (Example m SimpleJavaGrammar Feature)
addIfdefWrapThen = do
    SSJavaAST
file <- State UUID SSJavaAST
emptyfile
    SSJavaAST
lcd <- State UUID SSJavaAST
code_then
    SSJavaAST
alert <- State UUID SSJavaAST
code_else
    -- The start tree already has the alert line in it.
    let start :: SSJavaAST
start = (Edit SimpleJavaGrammar Feature -> SSJavaAST -> SSJavaAST
forall g a. Edit g a -> AST g a -> AST g a
run (Edit SimpleJavaGrammar Feature -> SSJavaAST -> SSJavaAST)
-> Edit SimpleJavaGrammar Feature -> SSJavaAST -> SSJavaAST
forall a b. (a -> b) -> a -> b
$ SSJavaAST -> UUID -> UUID -> Edit SimpleJavaGrammar Feature
forall a g. Eq a => AST g a -> UUID -> UUID -> Edit g a
edit_ins_tree SSJavaAST
lcd (SSJavaAST -> UUID
forall g a. AST g a -> UUID
uuidOf SSJavaAST
file) 0) SSJavaAST
file in
        Example m SimpleJavaGrammar Feature
-> State UUID (Example m SimpleJavaGrammar Feature)
forall (m :: * -> *) a. Monad m => a -> m a
return (Example m SimpleJavaGrammar Feature
 -> State UUID (Example m SimpleJavaGrammar Feature))
-> Example m SimpleJavaGrammar Feature
-> State UUID (Example m SimpleJavaGrammar Feature)
forall a b. (a -> b) -> a -> b
$ Feature
-> SSJavaAST
-> History SimpleJavaGrammar Feature
-> Example m SimpleJavaGrammar Feature
forall (m :: * -> *).
MonadColorPrinter m =>
Feature
-> SSJavaAST
-> History SimpleJavaGrammar Feature
-> Example m SimpleJavaGrammar Feature
createPatternExample "AddIfdefWrapThen" SSJavaAST
start
        (History SimpleJavaGrammar Feature
 -> Example m SimpleJavaGrammar Feature)
-> History SimpleJavaGrammar Feature
-> Example m SimpleJavaGrammar Feature
forall a b. (a -> b) -> a -> b
$ [Edit SimpleJavaGrammar Feature]
-> [FeatureFormula] -> History SimpleJavaGrammar Feature
forall a b. [a] -> [b] -> [(a, b)]
zip [
            UUID -> Edit SimpleJavaGrammar Feature
forall a g. Eq a => UUID -> Edit g a
edit_del_tree (UUID -> Edit SimpleJavaGrammar Feature)
-> UUID -> Edit SimpleJavaGrammar Feature
forall a b. (a -> b) -> a -> b
$ SSJavaAST -> UUID
forall g a. AST g a -> UUID
uuidOf SSJavaAST
lcd,
            SSJavaAST -> UUID -> UUID -> Edit SimpleJavaGrammar Feature
forall a g. Eq a => AST g a -> UUID -> UUID -> Edit g a
edit_ins_tree SSJavaAST
alert (SSJavaAST -> UUID
forall g a. AST g a -> UUID
uuidOf SSJavaAST
file) 0
        ]
        [
            PropositionalFormula Feature -> FeatureFormula
forall a. a -> Maybe a
Just (PropositionalFormula Feature -> FeatureFormula)
-> PropositionalFormula Feature -> FeatureFormula
forall a b. (a -> b) -> a -> b
$ PropositionalFormula Feature -> PropositionalFormula Feature
forall a. PropositionalFormula a -> PropositionalFormula a
PNot (PropositionalFormula Feature -> PropositionalFormula Feature)
-> PropositionalFormula Feature -> PropositionalFormula Feature
forall a b. (a -> b) -> a -> b
$ Feature -> PropositionalFormula Feature
forall a. a -> PropositionalFormula a
PVariable Feature
feature_m,
            PropositionalFormula Feature -> FeatureFormula
forall a. a -> Maybe a
Just (PropositionalFormula Feature -> FeatureFormula)
-> PropositionalFormula Feature -> FeatureFormula
forall a b. (a -> b) -> a -> b
$ PropositionalFormula Feature -> PropositionalFormula Feature
forall a. PropositionalFormula a -> PropositionalFormula a
PNot (PropositionalFormula Feature -> PropositionalFormula Feature)
-> PropositionalFormula Feature -> PropositionalFormula Feature
forall a b. (a -> b) -> a -> b
$ Feature -> PropositionalFormula Feature
forall a. a -> PropositionalFormula a
PVariable Feature
feature_m
        ]

{- |
'Example' instance of the /AddNormalCode/ pattern where non-variational code is added (code mapped to /true/).
-}
addNormalCode_nonvariational :: (MonadColorPrinter m) => State UUID (Example m SimpleJavaGrammar String)
addNormalCode_nonvariational :: State UUID (Example m SimpleJavaGrammar Feature)
addNormalCode_nonvariational = do
    SSJavaAST
start <- State UUID SSJavaAST
emptyfile
    SSJavaAST
lcd <- State UUID SSJavaAST
code_then
    Example m SimpleJavaGrammar Feature
-> State UUID (Example m SimpleJavaGrammar Feature)
forall (m :: * -> *) a. Monad m => a -> m a
return (Example m SimpleJavaGrammar Feature
 -> State UUID (Example m SimpleJavaGrammar Feature))
-> Example m SimpleJavaGrammar Feature
-> State UUID (Example m SimpleJavaGrammar Feature)
forall a b. (a -> b) -> a -> b
$ Feature
-> SSJavaAST
-> History SimpleJavaGrammar Feature
-> Example m SimpleJavaGrammar Feature
forall (m :: * -> *).
MonadColorPrinter m =>
Feature
-> SSJavaAST
-> History SimpleJavaGrammar Feature
-> Example m SimpleJavaGrammar Feature
createPatternExample "AddNormalCode (non-variable)" SSJavaAST
start
        [(SSJavaAST -> UUID -> UUID -> Edit SimpleJavaGrammar Feature
forall a g. Eq a => AST g a -> UUID -> UUID -> Edit g a
edit_ins_tree SSJavaAST
lcd (SSJavaAST -> UUID
forall g a. AST g a -> UUID
uuidOf SSJavaAST
start) 0, PropositionalFormula Feature -> FeatureFormula
forall a. a -> Maybe a
Just PropositionalFormula Feature
forall a. PropositionalFormula a
PTrue)]

{- |
'Example' instance of the /AddNormalCode/ pattern when an outer optional scope is already mapped to the target feature mapping.
-}
addNormalCode_outerpc :: (MonadColorPrinter m) => State UUID (Example m SimpleJavaGrammar String)
addNormalCode_outerpc :: State UUID (Example m SimpleJavaGrammar Feature)
addNormalCode_outerpc = do
    SSJavaAST
file <- State UUID SSJavaAST
emptyfile
    SSJavaAST
foo <- State UUID SSJavaAST
somefunction
    SSJavaAST
lcd <- State UUID SSJavaAST
code_then
    let
        outer_pc :: FeatureFormula
outer_pc = PropositionalFormula Feature -> FeatureFormula
forall a. a -> Maybe a
Just (PropositionalFormula Feature -> FeatureFormula)
-> PropositionalFormula Feature -> FeatureFormula
forall a b. (a -> b) -> a -> b
$ Feature -> PropositionalFormula Feature
forall a. a -> PropositionalFormula a
PVariable Feature
feature_FOO
        start :: SSJavaAST
start = (Edit SimpleJavaGrammar Feature -> SSJavaAST -> SSJavaAST
forall g a. Edit g a -> AST g a -> AST g a
run (Edit SimpleJavaGrammar Feature -> SSJavaAST -> SSJavaAST)
-> Edit SimpleJavaGrammar Feature -> SSJavaAST -> SSJavaAST
forall a b. (a -> b) -> a -> b
$ SSJavaAST -> UUID -> UUID -> Edit SimpleJavaGrammar Feature
forall a g. Eq a => AST g a -> UUID -> UUID -> Edit g a
edit_ins_tree SSJavaAST
foo (SSJavaAST -> UUID
forall g a. AST g a -> UUID
uuidOf SSJavaAST
file) 0) SSJavaAST
file
        statementsOfFoo :: UUID
statementsOfFoo = SSJavaAST -> UUID
forall g a. AST g a -> UUID
uuidOf (SSJavaAST -> UUID)
-> (Maybe SSJavaAST -> SSJavaAST) -> Maybe SSJavaAST -> UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe SSJavaAST -> SSJavaAST
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe SSJavaAST -> UUID) -> Maybe SSJavaAST -> UUID
forall a b. (a -> b) -> a -> b
$ SimpleJavaGrammar -> SSJavaAST -> Maybe SSJavaAST
forall g a. Eq g => g -> AST g a -> Maybe (AST g a)
findByGrammarType SimpleJavaGrammar
SJava_Statements SSJavaAST
foo
        in
        Example m SimpleJavaGrammar Feature
-> State UUID (Example m SimpleJavaGrammar Feature)
forall (m :: * -> *) a. Monad m => a -> m a
return (Example m SimpleJavaGrammar Feature
 -> State UUID (Example m SimpleJavaGrammar Feature))
-> Example m SimpleJavaGrammar Feature
-> State UUID (Example m SimpleJavaGrammar Feature)
forall a b. (a -> b) -> a -> b
$ FeatureTrace SimpleJavaGrammar Feature
-> Feature
-> SSJavaAST
-> History SimpleJavaGrammar Feature
-> Example m SimpleJavaGrammar Feature
forall (m :: * -> *).
MonadColorPrinter m =>
FeatureTrace SimpleJavaGrammar Feature
-> Feature
-> SSJavaAST
-> History SimpleJavaGrammar Feature
-> Example m SimpleJavaGrammar Feature
createPatternExampleWithStartTrace
            -- change the start trace so that there is already a trace
            (\n :: Node SimpleJavaGrammar Feature
n -> if Node SimpleJavaGrammar Feature
n Node SimpleJavaGrammar Feature
-> Node SimpleJavaGrammar Feature -> Bool
forall a. Eq a => a -> a -> Bool
== SSJavaAST -> Node SimpleJavaGrammar Feature
forall a. Tree a -> a
element SSJavaAST
foo then FeatureFormula
outer_pc else FeatureFormula
forall a. Maybe a
Nothing)
            "AddNormalCode (with outer PC)"
            SSJavaAST
start
            -- Here, any feature context would be feasible that is weaker than outer_pc (e.g., outer_pc itself).
            [(SSJavaAST -> UUID -> UUID -> Edit SimpleJavaGrammar Feature
forall a g. Eq a => AST g a -> UUID -> UUID -> Edit g a
edit_ins_tree SSJavaAST
lcd UUID
statementsOfFoo 0, PropositionalFormula Feature -> FeatureFormula
forall a. a -> Maybe a
Just PropositionalFormula Feature
forall a. PropositionalFormula a
PTrue)]
            
{- |
'Example' instance of the /RemNormalCode/ pattern when no feature traces are present initially.
-}
remNormalCode_null :: (MonadColorPrinter m) => State UUID (Example m SimpleJavaGrammar String)
remNormalCode_null :: State UUID (Example m SimpleJavaGrammar Feature)
remNormalCode_null = do
    SSJavaAST
file <- State UUID SSJavaAST
emptyfile
    SSJavaAST
lcd <- State UUID SSJavaAST
code_then
    let start :: SSJavaAST
start = (Edit SimpleJavaGrammar Feature -> SSJavaAST -> SSJavaAST
forall g a. Edit g a -> AST g a -> AST g a
run (Edit SimpleJavaGrammar Feature -> SSJavaAST -> SSJavaAST)
-> Edit SimpleJavaGrammar Feature -> SSJavaAST -> SSJavaAST
forall a b. (a -> b) -> a -> b
$ SSJavaAST -> UUID -> UUID -> Edit SimpleJavaGrammar Feature
forall a g. Eq a => AST g a -> UUID -> UUID -> Edit g a
edit_ins_tree SSJavaAST
lcd (SSJavaAST -> UUID
forall g a. AST g a -> UUID
uuidOf SSJavaAST
file) 0) SSJavaAST
file in
        Example m SimpleJavaGrammar Feature
-> State UUID (Example m SimpleJavaGrammar Feature)
forall (m :: * -> *) a. Monad m => a -> m a
return (Example m SimpleJavaGrammar Feature
 -> State UUID (Example m SimpleJavaGrammar Feature))
-> Example m SimpleJavaGrammar Feature
-> State UUID (Example m SimpleJavaGrammar Feature)
forall a b. (a -> b) -> a -> b
$ Feature
-> SSJavaAST
-> History SimpleJavaGrammar Feature
-> Example m SimpleJavaGrammar Feature
forall (m :: * -> *).
MonadColorPrinter m =>
Feature
-> SSJavaAST
-> History SimpleJavaGrammar Feature
-> Example m SimpleJavaGrammar Feature
createPatternExample "RemNormalCode (without traces)" SSJavaAST
start
            [(UUID -> Edit SimpleJavaGrammar Feature
forall a g. Eq a => UUID -> Edit g a
edit_del_tree (SSJavaAST -> UUID
forall g a. AST g a -> UUID
uuidOf SSJavaAST
lcd), PropositionalFormula Feature -> FeatureFormula
forall a. a -> Maybe a
Just PropositionalFormula Feature
forall a. PropositionalFormula a
PTrue)]

{- |
'Example' instance of the /RemNormalCode/ pattern when feature traces are present initally.
-}
remNormalCode_notnull :: (MonadColorPrinter m) => State UUID (Example m SimpleJavaGrammar String)
remNormalCode_notnull :: State UUID (Example m SimpleJavaGrammar Feature)
remNormalCode_notnull = do
    SSJavaAST
file <- State UUID SSJavaAST
emptyfile
    SSJavaAST
lcd <- State UUID SSJavaAST
code_then
    let 
        start :: SSJavaAST
start = (Edit SimpleJavaGrammar Feature -> SSJavaAST -> SSJavaAST
forall g a. Edit g a -> AST g a -> AST g a
run (Edit SimpleJavaGrammar Feature -> SSJavaAST -> SSJavaAST)
-> Edit SimpleJavaGrammar Feature -> SSJavaAST -> SSJavaAST
forall a b. (a -> b) -> a -> b
$ SSJavaAST -> UUID -> UUID -> Edit SimpleJavaGrammar Feature
forall a g. Eq a => AST g a -> UUID -> UUID -> Edit g a
edit_ins_tree SSJavaAST
lcd (SSJavaAST -> UUID
forall g a. AST g a -> UUID
uuidOf SSJavaAST
file) 0) SSJavaAST
file
        existingtrace :: FeatureFormula
existingtrace = PropositionalFormula Feature -> FeatureFormula
forall a. a -> Maybe a
Just (PropositionalFormula Feature -> FeatureFormula)
-> PropositionalFormula Feature -> FeatureFormula
forall a b. (a -> b) -> a -> b
$ Feature -> PropositionalFormula Feature
forall a. a -> PropositionalFormula a
PVariable Feature
feature_m
        in
        Example m SimpleJavaGrammar Feature
-> State UUID (Example m SimpleJavaGrammar Feature)
forall (m :: * -> *) a. Monad m => a -> m a
return (Example m SimpleJavaGrammar Feature
 -> State UUID (Example m SimpleJavaGrammar Feature))
-> Example m SimpleJavaGrammar Feature
-> State UUID (Example m SimpleJavaGrammar Feature)
forall a b. (a -> b) -> a -> b
$ FeatureTrace SimpleJavaGrammar Feature
-> Feature
-> SSJavaAST
-> History SimpleJavaGrammar Feature
-> Example m SimpleJavaGrammar Feature
forall (m :: * -> *).
MonadColorPrinter m =>
FeatureTrace SimpleJavaGrammar Feature
-> Feature
-> SSJavaAST
-> History SimpleJavaGrammar Feature
-> Example m SimpleJavaGrammar Feature
createPatternExampleWithStartTrace
            (\n :: Node SimpleJavaGrammar Feature
n -> if Node SimpleJavaGrammar Feature
n Node SimpleJavaGrammar Feature
-> Node SimpleJavaGrammar Feature -> Bool
forall a. Eq a => a -> a -> Bool
== SSJavaAST -> Node SimpleJavaGrammar Feature
forall a. Tree a -> a
element SSJavaAST
lcd then FeatureFormula
existingtrace else FeatureFormula
forall a. Maybe a
Nothing)
            "RemNormalCode (with trace)"
            SSJavaAST
start
            [(UUID -> Edit SimpleJavaGrammar Feature
forall a g. Eq a => UUID -> Edit g a
edit_del_tree (SSJavaAST -> UUID
forall g a. AST g a -> UUID
uuidOf SSJavaAST
lcd), FeatureFormula
forall a. Maybe a
Nothing {-null-})]

{- |
'Example' instance of the /RemIfdef/ pattern.
This behaves the same as 'remNormalCode_notnull'.
-}
remIfdef :: (MonadColorPrinter m) => State UUID (Example m SimpleJavaGrammar String)
remIfdef :: State UUID (Example m SimpleJavaGrammar Feature)
remIfdef = State UUID (Example m SimpleJavaGrammar Feature)
forall (m :: * -> *).
MonadColorPrinter m =>
State UUID (Example m SimpleJavaGrammar Feature)
remNormalCode_notnull State UUID (Example m SimpleJavaGrammar Feature)
-> (Example m SimpleJavaGrammar Feature
    -> State UUID (Example m SimpleJavaGrammar Feature))
-> State UUID (Example m SimpleJavaGrammar Feature)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \r :: Example m SimpleJavaGrammar Feature
r -> Example m SimpleJavaGrammar Feature
-> State UUID (Example m SimpleJavaGrammar Feature)
forall (m :: * -> *) a. Monad m => a -> m a
return Example m SimpleJavaGrammar Feature
r {name :: Feature
Example.name = "RemIfdef"}