{- |
Description: Module of the @main@ function to run demos and print meta-information.
License: GNU LGPLv3
Maintainer: paul.bittner@uni-ulm.de

Module of the @main@ function to run demos and print meta-information.
-}
module Main where

import Control.Monad.State ( State )

import UUID ( UUID )
import Util (removeQuotes,  genIndent )
import Tree ( prettyPrint )
import AST
import Grammar
import ASTPrettyPrinter
import Edits ( edit_identity )
import Logic
import Propositions
import NullPropositions 
import FeatureTrace 
import FeatureTraceRecording
import FeatureColour (FeatureFormulaColourPalette)
import Example
import TikzExport ( astToTikzWithTraceDefault )

import StackPopAlice (example)
import StackPopBob (example)
import EditPatterns

import Data.List (intercalate)

-- imports for Terminal printing ---------
import Data.Text.Prettyprint.Doc
    ( Doc, (<+>), annotate, hardline, Pretty(pretty) )
import System.Terminal
import Truthtable (generatetruthtablesfor)

-- | Style defining how to print 'AST's.
data CodePrintStyle
    = ShowAST  -- ^ Prints the 'AST' by showing each 'Node' in the hierarchy in an XML-like format.
    | ShowCode -- ^ Prints the 'AST' as the actual source code that it represents.
    | ShowTikz -- ^ Print the 'AST' as tikz code to use for our paper.
    deriving (Int -> CodePrintStyle -> ShowS
[CodePrintStyle] -> ShowS
CodePrintStyle -> String
(Int -> CodePrintStyle -> ShowS)
-> (CodePrintStyle -> String)
-> ([CodePrintStyle] -> ShowS)
-> Show CodePrintStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CodePrintStyle] -> ShowS
$cshowList :: [CodePrintStyle] -> ShowS
show :: CodePrintStyle -> String
$cshow :: CodePrintStyle -> String
showsPrec :: Int -> CodePrintStyle -> ShowS
$cshowsPrec :: Int -> CodePrintStyle -> ShowS
Show)
-- | Format defining whether to 'FeatureTrace's or presence conditions ('pc').
data TraceDisplay
    = Trace -- ^ Show the feature mapping of each node (i.e., the formula a node is directly annotated with).
    | PC    -- ^ Show the presence condition of each node (i.e., the conjunction of its feature mapping with all feature mappings inherited from ancestors).
    deriving (Int -> TraceDisplay -> ShowS
[TraceDisplay] -> ShowS
TraceDisplay -> String
(Int -> TraceDisplay -> ShowS)
-> (TraceDisplay -> String)
-> ([TraceDisplay] -> ShowS)
-> Show TraceDisplay
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TraceDisplay] -> ShowS
$cshowList :: [TraceDisplay] -> ShowS
show :: TraceDisplay -> String
$cshow :: TraceDisplay -> String
showsPrec :: Int -> TraceDisplay -> ShowS
$cshowsPrec :: Int -> TraceDisplay -> ShowS
Show, TraceDisplay -> TraceDisplay -> Bool
(TraceDisplay -> TraceDisplay -> Bool)
-> (TraceDisplay -> TraceDisplay -> Bool) -> Eq TraceDisplay
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TraceDisplay -> TraceDisplay -> Bool
$c/= :: TraceDisplay -> TraceDisplay -> Bool
== :: TraceDisplay -> TraceDisplay -> Bool
$c== :: TraceDisplay -> TraceDisplay -> Bool
Eq)
-- | Style defining how to print 'FeatureTrace's.
data TraceStyle
    = Text   -- ^ Show feature mapping formulas as plain text.
    | Colour -- ^ Encode features as colours to visualize feature mappings by colouring source code.
    | None   -- ^ Do not show feature traces at all.
    deriving (Int -> TraceStyle -> ShowS
[TraceStyle] -> ShowS
TraceStyle -> String
(Int -> TraceStyle -> ShowS)
-> (TraceStyle -> String)
-> ([TraceStyle] -> ShowS)
-> Show TraceStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TraceStyle] -> ShowS
$cshowList :: [TraceStyle] -> ShowS
show :: TraceStyle -> String
$cshow :: TraceStyle -> String
showsPrec :: Int -> TraceStyle -> ShowS
$cshowsPrec :: Int -> TraceStyle -> ShowS
Show, TraceStyle -> TraceStyle -> Bool
(TraceStyle -> TraceStyle -> Bool)
-> (TraceStyle -> TraceStyle -> Bool) -> Eq TraceStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TraceStyle -> TraceStyle -> Bool
$c/= :: TraceStyle -> TraceStyle -> Bool
== :: TraceStyle -> TraceStyle -> Bool
$c== :: TraceStyle -> TraceStyle -> Bool
Eq)

{- |
Format in which code and (recorded) feature mappings should be printed to the terminal.
-}
data OutputFormat = OutputFormat {
    OutputFormat -> CodePrintStyle
codeStyle :: CodePrintStyle,
    OutputFormat -> TraceDisplay
traceDisplay :: TraceDisplay,
    OutputFormat -> TraceStyle
traceStyle :: TraceStyle,
    OutputFormat -> Bool
withTraceLines :: Bool -- ^ Whether there should be vertical lines next to the shown code on the left that indicate presence condtions.
}

-- Some presets for output formats:

