{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}

{- |
FlexTask configuration and task instance types.
-}

module FlexTask.Types
  ( HtmlDict
  , CommonModules(..)
  , FlexInst(..)
  , FlexConf(..)
  , delimiter

  , parseFlexConfig
  , showFlexConfig
  , validateFlexConfig
  ) where


import Control.Monad                     (void)
import Control.OutputCapable.Blocks      (LangM, OutputCapable, indent, refuse, translate, german, english)
import Data.List.Extra                   (dropEnd1, intercalate, isPrefixOf, nubOrd, stripInfix, word1)
import Data.Map                          (Map)
import Data.Maybe                        (mapMaybe)
import Data.Text                         (Text)
import GHC.Generics                      (Generic)
import Text.Parsec (
    (<|>),
    anyChar,
    char,
    eof,
    lookAhead,
    manyTill,
    string,
    skipMany,
    try,
    sepBy,
    )
import Text.Parsec.Char                  (endOfLine, oneOf)
import Text.Parsec.String                (Parser)
import Yesod                             (Lang)



-- | A map of language code and internationalized HTML value pairs.
type HtmlDict = Map Lang String


{- |
Concrete Task instance.
Contained Haskell code is runtime interpreted to produce needed components of a task.
-}
data FlexInst = FlexInst {
    FlexInst -> ([Text], HtmlDict)
form            :: ([Text],HtmlDict), -- ^ Field IDs of input elements and Html code.
    FlexInst -> String
taskData        ::  String,           -- ^ Flexible task data used by task description and checker functions.
    FlexInst -> CommonModules
commonModules   ::  CommonModules,    -- ^ Modules shared between config and instance.
    FlexInst -> String
checkModule     ::  String            -- ^ Module containing the Checker functions.
  } deriving ((forall x. FlexInst -> Rep FlexInst x)
-> (forall x. Rep FlexInst x -> FlexInst) -> Generic FlexInst
forall x. Rep FlexInst x -> FlexInst
forall x. FlexInst -> Rep FlexInst x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FlexInst -> Rep FlexInst x
from :: forall x. FlexInst -> Rep FlexInst x
$cto :: forall x. Rep FlexInst x -> FlexInst
to :: forall x. Rep FlexInst x -> FlexInst
Generic)


{- |
Configuration to use for random generation of concrete `FlexInst`.
`taskDataModule` is interpreted upon generating an instance to produce static form data.
The other Haskell modules are propagated to the generated task instance.
-}
data FlexConf = FlexConf {
    FlexConf -> String
taskDataModule :: String,       -- ^ Module for generating the form, as well as `CheckModule`.
    FlexConf -> CommonModules
commonModules  :: CommonModules -- ^ Modules shared between config and instance.
  } deriving (FlexConf -> FlexConf -> Bool
(FlexConf -> FlexConf -> Bool)
-> (FlexConf -> FlexConf -> Bool) -> Eq FlexConf
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FlexConf -> FlexConf -> Bool
== :: FlexConf -> FlexConf -> Bool
$c/= :: FlexConf -> FlexConf -> Bool
/= :: FlexConf -> FlexConf -> Bool
Eq,(forall x. FlexConf -> Rep FlexConf x)
-> (forall x. Rep FlexConf x -> FlexConf) -> Generic FlexConf
forall x. Rep FlexConf x -> FlexConf
forall x. FlexConf -> Rep FlexConf x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FlexConf -> Rep FlexConf x
from :: forall x. FlexConf -> Rep FlexConf x
$cto :: forall x. Rep FlexConf x -> FlexConf
to :: forall x. Rep FlexConf x -> FlexConf
Generic,Eq FlexConf
Eq FlexConf =>
(FlexConf -> FlexConf -> Ordering)
-> (FlexConf -> FlexConf -> Bool)
-> (FlexConf -> FlexConf -> Bool)
-> (FlexConf -> FlexConf -> Bool)
-> (FlexConf -> FlexConf -> Bool)
-> (FlexConf -> FlexConf -> FlexConf)
-> (FlexConf -> FlexConf -> FlexConf)
-> Ord FlexConf
FlexConf -> FlexConf -> Bool
FlexConf -> FlexConf -> Ordering
FlexConf -> FlexConf -> FlexConf
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FlexConf -> FlexConf -> Ordering
compare :: FlexConf -> FlexConf -> Ordering
$c< :: FlexConf -> FlexConf -> Bool
< :: FlexConf -> FlexConf -> Bool
$c<= :: FlexConf -> FlexConf -> Bool
<= :: FlexConf -> FlexConf -> Bool
$c> :: FlexConf -> FlexConf -> Bool
> :: FlexConf -> FlexConf -> Bool
$c>= :: FlexConf -> FlexConf -> Bool
>= :: FlexConf -> FlexConf -> Bool
$cmax :: FlexConf -> FlexConf -> FlexConf
max :: FlexConf -> FlexConf -> FlexConf
$cmin :: FlexConf -> FlexConf -> FlexConf
min :: FlexConf -> FlexConf -> FlexConf
Ord,Int -> FlexConf -> ShowS
[FlexConf] -> ShowS
FlexConf -> String
(Int -> FlexConf -> ShowS)
-> (FlexConf -> String) -> ([FlexConf] -> ShowS) -> Show FlexConf
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FlexConf -> ShowS
showsPrec :: Int -> FlexConf -> ShowS
$cshow :: FlexConf -> String
show :: FlexConf -> String
$cshowList :: [FlexConf] -> ShowS
showList :: [FlexConf] -> ShowS
Show)


