{- |
Description: Module for creating demos of feature trace recording.
License: GNU LGPLv3
Maintainer: paul.bittner@uni-ulm.de

Module for creating demos of feature trace recording.
-}
module Example where

import AST ( AST )
import Edits ( EditScript )
import Grammar
import Feature
import FeatureTrace
import FeatureTraceRecording
import DefaultFeatureTraceRecording
import FeatureColour (FeatureFormulaColourPalette)
import Control.Monad.State ( State, runState )
import UUID

{- | An 'Example' represents a single demo showcase of feature trace recording.

- @m@: Monad defining colours which is used for printing an examples output.
- @g@: Grammar of the example (e.g., if the examples shows the development of Java or C++ or Haskell source code).
- @a@: Value type of the artefacts in the 'AST's (e.g., @String@).
-}
data Example m g a = Example {
    -- | The name of the example to identify it.
    Example m g a -> String
name :: String,
    -- | The version of the source code (as 'AST') and 'FeatureTrace's when the recording is started.
    Example m g a -> Version g a
startVersion :: Version g a,
    -- | The history of edits upon which to record feature traces when applied to 'startVersion'.
    Example m g a -> History g a
history :: History g a,
    -- | A colour scheme for displaying features and feature formula.
    Example m g a -> FeatureFormulaColourPalette m
colours :: FeatureFormulaColourPalette m
}

-- | Runs and example with the given 'FeatureTraceRecording' implementation, yielding a list of all intermediate versions.
-- The last element in the returned list is the 'AST' and 'FeatureTrace's to which the 'startVersion' was changed when aplying all edits in 'history' of the 'Example'.
runExample :: (Grammar g, Show a, Eq a) => FeatureTraceRecording g a -> Example m g a -> [Version g a]
runExample :: FeatureTraceRecording g a -> Example m g a -> [Version g a]
runExample ftr :: FeatureTraceRecording g a
ftr example :: Example m g a
example = FeatureTraceRecording g a
-> Version g a -> History g a -> [Version g a]
forall a g.
(Show a, Eq a) =>
FeatureTraceRecording g a
-> Version g a -> History g a -> [Version g a]
runFTRWithIntermediateSteps FeatureTraceRecording g a
ftr (Example m g a -> Version g a
forall (m :: * -> *) g a. Example m g a -> Version g a
startVersion Example m g a
example) (Example m g a -> History g a
forall (m :: * -> *) g a. Example m g a -> History g a
history Example m g a
example)

-- | Runs the given example with the default implementation of 'FeatureTraceRecording' ('defaultFeatureTraceRecording').
-- Is equivalent to @runExample defaultFeatureTraceRecording@.
runExampleWithDefaultFTR :: (Grammar g, Show a, Eq a) => Example m g a -> [Version g a]
runExampleWithDefaultFTR :: Example m g a -> [Version g a]
runExampleWithDefaultFTR = FeatureTraceRecording g a -> Example m g a -> [Version g a]
forall g a (m :: * -> *).
(Grammar g, Show a, Eq a) =>
FeatureTraceRecording g a -> Example m g a -> [Version g a]
runExample FeatureTraceRecording g a
forall g a. (Grammar g, Show a, Eq a) => FeatureTraceRecording g a
defaultFeatureTraceRecording

-- | Evaluates all 'UUID's in the example, starting with @0@.
-- Use this after building an 'AST' whose 'Node's yet have to be assigned 'UUID's.
finalizeExample :: State UUID (Example m g a) -> Example m g a
finalizeExample :: State UUID (Example m g a) -> Example m g a
finalizeExample ex :: State UUID (Example m g a)
ex = (Example m g a, UUID) -> Example m g a
forall a b. (a, b) -> a
fst ((Example m g a, UUID) -> Example m g a)
-> (Example m g a, UUID) -> Example m g a
forall a b. (a -> b) -> a -> b
$ State UUID (Example m g a) -> UUID -> (Example m g a, UUID)
forall s a. State s a -> s -> (a, s)
runState State UUID (Example m g a)
ex 0