{- |
The perspective of the developer, who is editing code while traces are recorded in the background
This is the format used in the figures in the paper.
-}
userFormat :: OutputFormat
userFormat :: OutputFormat
userFormat = OutputFormat :: CodePrintStyle
-> TraceDisplay -> TraceStyle -> Bool -> OutputFormat
OutputFormat {
    codeStyle :: CodePrintStyle
codeStyle = CodePrintStyle
ShowCode,
    traceDisplay :: TraceDisplay
traceDisplay = TraceDisplay
PC,
    traceStyle :: TraceStyle
traceStyle = TraceStyle
Colour,
    withTraceLines :: Bool
withTraceLines = Bool
False
}

{- |
A variation of 'userFormat' where traces and presence conditions can be investigated seperately at the same time.
Code is coloured in the colour of its trace while presence conditions are indicated by coloured lines on the left.
-}
userFormatDetailed :: OutputFormat
userFormatDetailed :: OutputFormat
userFormatDetailed = OutputFormat :: CodePrintStyle
-> TraceDisplay -> TraceStyle -> Bool -> OutputFormat
OutputFormat {
    codeStyle :: CodePrintStyle
codeStyle = CodePrintStyle
ShowCode,
    traceDisplay :: TraceDisplay
traceDisplay = TraceDisplay
Trace,
    traceStyle :: TraceStyle
traceStyle = TraceStyle
Colour,
    withTraceLines :: Bool
withTraceLines = Bool
True
}

{- |
Shows the 'AST' of the source code with 'FeatureTrace's as formulas.
-}
astFormat :: OutputFormat
astFormat :: OutputFormat
astFormat = OutputFormat :: CodePrintStyle
-> TraceDisplay -> TraceStyle -> Bool -> OutputFormat
OutputFormat {
    codeStyle :: CodePrintStyle
codeStyle = CodePrintStyle
ShowAST,
    traceDisplay :: TraceDisplay
traceDisplay = TraceDisplay
Trace,
    traceStyle :: TraceStyle
traceStyle = TraceStyle
Text,
    withTraceLines :: Bool
withTraceLines = Bool
False
}

{- |
Tikz export of 'AST' with 'FeatureTrace's.
Used for figures in the paper.
-}
tikzFormat :: OutputFormat
tikzFormat :: OutputFormat
tikzFormat = OutputFormat :: CodePrintStyle
-> TraceDisplay -> TraceStyle -> Bool -> OutputFormat
OutputFormat {
    codeStyle :: CodePrintStyle
codeStyle = CodePrintStyle
ShowTikz,
    traceDisplay :: TraceDisplay
traceDisplay = TraceDisplay
Trace,
    traceStyle :: TraceStyle
traceStyle = TraceStyle
None,
    withTraceLines :: Bool
withTraceLines = Bool
False
}
        
{- |
Entry point of the demo.
The main method will run and print the output of all examples (Alice, Bob, and the edit patterns).
You can change the format of the printed source code and feature mappings by changing the @format@ parameter inside 'main'.
Additionally, you might want to look at the truthtable of the ternary logic by Sobocinski we use (by uncommenting the line @showTruthtables@).
-}
main :: IO ()
main :: IO ()
main =
    {-
    Select your OutputFormat here.
    Above, there is a list of presets you can choose from.
    -}
    let format :: OutputFormat
format = OutputFormat
userFormat in
    do
        OutputFormat -> IO ()
showExamples OutputFormat
format
        -- showTruthtables