{- |
Modules present in both `FlexConf` and `FlexInst`.
They are propagated to the generated task instance.
-}
data CommonModules = CommonModules {
    CommonModules -> String
globalModule      ::  String, -- ^ Global code module available in all interpreter runs.
    CommonModules -> String
settingsModule    ::  String, -- ^ Module for task configuration constants.
    CommonModules -> String
descriptionModule ::  String, -- ^ Module for producing the task description.
    CommonModules -> String
parseModule       ::  String, -- ^ Module containing the Parser for the submission type.
    CommonModules -> [(String, String)]
extraModules      :: [(String,String)] -- ^ User defined additional modules with format (Name,Code)
  } deriving (CommonModules -> CommonModules -> Bool
(CommonModules -> CommonModules -> Bool)
-> (CommonModules -> CommonModules -> Bool) -> Eq CommonModules
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CommonModules -> CommonModules -> Bool
== :: CommonModules -> CommonModules -> Bool
$c/= :: CommonModules -> CommonModules -> Bool
/= :: CommonModules -> CommonModules -> Bool
Eq,(forall x. CommonModules -> Rep CommonModules x)
-> (forall x. Rep CommonModules x -> CommonModules)
-> Generic CommonModules
forall x. Rep CommonModules x -> CommonModules
forall x. CommonModules -> Rep CommonModules x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CommonModules -> Rep CommonModules x
from :: forall x. CommonModules -> Rep CommonModules x
$cto :: forall x. Rep CommonModules x -> CommonModules
to :: forall x. Rep CommonModules x -> CommonModules
Generic,Eq CommonModules
Eq CommonModules =>
(CommonModules -> CommonModules -> Ordering)
-> (CommonModules -> CommonModules -> Bool)
-> (CommonModules -> CommonModules -> Bool)
-> (CommonModules -> CommonModules -> Bool)
-> (CommonModules -> CommonModules -> Bool)
-> (CommonModules -> CommonModules -> CommonModules)
-> (CommonModules -> CommonModules -> CommonModules)
-> Ord CommonModules
CommonModules -> CommonModules -> Bool
CommonModules -> CommonModules -> Ordering
CommonModules -> CommonModules -> CommonModules
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CommonModules -> CommonModules -> Ordering
compare :: CommonModules -> CommonModules -> Ordering
$c< :: CommonModules -> CommonModules -> Bool
< :: CommonModules -> CommonModules -> Bool
$c<= :: CommonModules -> CommonModules -> Bool
<= :: CommonModules -> CommonModules -> Bool
$c> :: CommonModules -> CommonModules -> Bool
> :: CommonModules -> CommonModules -> Bool
$c>= :: CommonModules -> CommonModules -> Bool
>= :: CommonModules -> CommonModules -> Bool
$cmax :: CommonModules -> CommonModules -> CommonModules
max :: CommonModules -> CommonModules -> CommonModules
$cmin :: CommonModules -> CommonModules -> CommonModules
min :: CommonModules -> CommonModules -> CommonModules
Ord,Int -> CommonModules -> ShowS
[CommonModules] -> ShowS
CommonModules -> String
(Int -> CommonModules -> ShowS)
-> (CommonModules -> String)
-> ([CommonModules] -> ShowS)
-> Show CommonModules
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommonModules -> ShowS
showsPrec :: Int -> CommonModules -> ShowS
$cshow :: CommonModules -> String
show :: CommonModules -> String
$cshowList :: [CommonModules] -> ShowS
showList :: [CommonModules] -> ShowS
Show)



