{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE DeriveDataTypeable #-}
-- | This module provides common skeletons for printing tasks
module Modelling.Auxiliary.Output (
  addPretext,
  checkTaskText,
  directionsAdvice,
  hoveringInformation,
  simplifiedInformation,
  uniform,
  ) where

import qualified Data.Map                         as M (empty, insert)

import Control.OutputCapable.Blocks     (
  GenericOutputCapable (paragraph),
  Language(..),
  LangM,
  LangM',
  OutputCapable,
  english,
  german,
  translate,
  translations,
  collapsed,
  )
import Control.OutputCapable.Blocks.Type (
  SpecialOutput,
  checkTranslations,
  )
import Data.List                        ((\\), singleton)
import Data.Map                         (Map)
import Data.String.Interpolate          (iii)

hoveringInformation :: OutputCapable m => Bool -> LangM m
hoveringInformation :: forall (m :: * -> *). OutputCapable m => Bool -> LangM m
hoveringInformation Bool
isCollapsed = Bool
-> Map Language String
-> GenericLangM Language m ()
-> GenericLangM Language m ()
forall l (m :: * -> *).
GenericOutputCapable l m =>
Bool -> Map l String -> GenericLangM l m () -> GenericLangM l m ()
collapsed Bool
isCollapsed (State (Map Language String) () -> Map Language String
forall l a. State (Map l a) () -> Map l a
translations (State (Map Language String) () -> Map Language String)
-> State (Map Language String) () -> Map Language String
forall a b. (a -> b) -> a -> b
$ do
  String -> State (Map Language String) ()
english String
"Note on hovering"
  String -> State (Map Language String) ()
german String
"Anmerkung zum Hovern"
  ) (GenericLangM Language m () -> GenericLangM Language m ())
-> GenericLangM Language m () -> GenericLangM Language m ()
forall a b. (a -> b) -> a -> b
$ State (Map Language String) () -> GenericLangM Language m ()
forall l (m :: * -> *).
GenericOutputCapable l m =>
State (Map l String) () -> GenericLangM l m ()
translate (State (Map Language String) () -> GenericLangM Language m ())
-> State (Map Language String) () -> GenericLangM Language m ()
forall a b. (a -> b) -> a -> b
$ do
  String -> State (Map Language String) ()
english [iii|
    When hovering over or clicking on nodes / edges or their
    labels, the respective diagram elements that belong together are highlighted.
    |]
  String -> State (Map Language String) ()
german [iii|
    Beim Bewegen über oder Klicken auf
    Knoten / Kanten bzw. ihre Beschriftungen
    werden die jeweils zusammengehörenden Diagrammelemente hervorgehoben.
    |]

directionsAdvice :: OutputCapable m => Bool -> LangM m
directionsAdvice :: forall (m :: * -> *). OutputCapable m => Bool -> LangM m
directionsAdvice Bool
isCollapsed = Bool
-> Map Language String
-> GenericLangM Language m ()
-> GenericLangM Language m ()
forall l (m :: * -> *).
GenericOutputCapable l m =>
Bool -> Map l String -> GenericLangM l m () -> GenericLangM l m ()
collapsed Bool
isCollapsed (State (Map Language String) () -> Map Language String
forall l a. State (Map l a) () -> Map l a
translations (State (Map Language String) () -> Map Language String)
-> State (Map Language String) () -> Map Language String
forall a b. (a -> b) -> a -> b
$ do
  String -> State (Map Language String) ()
english String
"Note on navigation directions"
  String -> State (Map Language String) ()
german String
"Anmerkung zu Navigationsrichtungen"
  ) (GenericLangM Language m () -> GenericLangM Language m ())
-> GenericLangM Language m () -> GenericLangM Language m ()
forall a b. (a -> b) -> a -> b
$ State (Map Language String) () -> GenericLangM Language m ()
forall l (m :: * -> *).
GenericOutputCapable l m =>
State (Map l String) () -> GenericLangM l m ()
translate (State (Map Language String) () -> GenericLangM Language m ())
-> State (Map Language String) () -> GenericLangM Language m ()
forall a b. (a -> b) -> a -> b
$ do
  String -> State (Map Language String) ()
english [iii|
    Aggregations and compositions are only navigable
    from the "part" toward the "whole",
    i.e., they are not navigable in the opposite direction!
    |]
  String -> State (Map Language String) ()
german [iii|
    Aggregationen und Kompositionen
    sind nur vom "Teil" zum "Ganzen" navigierbar,
    d.h., sie sind nicht in der entgegengesetzten Richtung navigierbar!
    |]

simplifiedInformation :: OutputCapable m => Bool -> LangM m
simplifiedInformation :: forall (m :: * -> *). OutputCapable m => Bool -> LangM m
simplifiedInformation Bool
isCollapsed = Bool
-> Map Language String
-> GenericLangM Language m ()
-> GenericLangM Language m ()
forall l (m :: * -> *).
GenericOutputCapable l m =>
Bool -> Map l String -> GenericLangM l m () -> GenericLangM l m ()
collapsed Bool
isCollapsed (State (Map Language String) () -> Map Language String
forall l a. State (Map l a) () -> Map l a
translations (State (Map Language String) () -> Map Language String)
-> State (Map Language String) () -> Map Language String
forall a b. (a -> b) -> a -> b
$ do
  String -> State (Map Language String) ()
english String
"Note on class representation"
  String -> State (Map Language String) ()
german String
"Anmerkung zur Klassendarstellung"
  ) (GenericLangM Language m () -> GenericLangM Language m ())
-> GenericLangM Language m () -> GenericLangM Language m ()
forall a b. (a -> b) -> a -> b
$ State (Map Language String) () -> GenericLangM Language m ()
forall l (m :: * -> *).
GenericOutputCapable l m =>
State (Map l String) () -> GenericLangM l m ()
translate (State (Map Language String) () -> GenericLangM Language m ())
-> State (Map Language String) () -> GenericLangM Language m ()
forall a b. (a -> b) -> a -> b
$ do
  String -> State (Map Language String) ()
english [iii|
    Classes are represented simplified here.
    #{endLine}
    That means they consist of a single box containing only the class name
    but no sections for attributes or methods.
    #{endLine}
    Nevertheless, you should treat these simplified class representations
    as valid classes.
    |]
  String -> State (Map Language String) ()
german [iii|
    Klassen werden hier vereinfacht dargestellt.
    #{endLine}
    Das heißt, sie bestehen aus einer einfachen Box,
    die nur den Klassennamen enthält,
    aber keine Abschnitte für Attribute oder Methoden.
    #{endLine}
    Trotzdem sollten Sie diese vereinfachten Klassendarstellungen
    als gültige Klassen ansehen.
    |]
  where
    endLine :: String
    endLine :: String
endLine = String
"\n"

addPretext :: OutputCapable m => LangM' m a -> LangM' m a
addPretext :: forall (m :: * -> *) a. OutputCapable m => LangM' m a -> LangM' m a
addPretext = GenericLangM Language m ()
-> GenericLangM Language m a -> GenericLangM Language m a
forall a b.
GenericLangM Language m a
-> GenericLangM Language m b -> GenericLangM Language m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>) (GenericLangM Language m ()
 -> GenericLangM Language m a -> GenericLangM Language m a)