{- |
Runs the motivating example from the paper and examples for all edit patterns with the given 'OutputFormat'.
First, runs Alice's example where she records feature traces upon editing the pop method of a class Stack in Java (Figure 1 in the paper).
Second, shows how Bob could propagate Alice's edits and recorded feature traces to his variant as envisioned in future research.
Third, shows an instance of each edit pattern from our evaluation.
-}
showExamples :: OutputFormat -> IO ()
showExamples :: OutputFormat -> IO ()
showExamples format :: OutputFormat
format = (LocalTerminal -> IO ()) -> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
(LocalTerminal -> m a) -> m a
withTerminal ((LocalTerminal -> IO ()) -> IO ())
-> (LocalTerminal -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ TerminalT LocalTerminal IO () -> LocalTerminal -> IO ()
forall (m :: * -> *) t a.
(MonadIO m, MonadMask m, Terminal t) =>
TerminalT t m a -> t -> m a
runTerminalT (TerminalT LocalTerminal IO () -> LocalTerminal -> IO ())
-> TerminalT LocalTerminal IO () -> LocalTerminal -> IO ()
forall a b. (a -> b) -> a -> b
$
    let run :: State
  Int (Example (TerminalT LocalTerminal IO) SimpleJavaGrammar String)
-> TerminalT LocalTerminal IO ()
run = OutputFormat
-> State
     Int (Example (TerminalT LocalTerminal IO) SimpleJavaGrammar String)
-> TerminalT LocalTerminal IO ()
forall (m :: * -> *) g.
(MonadColorPrinter m, Grammar g, ASTPrettyPrinter g) =>
OutputFormat -> State Int (Example m g String) -> m ()
runStepwise OutputFormat
format in
    do
        Doc (Attribute (TerminalT LocalTerminal IO))
-> TerminalT LocalTerminal IO ()
forall (m :: * -> *).
MonadMarkupPrinter m =>
Doc (Attribute m) -> m ()
putDoc Doc (Attribute (TerminalT LocalTerminal IO))
forall ann. Doc ann
hardline
        String -> TerminalT LocalTerminal IO ()
forall (m :: * -> *). MonadColorPrinter m => String -> m ()
headline "Running Feature Trace Recording Demo"
        
        String -> TerminalT LocalTerminal IO ()
forall (m :: * -> *). MonadColorPrinter m => String -> m ()
headline ">>> [Motivating Example] <<<"
        State
  Int (Example (TerminalT LocalTerminal IO) SimpleJavaGrammar String)
-> TerminalT LocalTerminal IO ()
run State
  Int (Example (TerminalT LocalTerminal IO) SimpleJavaGrammar String)
forall (m :: * -> *).
MonadColorPrinter m =>
State Int (Example m SimpleJavaGrammar String)
StackPopAlice.example
        State
  Int (Example (TerminalT LocalTerminal IO) SimpleJavaGrammar String)
-> TerminalT LocalTerminal IO ()
run State
  Int (Example (TerminalT LocalTerminal IO) SimpleJavaGrammar String)
forall (m :: * -> *).
MonadColorPrinter m =>
State Int (Example m SimpleJavaGrammar String)
StackPopBob.example
        
        String -> TerminalT LocalTerminal IO ()
forall (m :: * -> *). MonadColorPrinter m => String -> m ()
headline ">>> [Edit Patterns] <<<"
        State
  Int (Example (TerminalT LocalTerminal IO) SimpleJavaGrammar String)
-> TerminalT LocalTerminal IO ()
run State
  Int (Example (TerminalT LocalTerminal IO) SimpleJavaGrammar String)
forall (m :: * -> *).
MonadColorPrinter m =>
State Int (Example m SimpleJavaGrammar String)
EditPatterns.addIfdef
        State
  Int (Example (TerminalT LocalTerminal IO) SimpleJavaGrammar String)
-> TerminalT LocalTerminal IO ()
run State
  Int (Example (TerminalT LocalTerminal IO) SimpleJavaGrammar String)
forall (m :: * -> *).
MonadColorPrinter m =>
State Int (Example m SimpleJavaGrammar String)
EditPatterns.addIfdefWithPC
        -- We omitted AddIfdef* as it is just a repitition of the previous pattern with arbitrary contexts and code fragments.
        -- AddIfDefElse has to be reproduced using two variants.
        -- Hence, we need two different examples here, one for the if-branch and one for the else-branch.
        State
  Int (Example (TerminalT LocalTerminal IO) SimpleJavaGrammar String)
-> TerminalT LocalTerminal IO ()
run State
  Int (Example (TerminalT LocalTerminal IO) SimpleJavaGrammar String)
forall (m :: * -> *).
MonadColorPrinter m =>
State Int (Example m SimpleJavaGrammar String)
EditPatterns.addIfdefElse_IfBranch
        State
  Int (Example (TerminalT LocalTerminal IO) SimpleJavaGrammar String)
-> TerminalT LocalTerminal IO ()
run State
  Int (Example (TerminalT LocalTerminal IO) SimpleJavaGrammar String)
forall (m :: * -> *).
MonadColorPrinter m =>
State Int (Example m SimpleJavaGrammar String)
EditPatterns.addIfdefElse_ElseBranch
        State
  Int (Example (TerminalT LocalTerminal IO) SimpleJavaGrammar String)
-> TerminalT LocalTerminal IO ()
run State
  Int (Example (TerminalT LocalTerminal IO) SimpleJavaGrammar String)
forall (m :: * -> *).
MonadColorPrinter m =>
State Int (Example m SimpleJavaGrammar String)
EditPatterns.addIfdefElse_IfBranchWithPC
        State
  Int (Example (TerminalT LocalTerminal IO) SimpleJavaGrammar String)
-> TerminalT LocalTerminal IO ()
run State
  Int (Example (TerminalT LocalTerminal IO) SimpleJavaGrammar String)
forall (m :: * -> *).
MonadColorPrinter m =>
State Int (Example m SimpleJavaGrammar String)
EditPatterns.addIfdefElse_ElseBranchWithPC
        State
  Int (Example (TerminalT LocalTerminal IO) SimpleJavaGrammar String)
-> TerminalT LocalTerminal IO ()
run State
  Int (Example (TerminalT LocalTerminal IO) SimpleJavaGrammar String)
forall (m :: * -> *).
MonadColorPrinter m =>
State Int (Example m SimpleJavaGrammar String)
EditPatterns.addIfdefWrapElse
        State
  Int (Example (TerminalT LocalTerminal IO) SimpleJavaGrammar String)
-> TerminalT LocalTerminal IO ()
run State
  Int (Example (TerminalT LocalTerminal IO) SimpleJavaGrammar String)
forall (m :: * -> *).
MonadColorPrinter m =>
State Int (Example m SimpleJavaGrammar String)
EditPatterns.addIfdefWrapThen
        -- Adding non-variational code (code that belongs to all clones)
        State
  Int (Example (TerminalT LocalTerminal IO) SimpleJavaGrammar String)
-> TerminalT LocalTerminal IO ()
run State
  Int (Example (TerminalT LocalTerminal IO) SimpleJavaGrammar String)
forall (m :: * -> *).
MonadColorPrinter m =>
State Int (Example m SimpleJavaGrammar String)
EditPatterns.addNormalCode_nonvariational
        -- Adding code without any associated trace into a tree-optional scope that is already traced.
        State
  Int (Example (TerminalT LocalTerminal IO) SimpleJavaGrammar String)
-> TerminalT LocalTerminal IO ()
run State
  Int (Example (TerminalT LocalTerminal IO) SimpleJavaGrammar String)
forall (m :: * -> *).
MonadColorPrinter m =>
State Int (Example m SimpleJavaGrammar String)
EditPatterns.addNormalCode_outerpc
        -- Removing code that does not have a presence condition
        State
  Int (Example (TerminalT LocalTerminal IO) SimpleJavaGrammar String)
-> TerminalT LocalTerminal IO ()
run State
  Int (Example (TerminalT LocalTerminal IO) SimpleJavaGrammar String)
forall (m :: * -> *).
MonadColorPrinter m =>
State Int (Example m SimpleJavaGrammar String)
EditPatterns.remNormalCode_null
        -- Removing code that has a feature trace and thereby a presence condition
        State
  Int (Example (TerminalT LocalTerminal IO) SimpleJavaGrammar String)
-> TerminalT LocalTerminal IO ()
run State
  Int (Example (TerminalT LocalTerminal IO) SimpleJavaGrammar String)
forall (m :: * -> *).
MonadColorPrinter m =>
State Int (Example m SimpleJavaGrammar String)
EditPatterns.remNormalCode_notnull
        -- Removing code that has a feature trace
        State
  Int (Example (TerminalT LocalTerminal IO) SimpleJavaGrammar String)
-> TerminalT LocalTerminal IO ()
run State
  Int (Example (TerminalT LocalTerminal IO) SimpleJavaGrammar String)
forall (m :: * -> *).
MonadColorPrinter m =>
State Int (Example m SimpleJavaGrammar String)
EditPatterns.remIfdef
    

-- | Turns the given text into a headline in the terminal.
-- We indicate headlines with a red background.
headline :: (MonadColorPrinter m) => String -> m()
headline :: String -> m ()
headline text :: String
text = Doc (Attribute m) -> m ()
forall (m :: * -> *).
MonadMarkupPrinter m =>
Doc (Attribute m) -> m ()
putDoc (Doc (Attribute m) -> m ()) -> Doc (Attribute m) -> m ()
forall a b. (a -> b) -> a -> b
$ Doc (Attribute m)
forall ann. Doc ann
hardline Doc (Attribute m) -> Doc (Attribute m) -> Doc (Attribute m)
forall ann. Doc ann -> Doc ann -> Doc ann
<+> (Attribute m -> Doc (Attribute m) -> Doc (Attribute m)
forall ann. ann -> Doc ann -> Doc ann
annotate (Color m -> Attribute m
forall (m :: * -> *). MonadColorPrinter m => Color m -> Attribute m
background Color m
forall (m :: * -> *). MonadColorPrinter m => Color m
red) (Doc (Attribute m) -> Doc (Attribute m))
-> Doc (Attribute m) -> Doc (Attribute m)
forall a b. (a -> b) -> a -> b
$ String -> Doc (Attribute m)
forall a ann. Pretty a => a -> Doc ann
pretty String
text) Doc (Attribute m) -> Doc (Attribute m) -> Doc (Attribute m)
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc (Attribute m)
forall ann. Doc ann
hardline Doc (Attribute m) -> Doc (Attribute m) -> Doc (Attribute m)
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc (Attribute m)
forall ann. Doc ann
hardline

-- | Runs the given 'Example' in the given 'OutputFormat' step by step (i.e., showing all intermediate results).
runStepwise :: (MonadColorPrinter m, Grammar g, ASTPrettyPrinter g) => OutputFormat -> State UUID (Example m g String) -> m ()
runStepwise :: OutputFormat -> State Int (Example m g String) -> m ()
runStepwise format :: OutputFormat
format ex :: State Int (Example m g String)
ex =
    let example :: Example m g String
example = State Int (Example m g String) -> Example m g String
forall (m :: * -> *) g a.
State Int (Example m g a) -> Example m g a
finalizeExample State Int (Example m g String)
ex
        result :: Doc (Attribute m)
result = OutputFormat
-> Example m g String -> [Version g String] -> Doc (Attribute m)
forall (m :: * -> *) g a.
(MonadColorPrinter m, Grammar g, ASTPrettyPrinter g, Show a,
 Eq a) =>
OutputFormat -> Example m g a -> [Version g a] -> Doc (Attribute m)
printTraces OutputFormat
format Example m g String
example (Example m g String -> [Version g String]
forall g a (m :: * -> *).
(Grammar g, Show a, Eq a) =>
Example m g a -> [Version g a]
Example.runExampleWithDefaultFTR Example m g String
example) in
    (Doc (Attribute m) -> m ()
forall (m :: * -> *).
MonadMarkupPrinter m =>
Doc (Attribute m) -> m ()
putDoc (Doc (Attribute m) -> m ()) -> Doc (Attribute m) -> m ()
forall a b. (a -> b) -> a -> b
$ Doc (Attribute m)
result Doc (Attribute m) -> Doc (Attribute m) -> Doc (Attribute m)
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc (Attribute m)
forall ann. Doc ann
hardline) m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
forall (m :: * -> *). MonadPrinter m => m ()
flush

-- | Prints the given 'AST' with the given 'FeatureTrace's in the given 'OutputFormat'.
-- If the 'OutputFormat' mandates to visualize feature mappings as colours (see 'TraceStyle'),
-- the given 'FeatureFormulaColourPalette' will be used to assign colours to feature formulas.
printASTWithTrace :: (MonadColorPrinter m, Grammar g, ASTPrettyPrinter g, Show a, Eq a) =>
    OutputFormat -> FeatureFormulaColourPalette m -> AST g a -> FeatureTrace g a -> Doc (Attribute m)
printASTWithTrace :: OutputFormat
-> FeatureFormulaColourPalette m
-> AST g a
-> FeatureTrace g a
-> Doc (Attribute m)
printASTWithTrace format :: OutputFormat
format featureColourPalette :: FeatureFormulaColourPalette m
featureColourPalette tree :: AST g a
tree trace :: FeatureTrace g a
trace = 
    let 
        codestyle :: CodePrintStyle
codestyle = OutputFormat -> CodePrintStyle
codeStyle OutputFormat
format
        tracestyle :: TraceStyle
tracestyle = OutputFormat -> TraceStyle
traceStyle OutputFormat
format
        tracedisplay :: TraceDisplay
tracedisplay = OutputFormat -> TraceDisplay
traceDisplay OutputFormat
format
        withtracelines :: Bool
withtracelines = OutputFormat -> Bool
withTraceLines OutputFormat
format
        nodePrint :: (Node g a -> FeatureFormula) -> Node g a -> Doc (Attribute m)
nodePrint trace :: Node g a -> FeatureFormula
trace n :: Node g a
n = case TraceStyle
tracestyle of
                        None -> String -> Doc (Attribute m)
forall a ann. Pretty a => a -> Doc ann
pretty(String -> Doc (Attribute m))
-> (a -> String) -> a -> Doc (Attribute m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ShowS
removeQuotesShowS -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> String
forall a. Show a => a -> String
show (a -> Doc (Attribute m)) -> a -> Doc (Attribute m)
forall a b. (a -> b) -> a -> b
$ Node g a -> a
forall g a. Node g a -> a
value Node g a
n
                        Colour -> FeatureFormula -> String -> Doc (Attribute m)
forall a. Pretty a => FeatureFormula -> a -> Doc (Attribute m)
paint (Node g a -> FeatureFormula
trace Node g a
n) (String -> Doc (Attribute m)) -> String -> Doc (Attribute m)
forall a b. (a -> b) -> a -> b
$ ShowS
removeQuotesShowS -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> String
forall a. Show a => a -> String
show (a -> String) -> a -> String
forall a b. (a -> b) -> a -> b
$ Node g a -> a
forall g a. Node g a -> a
value Node g a
n
                        Text -> String -> Doc (Attribute m)
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc (Attribute m)) -> String -> Doc (Attribute m)
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ["<", FeatureFormula -> String
forall a. Show a => Maybe a -> String
NullPropositions.prettyPrint (FeatureFormula -> String) -> FeatureFormula -> String
forall a b. (a -> b) -> a -> b
$ Node g a -> FeatureFormula
trace Node g a
n, ">", ShowS
removeQuotesShowS -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> String
forall a. Show a => a -> String
show (a -> String) -> a -> String
forall a b. (a -> b) -> a -> b
$ Node g a -> a
forall g a. Node g a -> a
value Node g a
n]
        stringPrint :: (t -> FeatureFormula) -> t -> a -> Doc (Attribute m)
stringPrint trace :: t -> FeatureFormula
trace n :: t
n s :: a
s = case TraceStyle
tracestyle of
                        Colour -> FeatureFormula -> a -> Doc (Attribute m)
forall a. Pretty a => FeatureFormula -> a -> Doc (Attribute m)
paint (t -> FeatureFormula
trace t
n) a
s
                        _ -> a -> Doc (Attribute m)
forall a ann. Pretty a => a -> Doc ann
pretty a
s
        indentGenerator :: (Node g a -> FeatureFormula)
-> Node g a -> Int -> Doc (Attribute m)
indentGenerator trace :: Node g a -> FeatureFormula
trace n :: Node g a
n i :: Int
i = if TraceStyle
tracestyle TraceStyle -> TraceStyle -> Bool
forall a. Eq a => a -> a -> Bool
== TraceStyle
Colour Bool -> Bool -> Bool
&& TraceDisplay
tracedisplay TraceDisplay -> TraceDisplay -> Bool
forall a. Eq a => a -> a -> Bool
== TraceDisplay
Trace Bool -> Bool -> Bool
&& Bool
withtracelines Bool -> Bool -> Bool
&& Node g a -> NodeType
forall g a. Grammar g => Node g a -> NodeType
optionaltype Node g a
n NodeType -> NodeType -> Bool
forall a. Eq a => a -> a -> Bool
== NodeType
Optional
                        then Doc (Attribute m) -> Doc (Attribute m) -> Doc (Attribute m)
forall a. Monoid a => a -> a -> a
mappend (FeatureFormula -> String -> Doc (Attribute m)
forall a. Pretty a => FeatureFormula -> a -> Doc (Attribute m)
paint (Node g a -> FeatureFormula
trace Node g a
n) "|") (String -> Doc (Attribute m)
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc (Attribute m)) -> String -> Doc (Attribute m)
forall a b. (a -> b) -> a -> b
$ Int -> String
genIndent (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-1))
                        else String -> Doc (Attribute m)
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc (Attribute m)) -> String -> Doc (Attribute m)
forall a b. (a -> b) -> a -> b
$ Int -> String
genIndent Int
i
        paint :: FeatureFormula -> a -> Doc (Attribute m)
