{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# 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.Char                         (isAscii, isLetter)
import Data.List.Extra (
  dropEnd1,
  intercalate,
  isPrefixOf,
  notNull,
  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,
    many1,
    manyTill,
    option,
    satisfy,
    string,
    skipMany,
    try,
    sepBy,
    space,
    spaces,
    )
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
taskName          ::  String, -- ^ A task identifier used as a label for file caching
    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)]
taskName :: CommonModules -> String
globalModule :: CommonModules -> String
settingsModule :: CommonModules -> String
descriptionModule :: CommonModules -> String
parseModule :: CommonModules -> String
extraModules :: CommonModules -> [(String, String)]
taskName :: 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
"taskName: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
taskName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\r\n" | String -> Bool
forall a. [a] -> Bool
notNull String
taskName] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
      [ 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
taskName <- String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"" (ParsecT String () Identity String
 -> ParsecT String () Identity String)
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall a b. (a -> b) -> a -> b
$ ParsecT String () Identity String
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT String () Identity String
forall {u}. ParsecT String u Identity String
parsePathSegment
    [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
taskName :: String
taskName :: String
taskName,
              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 {u} {a}.
ParsecT String u Identity a -> ParsecT String u Identity ()
discard ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
endOfLine
      ParsecT String u Identity () -> ParsecT String u Identity ()
forall {u} {a}.
ParsecT String u Identity a -> ParsecT String u Identity a
lexeme (ParsecT String u Identity () -> ParsecT String u Identity ())
-> ParsecT String u Identity () -> 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 String
-> ParsecT String u Identity () -> ParsecT String u Identity ()
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String u Identity Char -> ParsecT String u Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (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 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

    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

    parsePathSegment :: ParsecT String u Identity String
parsePathSegment = do
      ParsecT String u Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
      String -> ParsecT String u Identity ()
forall {u}. String -> ParsecT String u Identity ()
discardString String
"taskName"
      String -> ParsecT String u Identity ()
forall {u}. String -> ParsecT String u Identity ()
discardString String
":"
      String
path <- ParsecT String u Identity String
-> ParsecT String u Identity String
forall {u} {a}.
ParsecT String u Identity a -> ParsecT String u Identity a
lexeme (ParsecT String u Identity String
 -> ParsecT String u Identity String)
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ ParsecT String u Identity Char -> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT String u Identity Char
 -> ParsecT String u Identity String)
-> ParsecT String u Identity Char
-> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy ((Char -> Bool) -> ParsecT String u Identity Char)
-> (Char -> Bool) -> ParsecT String u Identity Char
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool -> Bool)
-> (Char -> Bool) -> (Char -> Bool) -> Char -> Bool
forall a b c.
(a -> b -> c) -> (Char -> a) -> (Char -> b) -> Char -> c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(&&) Char -> Bool
isAscii Char -> Bool
isLetter
      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
$ 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
space (ParsecT String u Identity () -> ParsecT String u Identity String)
-> ParsecT String u Identity () -> ParsecT String u Identity String
forall a b. (a -> b) -> a -> b
$ 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 ()
forall {u}. ParsecT String u Identity ()
atLeastThree
      ParsecT String u Identity ()
forall {u}. ParsecT String u Identity ()
atLeastThree
      String -> ParsecT String u Identity String
forall a. a -> ParsecT String u Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
path

    -- the Parsec provided 'spaces' parser also parses newline characters
    parseSpace :: ParsecT String u Identity ()
parseSpace = 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']
    lexeme :: ParsecT String u Identity a -> ParsecT String u Identity a
lexeme = (ParsecT String u Identity a
-> ParsecT String u Identity () -> ParsecT String u Identity a
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String u Identity ()
forall {u}. ParsecT String u Identity ()
parseSpace)
    discard :: ParsecT String u Identity a -> ParsecT String u Identity ()
discard = ParsecT String u Identity a -> ParsecT String u Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String u Identity a -> ParsecT String u Identity ())
-> (ParsecT String u Identity a -> ParsecT String u Identity a)
-> ParsecT String u Identity a
-> ParsecT String u Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT String u Identity a -> ParsecT String u Identity a
forall {u} {a}.
ParsecT String u Identity a -> ParsecT String u Identity a
lexeme
    discardString :: String -> ParsecT String u Identity ()
discardString = ParsecT String u Identity String -> ParsecT String u Identity ()
forall {u} {a}.
ParsecT String u Identity a -> ParsecT String u Identity ()
discard (ParsecT String u Identity String -> ParsecT String u Identity ())
-> (String -> ParsecT String u Identity String)
-> String
-> ParsecT String u Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string


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)]
taskName :: CommonModules -> String
globalModule :: CommonModules -> String
settingsModule :: CommonModules -> String
descriptionModule :: CommonModules -> String
parseModule :: CommonModules -> String
extraModules :: CommonModules -> [(String, String)]
taskName :: 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
      ]