{- |
Description: Motivating Example: Simulating propagation of Alice's edits on Stack.pop to Bob's clone
License: GNU LGPLv3
Maintainer: paul.bittner@uni-ulm.de

Module for reproducing Bob's part of our motivating 'example'.
Bob propagates applicable edits by Alice to his variant.
The example is described in detail in Section 2.2 of the paper and shown in Figure 3.
-}
module StackPopBob where

import StackPopAlice ( feature_ImmutableStack, example )

import UUID ( UUID )
import Example ( Example(..) )
import Edits ( Edit(delta), foldEditScript, edit_trace_only )
import Propositions ( PropositionalFormula(..) )
import SimpleJava ( SimpleJavaGrammar )
import FeatureColour
import FeatureTrace

import System.Terminal
import Control.Monad.State ( State ) 

{- |
Colours for features and feature formulas used in this example.
We chose terminal colours as close the the colours used in the paper as possible.
-}
featureColourPalette :: (MonadColorPrinter m) => FeatureFormulaColourPalette m -> FeatureFormulaColourPalette m
featureColourPalette :: FeatureFormulaColourPalette m -> FeatureFormulaColourPalette m
featureColourPalette fallback :: FeatureFormulaColourPalette m
fallback formula :: FeatureFormula
formula 
    | FeatureFormula
formula 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_ImmutableStack) = Color m
forall (m :: * -> *). MonadColorPrinter m => Color m
magenta
    | Bool
otherwise = FeatureFormulaColourPalette m
fallback FeatureFormula
formula

{- |
Example replaying our Bob's part of our motivating example shown in Figure 3 and described in Section 2.2 in our paper.
Bob propagates Alice's changes on the @pop@ method to his variant.
This example directly reuses the first two edits of Alice and appends an artifical noop edit ('edit_trace_only') to update the feature mappings
that were recorded upon Alice's edits that were not applicable to Bob's variant but induced further feature mappings.
-}
example :: MonadColorPrinter m => State UUID (Example m SimpleJavaGrammar String)
example :: State UUID (Example m SimpleJavaGrammar Feature)
example =
    State UUID (Example m SimpleJavaGrammar Feature)
forall (m :: * -> *).
MonadColorPrinter m =>
State UUID (Example m SimpleJavaGrammar Feature)
StackPopAlice.example
    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
>>= \alice :: Example m SimpleJavaGrammar Feature
alice ->
        let numEditsToSynchronise :: UUID
numEditsToSynchronise = 2
            deleteThatUpdatesBobsTrace :: UUID
deleteThatUpdatesBobsTrace = 2
            startVersion :: (FeatureTrace SimpleJavaGrammar Feature,
 AST SimpleJavaGrammar Feature)
startVersion@(startTrace :: FeatureTrace SimpleJavaGrammar Feature
startTrace, startTree :: AST SimpleJavaGrammar Feature
startTree) = Example m SimpleJavaGrammar Feature
-> (FeatureTrace SimpleJavaGrammar Feature,
    AST SimpleJavaGrammar Feature)
forall (m :: * -> *) g a. Example m g a -> Version g a
Example.startVersion Example m SimpleJavaGrammar Feature
alice
            alicesEdits :: History SimpleJavaGrammar Feature
alicesEdits = Example m SimpleJavaGrammar Feature
-> History SimpleJavaGrammar Feature
forall (m :: * -> *) g a. Example m g a -> History g a
history Example m SimpleJavaGrammar Feature
alice
            alicesEditsToSyncDirectly :: History SimpleJavaGrammar Feature
alicesEditsToSyncDirectly = UUID
-> History SimpleJavaGrammar Feature
-> History SimpleJavaGrammar Feature
forall a. UUID -> [a] -> [a]
take UUID
numEditsToSynchronise History SimpleJavaGrammar Feature
alicesEdits
            popVersion3 :: AST SimpleJavaGrammar Feature