paint formula :: FeatureFormula
formula = (Attribute m -> Doc (Attribute m) -> Doc (Attribute m)
forall ann. ann -> Doc ann -> Doc ann
annotate (Color m -> Attribute m
forall (m :: * -> *). MonadColorPrinter m => Color m -> Attribute m
foreground (Color m -> Attribute m) -> Color m -> Attribute m
forall a b. (a -> b) -> a -> b
$ FeatureFormulaColourPalette m
featureColourPalette FeatureFormula
formula))(Doc (Attribute m) -> Doc (Attribute m))
-> (a -> Doc (Attribute m)) -> a -> Doc (Attribute m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> Doc (Attribute m)
forall a ann. Pretty a => a -> Doc ann
pretty
        in
        case CodePrintStyle
codestyle of
            ShowAST -> (case TraceStyle
tracestyle of
                None -> String -> Doc (Attribute m)
forall a ann. Pretty a => a -> Doc ann
pretty(String -> Doc (Attribute m))
-> (AST g a -> String) -> AST g a -> Doc (Attribute m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AST g a -> String
forall a. Show a => a -> String
show
                Colour -> Int
-> (String -> Doc (Attribute m))
-> (Node g a -> Doc (Attribute m))
-> AST g a
-> Doc (Attribute m)
forall a b.
(Show a, Monoid b) =>
Int -> (String -> b) -> (a -> b) -> Tree a -> b
Tree.prettyPrint 0 String -> Doc (Attribute m)
forall a ann. Pretty a => a -> Doc ann
pretty (\n :: Node g a
n -> FeatureFormula -> String -> Doc (Attribute m)
forall a. Pretty a => FeatureFormula -> a -> Doc (Attribute m)
paint (FeatureTrace g a
trace Node g a
n) (String -> Doc (Attribute m)) -> String -> Doc (Attribute m)
forall a b. (a -> b) -> a -> b
$ Node g a -> String
forall a. Show a => a -> String
show Node g a
n)
                Text -> String -> Doc (Attribute m)
forall a ann. Pretty a => a -> Doc ann
pretty(String -> Doc (Attribute m))
-> (AST g a -> String) -> AST g a -> Doc (Attribute m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(FeatureTrace g a -> AST g a -> String
forall g a.
(Grammar g, Show a) =>
FeatureTrace g a -> AST g a -> String
FeatureTrace.prettyPrint FeatureTrace g a
trace)) AST g a
tree
            ShowTikz -> String -> Doc (Attribute m)
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc (Attribute m)) -> String -> Doc (Attribute m)
forall a b. (a -> b) -> a -> b
$ Version g a -> String
forall a g. (Eq a, Show a, Grammar g) => Version g a -> String
astToTikzWithTraceDefault (FeatureTrace g a
trace, AST g a
tree)
            ShowCode -> Doc (Attribute m)
-> (Node g a -> Int -> Doc (Attribute m))
-> (Node g a -> String -> Doc (Attribute m))
-> (Node g a -> Doc (Attribute m))
-> AST g a
-> Doc (Attribute m)
forall b g a.
(Monoid b, ASTPrettyPrinter g) =>
b
-> (Node g a -> Int -> b)
-> (Node g a -> String -> b)
-> (Node g a -> b)
-> AST g a
-> b
showCodeAs Doc (Attribute m)
forall a. Monoid a => a
mempty (FeatureTrace g a -> Node g a -> Int -> Doc (Attribute m)
forall g a.
Grammar g =>
(Node g a -> FeatureFormula)
-> Node g a -> Int -> Doc (Attribute m)
indentGenerator FeatureTrace g a
trace) (FeatureTrace g a -> Node g a -> String -> Doc (Attribute m)
forall a t.
Pretty a =>
(t -> FeatureFormula) -> t -> a -> Doc (Attribute m)
stringPrint FeatureTrace g a
trace) (FeatureTrace g a -> Node g a -> Doc (Attribute m)
forall a g.
Show a =>
(Node g a -> FeatureFormula) -> Node g a -> Doc (Attribute m)
nodePrint FeatureTrace g a
trace) AST g a
tree

-- | Prints the given list of versions that were produced from the given example.
printTraces :: (MonadColorPrinter m, Grammar g, ASTPrettyPrinter g, Show a, Eq a) =>
    OutputFormat -> Example m g a -> [Version g a] -> Doc (Attribute m)
printTraces :: OutputFormat -> Example m g a -> [Version g a] -> Doc (Attribute m)
printTraces format :: OutputFormat
format example :: Example m g a
example tracesAndTrees :: [Version g a]
tracesAndTrees = 
    let
        featureColourPalette :: FeatureFormulaColourPalette m
featureColourPalette = Example m g a -> FeatureFormulaColourPalette m
forall (m :: * -> *) g a.
Example m g a -> FeatureFormulaColourPalette m
colours Example m g a
example
        tracedisplay :: TraceDisplay
tracedisplay = OutputFormat -> TraceDisplay
traceDisplay OutputFormat
format
        toPC :: FeatureTrace g a -> AST g a -> FeatureTrace g a
toPC = \trace :: FeatureTrace g a
trace tree :: AST g a
tree -> if TraceDisplay
tracedisplay TraceDisplay -> TraceDisplay -> Bool
forall a. Eq a => a -> a -> Bool
== TraceDisplay
PC then AST g a -> FeatureTrace g a -> FeatureTrace g a
forall g a.
(Grammar g, Show a, Eq a) =>
AST g a -> FeatureTrace g a -> FeatureTrace g a
pc AST g a
tree FeatureTrace g a
trace else FeatureTrace g a
trace
        in
        Doc (Attribute m) -> Doc (Attribute m) -> Doc (Attribute m)
forall a. Monoid a => a -> a -> a
mappend (Doc (Attribute m) -> Doc (Attribute m) -> Doc (Attribute m)
forall a. Monoid a => a -> a -> a
mappend (String -> Doc (Attribute m)
forall a ann. Pretty a => a -> Doc ann
pretty "\n") (Doc (Attribute m) -> Doc (Attribute m))
-> Doc (Attribute m) -> Doc (Attribute m)
forall a b. (a -> b) -> a -> b
$ Attribute m -> Doc (Attribute m) -> Doc (Attribute m)
forall ann. ann -> Doc ann -> Doc ann
annotate (Color m -> Attribute m
forall (m :: * -> *). MonadColorPrinter m => Color m -> Attribute m
background Color m
forall (m :: * -> *). MonadColorPrinter m => Color m
red) (Doc (Attribute m) -> Doc (Attribute m))
-> Doc (Attribute m) -> Doc (Attribute m)
forall a b. (a -> b) -> a -> b
$ String -> Doc (Attribute m)
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc (Attribute m)) -> String -> Doc (Attribute m)
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "\n  " [
            "Running "String -> ShowS
forall a. [a] -> [a] -> [a]
++Example m g a -> String
forall (m :: * -> *) g a. Example m g a -> String
name Example m g a
example
            -- "codeStyle      = "++show codestyle,
            -- "traceDisplay   = "++show tracedisplay,
            -- "traceStyle     = "++show tracestyle
            ])
        (Doc (Attribute m) -> Doc (Attribute m))
-> Doc (Attribute m) -> Doc (Attribute m)
forall a b. (a -> b) -> a -> b
$ ((((Edit g a, FeatureFormula), Version g a)
  -> Doc (Attribute m) -> Doc (Attribute m))
 -> Doc (Attribute m)
 -> [((Edit g a, FeatureFormula), Version g a)]
 -> Doc (Attribute m))
-> Doc (Attribute m)
-> (((Edit g a, FeatureFormula), Version g a)
    -> Doc (Attribute m) -> Doc (Attribute m))
-> [((Edit g a, FeatureFormula), Version g a)]
-> Doc (Attribute m)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (((Edit g a, FeatureFormula), Version g a)
 -> Doc (Attribute m) -> Doc (Attribute m))
-> Doc (Attribute m)
-> [((Edit g a, FeatureFormula), Version g a)]
-> Doc (Attribute m)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
            Doc (Attribute m)
forall a. Monoid a => a
mempty
            (\((edit :: Edit g a
edit, fc :: FeatureFormula
fc), (trace :: FeatureTrace g a
trace, tree :: AST g a
tree)) s :: Doc (Attribute m)
s ->
                [Doc (Attribute m)] -> Doc (Attribute m)
forall a. Monoid a => [a] -> a
mconcat [
                    Doc (Attribute m)
forall ann. Doc ann
hardline,
                    Doc (Attribute m)
forall ann. Doc ann
hardline,
                    String -> Doc (Attribute m)
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc (Attribute m)) -> String -> Doc (Attribute m)
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ["==== Run ", Edit g a -> String
forall a. Show a => a -> String
show Edit g a
edit, " under context = "],
                    Attribute m -> Doc (Attribute m) -> Doc (Attribute m)
forall ann. ann -> Doc ann -> Doc ann
annotate (Color m -> Attribute m
forall (m :: * -> *). MonadColorPrinter m => Color m -> Attribute m
foreground (Color m -> Attribute m) -> Color m -> Attribute m
forall a b. (a -> b) -> a -> b
$ FeatureFormulaColourPalette m
featureColourPalette FeatureFormula
fc) (Doc (Attribute m) -> Doc (Attribute m))
-> Doc (Attribute m) -> Doc (Attribute m)
forall a b. (a -> b) -> a -> b
$ String -> Doc (Attribute m)
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc (Attribute m)) -> String -> Doc (Attribute m)
forall a b. (a -> b) -> a -> b
$ FeatureFormula -> String
forall a. Show a => Maybe a -> String
NullPropositions.prettyPrint FeatureFormula
fc,
                    String -> Doc (Attribute m)
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc (Attribute m)) -> String -> Doc (Attribute m)
forall a b. (a -> b) -> a -> b
$ " giving us ====",
                    Doc (Attribute m)