-- | Visual module separator for configuration display.
delimiter :: String
delimiter :: String
delimiter = String
"\r\n=============================================\r\n"



{- |
Convert a configuration into a String.
The modules are separated by lines of at least three consecutive /equals signs/ (=).
e.g.

@
Module1 where
...

====================

Module2 where
...
@
-}
showFlexConfig :: FlexConf -> String
showFlexConfig :: FlexConf -> String
showFlexConfig FlexConf{commonModules :: FlexConf -> CommonModules
commonModules = CommonModules{String
[(String, String)]
globalModule :: CommonModules -> String
settingsModule :: CommonModules -> String
descriptionModule :: CommonModules -> String
parseModule :: CommonModules -> String
extraModules :: CommonModules -> [(String, String)]
globalModule :: String
settingsModule :: String
descriptionModule :: String
parseModule :: String
extraModules :: [(String, String)]
..},String
taskDataModule :: FlexConf -> String
taskDataModule :: String
..} =
    String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
delimiter ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
      [ String
globalModule
      , String
settingsModule
      , String
taskDataModule
      , String
descriptionModule
      , String
parseModule
      ]
      [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> b
snd [(String, String)]
extraModules



{- |
Parser for FlexTask configurations.
Reads five or more code modules each separated by at least three /equals signs/ (=).

Modules starting from the sixth will be added to `CommonModules.extraModules`.
-}
parseFlexConfig :: Parser FlexConf
parseFlexConfig :: Parser FlexConf
parseFlexConfig = do
    [String]
modules <- ParsecT String () Identity [String]
forall {u}. ParsecT String u Identity [String]
betweenEquals
    case Int -> [String] -> ([String], [String])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
5 [String]
modules of
      ([String
globalModule,String
settingsModule,String
taskDataModule,String
descriptionModule,String
parseModule], [String]
extra) -> do
        let extraModules :: [(String, String)]
extraModules = (String -> Maybe (String, String))
-> [String] -> [(String, String)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe (String, String)
getModName [String]
extra
        FlexConf -> Parser FlexConf
forall a. a -> ParsecT String () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FlexConf -> Parser FlexConf) -> FlexConf -> Parser FlexConf
forall a b. (a -> b) -> a -> b
$
          FlexConf {
            String
taskDataModule :: String
taskDataModule :: String
taskDataModule,
            commonModules :: CommonModules
commonModules = CommonModules {
              String
globalModule :: String
globalModule :: String
globalModule,
              String
settingsModule :: String
settingsModule :: String
settingsModule,
              String
descriptionModule :: String
descriptionModule :: String
descriptionModule,
              String
parseModule :: String
parseModule :: String
parseModule,
              [(String, String)]
extraModules :: [(String, String)]
extraModules :: [(String, String)]
extraModules
            }
          }
      ([String], [String])
_ -> String -> Parser FlexConf
forall a. String -> ParsecT String () Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser FlexConf) -> String -> Parser FlexConf
forall a b. (a -> b) -> a -> b
$
             String
"Unexpected end of file. " String -> ShowS
forall a. [a] -> [a] -> [a]
++
             String
"Provide at least the following Modules (in this order): " String -> ShowS
forall a. [a] -> [a] -> [a]
++
             String
"Global, TaskSettings, TaskData (Check), Description, Parse"
  where
    atLeastThree :: ParsecT String u Identity ()
atLeastThree = do
      ParsecT String u Identity Char -> ParsecT String u Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
endOfLine
      ParsecT String u Identity ()
forall {u}. ParsecT String u Identity ()
whiteSpace
      ParsecT String u Identity String -> ParsecT String u Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String u Identity String -> ParsecT String u Identity ())
-> ParsecT String u Identity String -> ParsecT String u Identity ()
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"==="
      ParsecT String u Identity Char -> ParsecT String u Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (ParsecT String u Identity Char -> ParsecT String u Identity ())
