{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE QuasiQuotes #-}
module Modelling.ActivityDiagram.Auxiliary.Util (
  finalNodesAdvice
  ) where

import Data.String.Interpolate          (iii)
import Control.OutputCapable.Blocks (
  LangM,
  OutputCapable,
  english,
  german,
  paragraph,
  translate,
  )

finalNodesAdvice :: OutputCapable m => Bool -> LangM m
finalNodesAdvice :: forall (m :: * -> *). OutputCapable m => Bool -> LangM m
finalNodesAdvice Bool
withFinalTransitionAdvice = do
  LangM m -> LangM m
forall l (m :: * -> *).
GenericOutputCapable l m =>
GenericLangM l m () -> GenericLangM l m ()
paragraph (LangM m -> LangM m) -> LangM m -> LangM m
forall a b. (a -> b) -> a -> b
$ State (Map Language String) () -> LangM m
forall l (m :: * -> *).
GenericOutputCapable l m =>
State (Map l String) () -> GenericLangM l m ()
translate (State (Map Language String) () -> LangM m)
-> State (Map Language String) () -> LangM m
forall a b. (a -> b) -> a -> b
$ do
    String -> State (Map Language String) ()
english (String -> State (Map Language String) ())
-> String -> State (Map Language String) ()
forall a b. (a -> b) -> a -> b
$ [iii|
      Hint on the translation to a Petri net:
      For final nodes no additional places are introduced.
      They are realised in a way that a token is consumed,
      i.e. disappears from the net at that position.
      |]
      String -> String -> String
`appendExtendedAdvice`
      [iii|
      If an additional transition is required to realise this behavior
      at a position in the diagram where there is a final node,
      this transition does not count as auxiliary node.
      |]
    String -> State (Map Language String) ()
german (String -> State (Map Language String) ())
-> String -> State (Map Language String) ()
forall a b. (a -> b) -> a -> b
$ [iii|
      Hinweis zur Übersetzung in ein Petrinetz:
      Für Endknoten  werden keine zusätzlichen Stellen eingeführt.
      Sie werden so realisiert, dass ein Token verbraucht wird,
      also an dieser Position aus dem Netz verschwindet.
      |]
      String -> String -> String
`appendExtendedAdvice`
      [iii|
      Falls eine zusätzliche Transition erforderlich ist,
      um dieses Verhalten an einer Position im Diagramm zu realisieren,
      an der sich ein Endknoten befindet,
      zählt diese Transition nicht als Hilfsknoten.
      |]
  pure ()
  where
    appendExtendedAdvice :: String -> String -> String
appendExtendedAdvice String
x String
y
      | Bool
withFinalTransitionAdvice = String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
' ' Char -> String -> String
forall a. a -> [a] -> [a]
: String
y
      | Bool
otherwise = String
x