forall ann. Doc ann
hardline,
                    OutputFormat
-> FeatureFormulaColourPalette m
-> AST g a
-> FeatureTrace g a
-> Doc (Attribute m)
forall (m :: * -> *) g a.
(MonadColorPrinter m, Grammar g, ASTPrettyPrinter g, Show a,
 Eq a) =>
OutputFormat
-> FeatureFormulaColourPalette m
-> AST g a
-> FeatureTrace g a
-> Doc (Attribute m)
printASTWithTrace OutputFormat
format FeatureFormulaColourPalette m
featureColourPalette AST g a
tree (FeatureTrace g a -> AST g a -> FeatureTrace g a
toPC FeatureTrace g a
trace AST g a
tree),
                    Doc (Attribute m)
s])
        ([((Edit g a, FeatureFormula), Version g a)] -> Doc (Attribute m))
-> [((Edit g a, FeatureFormula), Version g a)] -> Doc (Attribute m)
forall a b. (a -> b) -> a -> b
$ [(Edit g a, FeatureFormula)]
-> [Version g a] -> [((Edit g a, FeatureFormula), Version g a)]
forall a b. [a] -> [b] -> [(a, b)]
zip
        -- We have to do this as the first entry in tracesAndTrees will be the initial state of the program
        ([(Edit g a, FeatureFormula)] -> [(Edit g a, FeatureFormula)]
forall g a. History g a -> History g a
alsoShowInitialStateInHistory (Example m g a -> [(Edit g a, FeatureFormula)]
forall (m :: * -> *) g a. Example m g a -> History g a
history Example m g a
example))
        [Version g a]