popVersion3 = EditScript SimpleJavaGrammar Feature
-> AST SimpleJavaGrammar Feature -> AST SimpleJavaGrammar Feature
forall g a. EditScript g a -> AST g a -> AST g a
foldEditScript ((Edit SimpleJavaGrammar Feature, FeatureFormula)
-> Edit SimpleJavaGrammar Feature
forall a b. (a, b) -> a
fst ((Edit SimpleJavaGrammar Feature, FeatureFormula)
 -> Edit SimpleJavaGrammar Feature)
-> History SimpleJavaGrammar Feature
-> EditScript SimpleJavaGrammar Feature
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> History SimpleJavaGrammar Feature
alicesEditsToSyncDirectly) AST SimpleJavaGrammar Feature
startTree
            in
        Example m SimpleJavaGrammar Feature
-> State UUID (Example m SimpleJavaGrammar Feature)
forall (m :: * -> *) a. Monad m => a -> m a
return Example :: forall (m :: * -> *) g a.
Feature
-> Version g a
-> History g a
-> FeatureFormulaColourPalette m
-> Example m g a
Example {
            name :: Feature
Example.name = "Motivating Example: Simulating propagation of Alice's edits on Stack.pop to Bob's clone",
            colours :: FeatureFormulaColourPalette m
Example.colours = FeatureFormulaColourPalette m -> FeatureFormulaColourPalette m
forall (m :: * -> *).
MonadColorPrinter m =>
FeatureFormulaColourPalette m -> FeatureFormulaColourPalette m
StackPopBob.featureColourPalette (FeatureFormulaColourPalette m -> FeatureFormulaColourPalette m)
-> FeatureFormulaColourPalette m -> FeatureFormulaColourPalette m
forall a b. (a -> b) -> a -> b
$ Example m SimpleJavaGrammar Feature
-> FeatureFormulaColourPalette m
forall (m :: * -> *) g a.
Example m g a -> FeatureFormulaColourPalette m
colours Example m SimpleJavaGrammar Feature
alice,
            startVersion :: (FeatureTrace SimpleJavaGrammar Feature,
 AST SimpleJavaGrammar Feature)
Example.startVersion = (FeatureTrace SimpleJavaGrammar Feature,
 AST SimpleJavaGrammar Feature)
startVersion,
            history :: History SimpleJavaGrammar Feature
Example.history = 
                History SimpleJavaGrammar Feature
alicesEditsToSyncDirectlyHistory SimpleJavaGrammar Feature
-> History SimpleJavaGrammar Feature
-> History SimpleJavaGrammar Feature
forall a. [a] -> [a] -> [a]
++
                [(Set (Node SimpleJavaGrammar Feature)
-> Edit SimpleJavaGrammar Feature
forall g a. Set (Node g a) -> Edit g a
edit_trace_only (Set (Node SimpleJavaGrammar Feature)
 -> Edit SimpleJavaGrammar Feature)
-> Set (Node SimpleJavaGrammar Feature)
-> Edit SimpleJavaGrammar Feature
forall a b. (a -> b) -> a -> b
$ Edit SimpleJavaGrammar Feature
-> AST SimpleJavaGrammar Feature
-> Set (Node SimpleJavaGrammar Feature)
forall g a. Edit g a -> AST g a -> Set (Node g a)
delta ((Edit SimpleJavaGrammar Feature, FeatureFormula)
-> Edit SimpleJavaGrammar Feature
forall a b. (a, b) -> a
fst ((Edit SimpleJavaGrammar Feature, FeatureFormula)
 -> Edit SimpleJavaGrammar Feature)
-> (Edit SimpleJavaGrammar Feature, FeatureFormula)
-> Edit SimpleJavaGrammar Feature
forall a b. (a -> b) -> a -> b
$ History SimpleJavaGrammar Feature
alicesEdits History SimpleJavaGrammar Feature
-> UUID -> (Edit SimpleJavaGrammar Feature, FeatureFormula)
forall a. [a] -> UUID -> a
!! UUID
deleteThatUpdatesBobsTrace) AST SimpleJavaGrammar Feature
popVersion3, 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_ImmutableStack)]
        }