-> GenericLangM Language m ()
-> GenericLangM Language m a
-> GenericLangM Language m a
forall a b. (a -> b) -> a -> b
$
  GenericLangM Language m () -> GenericLangM Language m ()
forall l (m :: * -> *).
GenericOutputCapable l m =>
GenericLangM l m () -> GenericLangM l m ()
paragraph (GenericLangM Language m () -> GenericLangM Language m ())
-> GenericLangM Language m () -> GenericLangM Language m ()
forall a b. (a -> b) -> a -> b
$ State (Map Language String) () -> GenericLangM Language m ()
forall l (m :: * -> *).
GenericOutputCapable l m =>
State (Map l String) () -> GenericLangM l m ()
translate (State (Map Language String) () -> GenericLangM Language m ())
-> State (Map Language String) () -> GenericLangM Language m ()
forall a b. (a -> b) -> a -> b
$ do
    String -> State (Map Language String) ()
english String
"Remarks on your solution:"
    String -> State (Map Language String) ()
german String
"Anmerkungen zur eingereichten Lösung:"

uniform :: a -> Map Language a
uniform :: forall a. a -> Map Language a
uniform a
x = (Language -> Map Language a -> Map Language a)
-> Map Language a -> [Language] -> Map Language a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Language -> a -> Map Language a -> Map Language a
forall k a. Ord k => k -> a -> Map k a -> Map k a
`M.insert` a
x) Map Language a
forall k a. Map k a
M.empty [Language
forall a. Bounded a => a
minBound ..]

checkTaskText
  :: (Bounded element, Enum element, Eq element, Show element)
  => [SpecialOutput element]
  -> Maybe String
checkTaskText :: forall element.
(Bounded element, Enum element, Eq element, Show element) =>
[SpecialOutput element] -> Maybe String
checkTaskText [SpecialOutput element]
taskText
  | element
x:[element]
_ <- [element]
allElements [element] -> [element] -> [element]
forall a. Eq a => [a] -> [a] -> [a]
\\ [element]
usedElements
  = String -> Maybe String
forall a. a -> Maybe a
Just [iii|Your task text is incomplete as it is missing '#{show x}'.|]
  | element
x:[element]
_ <- [element]
usedElements [element] -> [element] -> [element]
forall a. Eq a => [a] -> [a] -> [a]
\\ [element]
allElements
  = String -> Maybe String
forall a. a -> Maybe a
Just [iii|
      Your task text is using '#{show x}' at least twice,
      but it should appear exactly once.
      |]
  | String
x:[String]
_ <- (SpecialOutput element -> [String])
-> [SpecialOutput element] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((element -> [String]) -> SpecialOutput element -> [String]
forall element.
(element -> [String]) -> SpecialOutput element -> [String]
checkTranslations ([String] -> element -> [String]
forall a b. a -> b -> a
const [])) [SpecialOutput element]
taskText
  = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ [iii|Problem within your task text: |] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x
  | Bool
otherwise
  = Maybe String
forall a. Maybe a
Nothing
  where
    usedElements :: [element]
usedElements = (SpecialOutput element -> [element])
-> [SpecialOutput element] -> [element]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((element -> [element]) -> SpecialOutput element -> [element]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap element -> [element]
forall a. a -> [a]
singleton) [SpecialOutput element]
taskText
    allElements :: [element]
allElements = [element
forall a. Bounded a => a
minBound ..]