tracesAndTrees

-- | Helper function to show the initial state of the given history in 'printTraces'.
-- Prepends an identity edit and dummy 'FeatureContext'.
-- The context could be anything and thus is set to 'Nothing' (/null/).
alsoShowInitialStateInHistory :: History g a -> History g a
alsoShowInitialStateInHistory :: History g a -> History g a
alsoShowInitialStateInHistory h :: History g a
h = (Edit g a
forall g a. Edit g a
edit_identity, FeatureFormula
forall a. Maybe a
Nothing)(Edit g a, FeatureFormula) -> History g a -> History g a
forall a. a -> [a] -> [a]
:History g a
h

-- | Helper function to help with type inference.
-- Returns all atomic values of a 'PropositionalFormula' (over strings).
propositional_values :: [PropositionalFormula String]
propositional_values :: [PropositionalFormula String]
propositional_values = [PropositionalFormula String]
forall l. Logic l => [l]
lvalues

-- | Helper function to help with type inference.
-- Returns all atomic values of a 'NullableFormula' (over strings).
nullableFormula_values :: [NullableFormula String]
nullableFormula_values :: [FeatureFormula]
nullableFormula_values = [FeatureFormula]
forall l. Logic l => [l]
lvalues

-- | Prints truthtables for common operators in 'PropositionalFormula's and 'NullableFormula's (not, and, or, implies, equiv)
showTruthtables :: IO()
showTruthtables :: IO ()
showTruthtables = (LocalTerminal -> IO ()) -> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
(LocalTerminal -> m a) -> m a
withTerminal ((LocalTerminal -> IO ()) -> IO ())
-> (LocalTerminal -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ TerminalT LocalTerminal IO () -> LocalTerminal -> IO ()
forall (m :: * -> *) t a.
(MonadIO m, MonadMask m, Terminal t) =>
TerminalT t m a -> t -> m a
runTerminalT (TerminalT LocalTerminal IO () -> LocalTerminal -> IO ())
-> TerminalT LocalTerminal IO () -> LocalTerminal -> IO ()
forall a b. (a -> b) -> a -> b
$
    do
        String -> TerminalT LocalTerminal IO ()
forall (m :: * -> *). MonadColorPrinter m => String -> m ()
headline "Propositional Logic"
        Doc (Attribute (TerminalT LocalTerminal IO))
-> TerminalT LocalTerminal IO ()
forall (m :: * -> *).
MonadMarkupPrinter m =>
Doc (Attribute m) -> m ()
putDoc(Doc (Attribute (TerminalT LocalTerminal IO))
 -> TerminalT LocalTerminal IO ())
-> (String -> Doc (Attribute (TerminalT LocalTerminal IO)))
-> String
-> TerminalT LocalTerminal IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> Doc (Attribute (TerminalT LocalTerminal IO))
forall a ann. Pretty a => a -> Doc ann
pretty (String -> TerminalT LocalTerminal IO ())
-> String -> TerminalT LocalTerminal IO ()
forall a b. (a -> b) -> a -> b
$ [PropositionalFormula String] -> String
forall a. (Logic a, Show a) => [a] -> String
generatetruthtablesfor [PropositionalFormula String]
propositional_values
        Doc (Attribute (TerminalT LocalTerminal IO))
-> TerminalT LocalTerminal IO ()
forall (m :: * -> *).
MonadMarkupPrinter m =>
Doc (Attribute m) -> m ()
putDoc (Doc (Attribute (TerminalT LocalTerminal IO))
 -> TerminalT LocalTerminal IO ())
-> Doc (Attribute (TerminalT LocalTerminal IO))
-> TerminalT LocalTerminal IO ()
forall a b. (a -> b) -> a -> b
$ Doc (Attribute (TerminalT LocalTerminal IO))
forall ann. Doc ann
hardline Doc (Attribute (TerminalT LocalTerminal IO))
-> Doc (Attribute (TerminalT LocalTerminal IO))
-> Doc (Attribute (TerminalT LocalTerminal IO))
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc (Attribute (TerminalT LocalTerminal IO))
forall ann. Doc ann
hardline
        String -> TerminalT LocalTerminal IO ()
forall (m :: * -> *). MonadColorPrinter m => String -> m ()
headline "Ternary Logic With Null"
        Doc (Attribute (TerminalT LocalTerminal IO))
-> TerminalT LocalTerminal IO ()
forall (m :: * -> *).
MonadMarkupPrinter m =>
Doc (Attribute m) -> m ()
putDoc(Doc (Attribute (TerminalT LocalTerminal IO))
 -> TerminalT LocalTerminal IO ())
-> (String -> Doc (Attribute (TerminalT LocalTerminal IO)))
-> String
-> TerminalT LocalTerminal IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> Doc (Attribute (TerminalT LocalTerminal IO))
forall a ann. Pretty a => a -> Doc ann
pretty (String -> TerminalT LocalTerminal IO ())
-> String -> TerminalT LocalTerminal IO ()
forall a b. (a -> b) -> a -> b
$ [FeatureFormula] -> String
forall a. (Logic a, Show a) => [a] -> String
generatetruthtablesfor [FeatureFormula]
nullableFormula_values