-> ParsecT String u Identity Char -> ParsecT String u Identity ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'='
      ParsecT String u Identity ()
forall {u}. ParsecT String u Identity ()
whiteSpace
      ParsecT String u Identity Char -> ParsecT String u Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
endOfLine

    whiteSpace :: ParsecT String u Identity ()
whiteSpace = ParsecT String u Identity Char -> ParsecT String u Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (ParsecT String u Identity Char -> ParsecT String u Identity ())
-> ParsecT String u Identity Char -> ParsecT String u Identity ()
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf [Char
' ', Char
'\t']

    betweenEquals :: ParsecT String u Identity [String]
betweenEquals =
      ParsecT String u Identity Char
-> ParsecT String u Identity () -> ParsecT String u Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (ParsecT String u Identity () -> ParsecT String u Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String u Identity () -> ParsecT String u Identity ())
-> ParsecT String u Identity () -> ParsecT String u Identity ()
forall a b. (a -> b) -> a -> b
$ ParsecT String u Identity () -> ParsecT String u Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT String u Identity () -> ParsecT String u Identity ())
-> ParsecT String u Identity () -> ParsecT String u Identity ()
forall a b. (a -> b) -> a -> b
$ ParsecT String u Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof ParsecT String u Identity ()
-> ParsecT String u Identity () -> ParsecT String u Identity ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String u Identity ()
forall {u}. ParsecT String u Identity ()
atLeastThree) ParsecT String u Identity String
-> ParsecT String u Identity ()
-> ParsecT String u Identity [String]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
`sepBy`
      ParsecT String u Identity ()
forall {u}. ParsecT String u Identity ()
atLeastThree


getModName :: String -> Maybe (String, String)
getModName :: String -> Maybe (String, String)
getModName String
code = do
  (String
_,String
nameAtFront) <- String -> String -> Maybe (String, String)
forall a. Eq a => [a] -> [a] -> Maybe ([a], [a])
stripInfix String
"module" (String -> Maybe (String, String))
-> String -> Maybe (String, String)
forall a b. (a -> b) -> a -> b
$ ShowS
removeComments String
code
  (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just ((String, String) -> String
forall a b. (a, b) -> a
fst ((String, String) -> String) -> (String, String) -> String
forall a b. (a -> b) -> a -> b
$ String -> (String, String)
word1 String
nameAtFront, String
code)


removeComments :: String -> String
removeComments :: ShowS
removeComments = [String] -> String
unlines ([String] -> String) -> (String -> [String]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"--" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`)) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines (String -> [String]) -> ShowS -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
runRemove
  where
    runRemove :: ShowS
runRemove String
xs = case String -> String -> Maybe (String, String)
forall a. Eq a => [a] -> [a] -> Maybe ([a], [a])
stripInfix String
"{-" String
xs of
      Maybe (String, String)
Nothing -> String
xs
      Just (String
a,String
b) -> String
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ case String -> String -> Maybe (String, String)
forall a. Eq a => [a] -> [a] -> Maybe ([a], [a])
stripInfix String
"-}" String
b of
        Maybe (String, String)
Nothing -> String
xs
        Just (String
_,String
rest) -> ShowS
runRemove String
rest


-- | Check a configuration for inconsistencies
validateFlexConfig :: OutputCapable m => FlexConf -> LangM m
validateFlexConfig :: forall (m :: * -> *). OutputCapable m => FlexConf -> LangM m
validateFlexConfig FlexConf{commonModules :: FlexConf -> CommonModules
commonModules = CommonModules{String
[(String, String)]
globalModule :: CommonModules -> String
settingsModule :: CommonModules -> String
descriptionModule :: CommonModules -> String
parseModule :: CommonModules -> String
extraModules :: CommonModules -> [(String, String)]
globalModule :: String
settingsModule :: String
descriptionModule :: String
parseModule :: String
extraModules :: [(String, String)]
..},String
taskDataModule :: FlexConf -> String
taskDataModule :: String
..}
  | [String]
requiredNames [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
/= [String]
requiredConfig = State (Map Language String) () -> GenericLangM Language m ()
reject (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) ()
german (String -> State (Map Language String) ())
-> String -> State (Map Language String) ()
forall a b. (a -> b) -> a -> b
$
      String
"Die festen Module wurden in Reihenfolge oder Namen verändert. " String -> ShowS
forall a. [a] -> [a] -> [a]
++
      String
"Sie müssen exakt mit folgender Reihenfolge und " String -> ShowS
forall a. [a] -> [a] -> [a]
++
      String
"folgenden Bezeichnern definiert werden: " String -> ShowS
forall a. [a] -> [a] -> [a]
++
      String
listRequired
    String -> State (Map Language String) ()
english (String -> State (Map Language String) ())
-> String -> State (Map Language String) ()
forall a b. (a -> b) -> a -> b
$
      String
"The names or order of required modules was changed. " String -> ShowS
forall a. [a] -> [a] -> [a]
++
      String
"They have to be defined with exactly the following names and order: " String -> ShowS
forall a. [a] -> [a] -> [a]
++
      String
listRequired
  | String
"Helper" String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
moduleNames = State (Map Language String) () -> GenericLangM Language m ()
reject (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) ()
german (String -> State (Map Language String) ())
-> String -> State (Map Language String) ()
forall a b. (a -> b) -> a -> b
$
      String
"Eines der zusätzlichen Module wurde mit Namen \"Helper\" definiert. " String -> ShowS
forall a. [a] -> [a] -> [a]
++
      String
"Dieser Name ist für ein internes Modul reserviert."
    String -> State (Map Language String) ()
english (String -> State (Map Language String) ())
-> String -> State (Map Language String) ()
forall a b. (a -> b) -> a -> b
$
      String
"An additional Module was defined as \"Helper\". " String -> ShowS
forall a. [a] -> [a] -> [a]
++
      String
"This name is reserved for internal use."
  | (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
required) [String]
moduleNames = State (Map Language String) () -> GenericLangM Language m ()
reject (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) ()
german String
"Eines der Zusatzmodule wurde wie ein festes Modul benannt."
    String -> State (Map Language String) ()
english String
"An additional module has the same name as a required one."
  | [String] -> [String]
forall a. Ord a => [a] -> [a]
nubOrd [String]
moduleNames [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
/= [String]
moduleNames = State (Map Language String) () -> GenericLangM Language m ()
reject (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) ()
german String
"Mindestens zwei Zusatzmodule haben den gleichen Namen."
    String -> State (Map Language String) ()
english String
"At least two additional modules use the same name."
  | Bool
otherwise = () -> GenericLangM Language m ()
forall a. a -> GenericLangM Language m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  where
    reject :: State (Map Language String) () -> GenericLangM Language m ()
reject = GenericLangM Language m () -> GenericLangM Language m ()
forall l (m :: * -> *).
GenericOutputCapable l m =>
GenericLangM l m () -> GenericLangM l m ()
refuse (GenericLangM Language m () -> GenericLangM Language m ())
-> (State (Map Language String) () -> GenericLangM Language m ())
-> State (Map Language String) ()
-> GenericLangM Language m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericLangM Language m () -> GenericLangM Language m ()
forall l (m :: * -> *).
GenericOutputCapable l m =>
GenericLangM l m () -> GenericLangM l m ()
indent (GenericLangM Language m () -> GenericLangM Language m ())
-> (State (Map Language String) () -> GenericLangM Language m ())
-> State (Map Language String) ()
-> GenericLangM Language m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State (Map Language String) () -> GenericLangM Language m ()
forall l (m :: * -> *).
GenericOutputCapable l m =>
State (Map l String) () -> GenericLangM l m ()
translate
    moduleNames :: [String]
moduleNames = ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> a
fst [(String, String)]
extraModules
    required :: [String]
required = [String
"Global",String
"TaskSettings",String
"TaskData",String
"Description",String
"Parse",String
"Check"]
    requiredConfig :: [String]
requiredConfig = [String] -> [String]
forall a. [a] -> [a]
dropEnd1 [String]
required
    listRequired :: String
listRequired = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
requiredConfig
    requiredNames :: [String]
requiredNames = (String -> Maybe String) -> [String] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (((String, String) -> String)
-> Maybe (String, String) -> Maybe String
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, String) -> String
forall a b. (a, b) -> a
fst (Maybe (String, String) -> Maybe String)
-> (String -> Maybe (String, String)) -> String -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe (String, String)
getModName)
      [ String
globalModule
      , String
settingsModule
      , String
taskDataModule
      , String
descriptionModule
      , String
parseModule
      ]