{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TupleSections #-}
module Haskell.Template.Task (
  FSolutionConfig (..),
  SolutionConfig,
  check,
  defaultCode,
  defaultSolutionConfig,
  finaliseConfigs,
  getCodeWorldButtonOption,
  getCodeWorldRenderButtonOption,
  getCodeWorldPartialRenderButtonOption,
  getHlintFeedback,
  grade,
  matchTemplate,
  maybeSampleSolution,
  parse,
  rejectHint,
  rejectMatch,
  toSolutionConfigOpt,
  unsafeTemplateSegment,
  ) where

import qualified Data.ByteString.Char8            as BS
import qualified Language.Haskell.Exts            as E
import qualified Language.Haskell.Exts.Parser     as P
import qualified System.IO                        as IO {- required to avoid encoding problems -}
import qualified Data.String.Interpolate          as SI (i, iii)

import Haskell.Template.FileContents    (testHelperContents, testHarnessContents)
import Haskell.Template.Match
  (Location (..), Result (..), What (..), Where (..), highlight_ssi)
import qualified Haskell.Template.Match as Match (test)

import Control.Applicative              ((<|>))
import Control.Monad                    (forM, guard, msum, unless, void, when)
import Control.Monad.Extra              ((&&^), whenJust)
import Control.Monad.IO.Class           (MonadIO)
import Data.Char                        (isUpper)
import Data.Functor.Identity            (Identity (..))
import Data.List
  (delete, elemIndex, groupBy, intercalate, isInfixOf, isPrefixOf,
   union,
   )
import Data.List.Extra
  (genericTake, nubOrd, replace, takeEnd, takeWhileEnd)
import Data.Maybe                       (fromMaybe)
import Data.Text.Lazy                   (pack)
import Data.Typeable                    (Typeable)
import Data.Yaml
  (FromJSON, ParseException, ToJSON, decodeEither')
import Data.Yaml.Pretty
  (defConfig, encodePretty, setConfCompare)
import GHC.Generics                     (Generic (..))
import Language.Haskell.HLint           (hlint)
import Language.Haskell.Interpreter
  (GhcError (..), InterpreterError (..), MonadInterpreter, OptionVal (..),
   Extension(UnknownExtension), as, installedModulesInScope, interpret, languageExtensions, liftIO,
   loadModules, reset, runInterpreter, set, setImports, setTopLevelModules, searchPath)
import Language.Haskell.Interpreter.Unsafe
  (unsafeRunInterpreterWithArgs)
import Numeric.Natural                  (Natural)
import System.FilePath (
  (<.>),
  (</>),
  pathSeparator,
  takeBaseName,
  takeExtension,
  )
import Test.HUnit                       (Counts (..))
import Text.PrettyPrint.Leijen.Text
  (Doc, (<+>), empty, int, linebreak, nest, punctuate, text, vcat)
import Text.Read                        (readMaybe)
import Text.Regex.PCRE.Heavy            (re, sub)

encode :: ToJSON a => a -> BS.ByteString
encode :: forall a. ToJSON a => a -> ByteString
encode = Config -> a -> ByteString
forall a. ToJSON a => Config -> a -> ByteString
encodePretty (Config -> a -> ByteString) -> Config -> a -> ByteString
forall a b. (a -> b) -> a -> b
$ (Text -> Text -> Ordering) -> Config -> Config
setConfCompare Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Config
defConfig

defaultCode :: String
defaultCode :: String
defaultCode = ByteString -> String
BS.unpack (SolutionConfigOpt -> ByteString
forall a. ToJSON a => a -> ByteString
encode SolutionConfigOpt
defaultSolutionConfig) String -> String -> String
forall a. [a] -> [a] -> [a]
++
  [SI.i|\#\#\#\#\# parameter description:
\# allowAdding                 - allow adding program parts
\# allowModifying              - allow modifying program parts
\# allowRemoving               - allow removing program parts
\# addCodeWorldButton          - adds a button to transfer student visible code
\#                               into the CodeWorld editor
\# addCodeWorldRenderButton    - adds a button to transfer student visible code
\#                               into the CodeWorld runner
\# addCodeWorldPartialRenderButton - adds a button to transfer student visible
\#                                   code into the CodeWorld runner with
\#                                   preview for code containing 'undefined'
\# configGhcLimit              - caps amount of GHC warnings/errors to display
\# configGhcErrors             - GHC warnings to enforce
\# configGhcWarnings           - GHC warnings to provide as hints
\# configHlintSuggestionsLimit - caps amount of hlint suggestions to display
\# configHlintErrors           - hlint hints to enforce, only first one encountered is displayed
\# configHlintGroups           - hlint extra hint groups to use
\# configHlintRules            - hlint extra hint rules to use
\# configHlintSuggestions      - hlint hints to provide as suggestions
\# configLanguageExtensions    - this sets LanguageExtensions for hlint as well
\# maxLineLength               - submissions with lines longer than this value are rejected
\# syntaxCutoff                - determines the last step in the syntax phase (later steps are considered semantics);
\#                               possible values (and also the order of steps):
\#                                 CodeWidth, Compilation, GhcErrors, HlintErrors, TemplateMatch, TestSuite
\#                               default on omission is TemplateMatch; steps after TestSuite are (in this order):
\#                                 GhcWarnings, HlintSuggestions
\# disableSemantics            - will prevent the semantics phase (as determined by syntaxCutoff) from running;
\#                               this means a submission will be accepted after passing the syntax phase
\# provideSampleSolution       - display provided sample solution to students after semantics feedback
\# rigorousValidation          - will run all tests configured for submissions on the provided sample solution
\#                               (no effect if there is none);
\#                               this should be set while configuring the task and disabled after,
\#                               in order to reduce wait times for students
\# messageOnCloningSampleSolution - compare provided sample solution with submission and output
\#                                  this message as feedback if the submission contains the sample solution
\#                                  (provideSampleSolution will be ignored if the submission is a clone)
----------
module Solution where
import Prelude

r :: [a] -> [a]
r = undefined

----------
{- You can add additional modules separated by lines of three or more dashes: -}
{-\# LANGUAGE ScopedTypeVariables \#-}
module Test (test) where
import Prelude
{-
If this module is present, Test.test is used to check the submission.
Otherwise, Solution.test is used.

'test' has to be Test.HUnit.Testable, so assertions build with (@?=) will work,
as do plain 'Bool's.
If your test suite comprises more than a single assertion, you should use a list
of named test cases (see (~:)) to provide better feedback.

Example:
-}
import TestHelper (qc)
import TestHarness
import Test.HUnit (Test, (@?=), (~:))

import qualified Solution

test :: [Test]
test =
  ["Test with QuickCheck (random input)" ~:
     qc 5000 $ \\(xs :: [Int]) ->
       Solution.r xs == Prelude.reverse xs
  ]
----------
module SampleSolution where
import Prelude

{-
This module may provide a sample solution.
Including it is currently optional, but strongly encouraged,
as the sample will be validated the same way a student's submission would,
thus preventing a broken configuration or impossible task.
-}

r :: [a] -> [a]
r = reverse

----------
module SomeHiddenModule where
import Prelude
{- This module is also not shown to the student but is available to the code -}
{-
Also available are the following modules:

  TestHelper   (Import this in Solution or Test)
    (Use either of the following instead of 'quickCheck' to turn a property into a HUnit assertion.)
    qcWithArgs :: Testable prop => Int -> Args -> prop -> Assertion
      (Provide a timeout (in ms) and Arbitrary QuickCheck Args)
    qc'        :: Testable prop => Int -> Int -> prop -> Assertion
      (Provide a timeout (in ms) and a number for 'maxSuccess')
    qc         :: Testable prop => Int -> prop -> Assertion
      (Provide a timeout (in ms))

  TestHarness  (Import this in Test)
    syntaxCheck :: (Module SrcSpanInfo -> Assertion) -> Assertion
    findTopLevelDeclsOf :: String -> Module SrcSpanInfo -> [Decl SrcSpanInfo]
    contains
    ident :: String -> Name SrcSpanInfo -> Bool
      (Used to implement syntax checks. Example usage: see above)

    allowFailures :: Int -> [Test] -> Assertion
      (Detailed output of correct/incorrect Tests in case of failure,
      with the option to allow a fixed number of tests to fail.)
 -}|]

data FeedbackPhase
  = CodeWidth
  | Compilation
  | GhcErrors
  | HlintErrors
  | TemplateMatch
  | TestSuite
  deriving (Int -> FeedbackPhase
FeedbackPhase -> Int
FeedbackPhase -> [FeedbackPhase]
FeedbackPhase -> FeedbackPhase
FeedbackPhase -> FeedbackPhase -> [FeedbackPhase]
FeedbackPhase -> FeedbackPhase -> FeedbackPhase -> [FeedbackPhase]
(FeedbackPhase -> FeedbackPhase)
-> (FeedbackPhase -> FeedbackPhase)
-> (Int -> FeedbackPhase)
-> (FeedbackPhase -> Int)
-> (FeedbackPhase -> [FeedbackPhase])
-> (FeedbackPhase -> FeedbackPhase -> [FeedbackPhase])
-> (FeedbackPhase -> FeedbackPhase -> [FeedbackPhase])
-> (FeedbackPhase
    -> FeedbackPhase -> FeedbackPhase -> [FeedbackPhase])
-> Enum FeedbackPhase
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: FeedbackPhase -> FeedbackPhase
succ :: FeedbackPhase -> FeedbackPhase
$cpred :: FeedbackPhase -> FeedbackPhase
pred :: FeedbackPhase -> FeedbackPhase
$ctoEnum :: Int -> FeedbackPhase
toEnum :: Int -> FeedbackPhase
$cfromEnum :: FeedbackPhase -> Int
fromEnum :: FeedbackPhase -> Int
$cenumFrom :: FeedbackPhase -> [FeedbackPhase]
enumFrom :: FeedbackPhase -> [FeedbackPhase]
$cenumFromThen :: FeedbackPhase -> FeedbackPhase -> [FeedbackPhase]
enumFromThen :: FeedbackPhase -> FeedbackPhase -> [FeedbackPhase]
$cenumFromTo :: FeedbackPhase -> FeedbackPhase -> [FeedbackPhase]
enumFromTo :: FeedbackPhase -> FeedbackPhase -> [FeedbackPhase]
$cenumFromThenTo :: FeedbackPhase -> FeedbackPhase -> FeedbackPhase -> [FeedbackPhase]
enumFromThenTo :: FeedbackPhase -> FeedbackPhase -> FeedbackPhase -> [FeedbackPhase]
Enum, FeedbackPhase -> FeedbackPhase -> Bool
(FeedbackPhase -> FeedbackPhase -> Bool)
-> (FeedbackPhase -> FeedbackPhase -> Bool) -> Eq FeedbackPhase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FeedbackPhase -> FeedbackPhase -> Bool
== :: FeedbackPhase -> FeedbackPhase -> Bool
$c/= :: FeedbackPhase -> FeedbackPhase -> Bool
/= :: FeedbackPhase -> FeedbackPhase -> Bool
Eq, (forall x. FeedbackPhase -> Rep FeedbackPhase x)
-> (forall x. Rep FeedbackPhase x -> FeedbackPhase)
-> Generic FeedbackPhase
forall x. Rep FeedbackPhase x -> FeedbackPhase
forall x. FeedbackPhase -> Rep FeedbackPhase x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FeedbackPhase -> Rep FeedbackPhase x
from :: forall x. FeedbackPhase -> Rep FeedbackPhase x
$cto :: forall x. Rep FeedbackPhase x -> FeedbackPhase
to :: forall x. Rep FeedbackPhase x -> FeedbackPhase
Generic, Int -> FeedbackPhase -> String -> String
[FeedbackPhase] -> String -> String
FeedbackPhase -> String
(Int -> FeedbackPhase -> String -> String)
-> (FeedbackPhase -> String)
-> ([FeedbackPhase] -> String -> String)
-> Show FeedbackPhase
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> FeedbackPhase -> String -> String
showsPrec :: Int -> FeedbackPhase -> String -> String
$cshow :: FeedbackPhase -> String
show :: FeedbackPhase -> String
$cshowList :: [FeedbackPhase] -> String -> String
showList :: [FeedbackPhase] -> String -> String
Show, Value -> Parser [FeedbackPhase]
Value -> Parser FeedbackPhase
(Value -> Parser FeedbackPhase)
-> (Value -> Parser [FeedbackPhase]) -> FromJSON FeedbackPhase
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser FeedbackPhase
parseJSON :: Value -> Parser FeedbackPhase
$cparseJSONList :: Value -> Parser [FeedbackPhase]
parseJSONList :: Value -> Parser [FeedbackPhase]
FromJSON, [FeedbackPhase] -> Value
[FeedbackPhase] -> Encoding
FeedbackPhase -> Value
FeedbackPhase -> Encoding
(FeedbackPhase -> Value)
-> (FeedbackPhase -> Encoding)
-> ([FeedbackPhase] -> Value)
-> ([FeedbackPhase] -> Encoding)
-> ToJSON FeedbackPhase
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: FeedbackPhase -> Value
toJSON :: FeedbackPhase -> Value
$ctoEncoding :: FeedbackPhase -> Encoding
toEncoding :: FeedbackPhase -> Encoding
$ctoJSONList :: [FeedbackPhase] -> Value
toJSONList :: [FeedbackPhase] -> Value
$ctoEncodingList :: [FeedbackPhase] -> Encoding
toEncodingList :: [FeedbackPhase] -> Encoding
ToJSON)

data FSolutionConfig m = SolutionConfig {
    forall (m :: * -> *). FSolutionConfig m -> m Bool
allowAdding                 :: m Bool,
    forall (m :: * -> *). FSolutionConfig m -> m Bool
allowModifying              :: m Bool,
    forall (m :: * -> *). FSolutionConfig m -> m Bool
allowRemoving               :: m Bool,
    forall (m :: * -> *). FSolutionConfig m -> m Bool
addCodeWorldButton          :: m Bool,
    forall (m :: * -> *). FSolutionConfig m -> m Bool
addCodeWorldRenderButton    :: m Bool,
    forall (m :: * -> *). FSolutionConfig m -> m Bool
addCodeWorldPartialRenderButton :: m Bool,
    forall (m :: * -> *). FSolutionConfig m -> m (Maybe Natural)
configGhcLimit              :: m (Maybe Natural),
    forall (m :: * -> *). FSolutionConfig m -> m [String]
configGhcErrors             :: m [String],
    forall (m :: * -> *). FSolutionConfig m -> m [String]
configGhcWarnings           :: m [String],
    forall (m :: * -> *). FSolutionConfig m -> m (Maybe Natural)
configHlintSuggestionsLimit :: m (Maybe Natural),
    forall (m :: * -> *). FSolutionConfig m -> m [String]
configHlintErrors           :: m [String],
    forall (m :: * -> *). FSolutionConfig m -> m [String]
configHlintGroups           :: m [String],
    forall (m :: * -> *). FSolutionConfig m -> m [String]
configHlintRules            :: m [String],
    forall (m :: * -> *). FSolutionConfig m -> m [String]
configHlintSuggestions      :: m [String],
    forall (m :: * -> *). FSolutionConfig m -> m [String]
configLanguageExtensions    :: m [String],
    forall (m :: * -> *). FSolutionConfig m -> m (Maybe Natural)
maxLineLength               :: m (Maybe Natural),
    forall (m :: * -> *). FSolutionConfig m -> m Bool
provideSampleSolution       :: m Bool,
    forall (m :: * -> *). FSolutionConfig m -> m (Maybe String)
messageOnCloningSampleSolution :: m (Maybe String),
    forall (m :: * -> *). FSolutionConfig m -> m Bool
disableSemantics            :: m Bool,
    forall (m :: * -> *). FSolutionConfig m -> m Bool
rigorousValidation          :: m Bool,
    forall (m :: * -> *). FSolutionConfig m -> m FeedbackPhase
syntaxCutoff                :: m FeedbackPhase
  } deriving (forall x. FSolutionConfig m -> Rep (FSolutionConfig m) x)
-> (forall x. Rep (FSolutionConfig m) x -> FSolutionConfig m)
-> Generic (FSolutionConfig m)
forall x. Rep (FSolutionConfig m) x -> FSolutionConfig m
forall x. FSolutionConfig m -> Rep (FSolutionConfig m) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (m :: * -> *) x.
Rep (FSolutionConfig m) x -> FSolutionConfig m
forall (m :: * -> *) x.
FSolutionConfig m -> Rep (FSolutionConfig m) x
$cfrom :: forall (m :: * -> *) x.
FSolutionConfig m -> Rep (FSolutionConfig m) x
from :: forall x. FSolutionConfig m -> Rep (FSolutionConfig m) x
$cto :: forall (m :: * -> *) x.
Rep (FSolutionConfig m) x -> FSolutionConfig m
to :: forall x. Rep (FSolutionConfig m) x -> FSolutionConfig m
Generic

type SolutionConfigOpt = FSolutionConfig Maybe

deriving instance Show SolutionConfigOpt
deriving instance FromJSON SolutionConfigOpt
deriving instance ToJSON SolutionConfigOpt

type SolutionConfig  = FSolutionConfig Identity

deriving instance Show SolutionConfig

defaultSolutionConfig :: SolutionConfigOpt
defaultSolutionConfig :: SolutionConfigOpt
defaultSolutionConfig = SolutionConfig {
    allowAdding :: Maybe Bool
allowAdding                 = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True,
    allowModifying :: Maybe Bool
allowModifying              = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False,
    allowRemoving :: Maybe Bool
allowRemoving               = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False,
    addCodeWorldButton :: Maybe Bool
addCodeWorldButton          = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True,
    addCodeWorldRenderButton :: Maybe Bool
addCodeWorldRenderButton    = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True,
    addCodeWorldPartialRenderButton :: Maybe Bool
addCodeWorldPartialRenderButton = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False,
    configGhcLimit :: Maybe (Maybe Natural)
configGhcLimit              = Maybe Natural -> Maybe (Maybe Natural)
forall a. a -> Maybe a
Just Maybe Natural
forall a. Maybe a
Nothing,
    configGhcErrors :: Maybe [String]
configGhcErrors             = [String] -> Maybe [String]
forall a. a -> Maybe a
Just [],
    configGhcWarnings :: Maybe [String]
configGhcWarnings           = [String] -> Maybe [String]
forall a. a -> Maybe a
Just [],
    configHlintSuggestionsLimit :: Maybe (Maybe Natural)
configHlintSuggestionsLimit = Maybe Natural -> Maybe (Maybe Natural)
forall a. a -> Maybe a
Just Maybe Natural
forall a. Maybe a
Nothing,
    configHlintErrors :: Maybe [String]
configHlintErrors           = [String] -> Maybe [String]
forall a. a -> Maybe a
Just [],
    configHlintGroups :: Maybe [String]
configHlintGroups           = [String] -> Maybe [String]
forall a. a -> Maybe a
Just [],
    configHlintRules :: Maybe [String]
configHlintRules            = [String] -> Maybe [String]
forall a. a -> Maybe a
Just [],
    configHlintSuggestions :: Maybe [String]
configHlintSuggestions      = [String] -> Maybe [String]
forall a. a -> Maybe a
Just [],
    configLanguageExtensions :: Maybe [String]
configLanguageExtensions    = [String] -> Maybe [String]
forall a. a -> Maybe a
Just [String
"NPlusKPatterns",String
"ScopedTypeVariables"],
    maxLineLength :: Maybe (Maybe Natural)
maxLineLength               = Maybe Natural -> Maybe (Maybe Natural)
forall a. a -> Maybe a
Just Maybe Natural
forall a. Maybe a
Nothing,
    provideSampleSolution :: Maybe Bool
provideSampleSolution       = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False,
    messageOnCloningSampleSolution :: Maybe (Maybe String)
messageOnCloningSampleSolution = Maybe String -> Maybe (Maybe String)
forall a. a -> Maybe a
Just Maybe String
forall a. Maybe a
Nothing,
    disableSemantics :: Maybe Bool
disableSemantics            = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False,
    rigorousValidation :: Maybe Bool
rigorousValidation          = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False,
    syntaxCutoff :: Maybe FeedbackPhase
syntaxCutoff                = FeedbackPhase -> Maybe FeedbackPhase
forall a. a -> Maybe a
Just FeedbackPhase
TemplateMatch
  }

toSolutionConfigOpt :: SolutionConfig -> SolutionConfigOpt
toSolutionConfigOpt :: SolutionConfig -> SolutionConfigOpt
toSolutionConfigOpt SolutionConfig {Identity Bool
Identity [String]
Identity (Maybe Natural)
Identity (Maybe String)
Identity FeedbackPhase
allowAdding :: forall (m :: * -> *). FSolutionConfig m -> m Bool
allowModifying :: forall (m :: * -> *). FSolutionConfig m -> m Bool
allowRemoving :: forall (m :: * -> *). FSolutionConfig m -> m Bool
addCodeWorldButton :: forall (m :: * -> *). FSolutionConfig m -> m Bool
addCodeWorldRenderButton :: forall (m :: * -> *). FSolutionConfig m -> m Bool
addCodeWorldPartialRenderButton :: forall (m :: * -> *). FSolutionConfig m -> m Bool
configGhcLimit :: forall (m :: * -> *). FSolutionConfig m -> m (Maybe Natural)
configGhcErrors :: forall (m :: * -> *). FSolutionConfig m -> m [String]
configGhcWarnings :: forall (m :: * -> *). FSolutionConfig m -> m [String]
configHlintSuggestionsLimit :: forall (m :: * -> *). FSolutionConfig m -> m (Maybe Natural)
configHlintErrors :: forall (m :: * -> *). FSolutionConfig m -> m [String]
configHlintGroups :: forall (m :: * -> *). FSolutionConfig m -> m [String]
configHlintRules :: forall (m :: * -> *). FSolutionConfig m -> m [String]
configHlintSuggestions :: forall (m :: * -> *). FSolutionConfig m -> m [String]
configLanguageExtensions :: forall (m :: * -> *). FSolutionConfig m -> m [String]
maxLineLength :: forall (m :: * -> *). FSolutionConfig m -> m (Maybe Natural)
provideSampleSolution :: forall (m :: * -> *). FSolutionConfig m -> m Bool
messageOnCloningSampleSolution :: forall (m :: * -> *). FSolutionConfig m -> m (Maybe String)
disableSemantics :: forall (m :: * -> *). FSolutionConfig m -> m Bool
rigorousValidation :: forall (m :: * -> *). FSolutionConfig m -> m Bool
syntaxCutoff :: forall (m :: * -> *). FSolutionConfig m -> m FeedbackPhase
allowAdding :: Identity Bool
allowModifying :: Identity Bool
allowRemoving :: Identity Bool
addCodeWorldButton :: Identity Bool
addCodeWorldRenderButton :: Identity Bool
addCodeWorldPartialRenderButton :: Identity Bool
configGhcLimit :: Identity (Maybe Natural)
configGhcErrors :: Identity [String]
configGhcWarnings :: Identity [String]
configHlintSuggestionsLimit :: Identity (Maybe Natural)
configHlintErrors :: Identity [String]
configHlintGroups :: Identity [String]
configHlintRules :: Identity [String]
configHlintSuggestions :: Identity [String]
configLanguageExtensions :: Identity [String]
maxLineLength :: Identity (Maybe Natural)
provideSampleSolution :: Identity Bool
messageOnCloningSampleSolution :: Identity (Maybe String)
disableSemantics :: Identity Bool
rigorousValidation :: Identity Bool
syntaxCutoff :: Identity FeedbackPhase
..} = Identity SolutionConfigOpt -> SolutionConfigOpt
forall a. Identity a -> a
runIdentity (Identity SolutionConfigOpt -> SolutionConfigOpt)
-> Identity SolutionConfigOpt -> SolutionConfigOpt
forall a b. (a -> b) -> a -> b
$ Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe (Maybe Natural)
-> Maybe [String]
-> Maybe [String]
-> Maybe (Maybe Natural)
-> Maybe [String]
-> Maybe [String]
-> Maybe [String]
-> Maybe [String]
-> Maybe [String]
-> Maybe (Maybe Natural)
-> Maybe Bool
-> Maybe (Maybe String)
-> Maybe Bool
-> Maybe Bool
-> Maybe FeedbackPhase
-> SolutionConfigOpt
forall (m :: * -> *).
m Bool
-> m Bool
-> m Bool
-> m Bool
-> m Bool
-> m Bool
-> m (Maybe Natural)
-> m [String]
-> m [String]
-> m (Maybe Natural)
-> m [String]
-> m [String]
-> m [String]
-> m [String]
-> m [String]
-> m (Maybe Natural)
-> m Bool
-> m (Maybe String)
-> m Bool
-> m Bool
-> m FeedbackPhase
-> FSolutionConfig m
SolutionConfig
  (Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe (Maybe Natural)
 -> Maybe [String]
 -> Maybe [String]
 -> Maybe (Maybe Natural)
 -> Maybe [String]
 -> Maybe [String]
 -> Maybe [String]
 -> Maybe [String]
 -> Maybe [String]
 -> Maybe (Maybe Natural)
 -> Maybe Bool
 -> Maybe (Maybe String)
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe FeedbackPhase
 -> SolutionConfigOpt)
-> Identity (Maybe Bool)
-> Identity
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe (Maybe Natural)
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe (Maybe Natural)
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe (Maybe Natural)
      -> Maybe Bool
      -> Maybe (Maybe String)
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe FeedbackPhase
      -> SolutionConfigOpt)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool -> Maybe Bool) -> Identity Bool -> Identity (Maybe Bool)
forall a b. (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Maybe Bool
forall a. a -> Maybe a
Just Identity Bool
allowAdding
  Identity
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe (Maybe Natural)
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe (Maybe Natural)
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe (Maybe Natural)
   -> Maybe Bool
   -> Maybe (Maybe String)
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe FeedbackPhase
   -> SolutionConfigOpt)
-> Identity (Maybe Bool)
-> Identity
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe (Maybe Natural)
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe (Maybe Natural)
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe (Maybe Natural)
      -> Maybe Bool
      -> Maybe (Maybe String)
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe FeedbackPhase
      -> SolutionConfigOpt)
forall a b. Identity (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool -> Maybe Bool) -> Identity Bool -> Identity (Maybe Bool)
forall a b. (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Maybe Bool
forall a. a -> Maybe a
Just Identity Bool
allowModifying
  Identity
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe (Maybe Natural)
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe (Maybe Natural)
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe (Maybe Natural)
   -> Maybe Bool
   -> Maybe (Maybe String)
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe FeedbackPhase
   -> SolutionConfigOpt)
-> Identity (Maybe Bool)
-> Identity
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe (Maybe Natural)
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe (Maybe Natural)
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe (Maybe Natural)
      -> Maybe Bool
      -> Maybe (Maybe String)
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe FeedbackPhase
      -> SolutionConfigOpt)
forall a b. Identity (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool -> Maybe Bool) -> Identity Bool -> Identity (Maybe Bool)
forall a b. (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Maybe Bool
forall a. a -> Maybe a
Just Identity Bool
allowRemoving
  Identity
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe (Maybe Natural)
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe (Maybe Natural)
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe (Maybe Natural)
   -> Maybe Bool
   -> Maybe (Maybe String)
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe FeedbackPhase
   -> SolutionConfigOpt)
-> Identity (Maybe Bool)
-> Identity
     (Maybe Bool
      -> Maybe Bool
      -> Maybe (Maybe Natural)
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe (Maybe Natural)
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe (Maybe Natural)
      -> Maybe Bool
      -> Maybe (Maybe String)
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe FeedbackPhase
      -> SolutionConfigOpt)
forall a b. Identity (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool -> Maybe Bool) -> Identity Bool -> Identity (Maybe Bool)
forall a b. (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Maybe Bool
forall a. a -> Maybe a
Just Identity Bool
addCodeWorldButton
  Identity
  (Maybe Bool
   -> Maybe Bool
   -> Maybe (Maybe Natural)
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe (Maybe Natural)
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe (Maybe Natural)
   -> Maybe Bool
   -> Maybe (Maybe String)
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe FeedbackPhase
   -> SolutionConfigOpt)
-> Identity (Maybe Bool)
-> Identity
     (Maybe Bool
      -> Maybe (Maybe Natural)
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe (Maybe Natural)
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe (Maybe Natural)
      -> Maybe Bool
      -> Maybe (Maybe String)
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe FeedbackPhase
      -> SolutionConfigOpt)
forall a b. Identity (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool -> Maybe Bool) -> Identity Bool -> Identity (Maybe Bool)
forall a b. (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Maybe Bool
forall a. a -> Maybe a
Just Identity Bool
addCodeWorldRenderButton
  Identity
  (Maybe Bool
   -> Maybe (Maybe Natural)
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe (Maybe Natural)
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe (Maybe Natural)
   -> Maybe Bool
   -> Maybe (Maybe String)
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe FeedbackPhase
   -> SolutionConfigOpt)
-> Identity (Maybe Bool)
-> Identity
     (Maybe (Maybe Natural)
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe (Maybe Natural)
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe (Maybe Natural)
      -> Maybe Bool
      -> Maybe (Maybe String)
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe FeedbackPhase
      -> SolutionConfigOpt)
forall a b. Identity (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool -> Maybe Bool) -> Identity Bool -> Identity (Maybe Bool)
forall a b. (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Maybe Bool
forall a. a -> Maybe a
Just Identity Bool
addCodeWorldPartialRenderButton
  Identity
  (Maybe (Maybe Natural)
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe (Maybe Natural)
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe (Maybe Natural)
   -> Maybe Bool
   -> Maybe (Maybe String)
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe FeedbackPhase
   -> SolutionConfigOpt)
-> Identity (Maybe (Maybe Natural))
-> Identity
     (Maybe [String]
      -> Maybe [String]
      -> Maybe (Maybe Natural)
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe (Maybe Natural)
      -> Maybe Bool
      -> Maybe (Maybe String)
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe FeedbackPhase
      -> SolutionConfigOpt)
forall a b. Identity (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe Natural -> Maybe (Maybe Natural))
-> Identity (Maybe Natural) -> Identity (Maybe (Maybe Natural))
forall a b. (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Natural -> Maybe (Maybe Natural)
forall a. a -> Maybe a
Just Identity (Maybe Natural)
configGhcLimit
  Identity
  (Maybe [String]
   -> Maybe [String]
   -> Maybe (Maybe Natural)
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe (Maybe Natural)
   -> Maybe Bool
   -> Maybe (Maybe String)
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe FeedbackPhase
   -> SolutionConfigOpt)
-> Identity (Maybe [String])
-> Identity
     (Maybe [String]
      -> Maybe (Maybe Natural)
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe (Maybe Natural)
      -> Maybe Bool
      -> Maybe (Maybe String)
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe FeedbackPhase
      -> SolutionConfigOpt)
forall a b. Identity (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([String] -> Maybe [String])
-> Identity [String] -> Identity (Maybe [String])
forall a b. (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> Maybe [String]
forall a. a -> Maybe a
Just Identity [String]
configGhcErrors
  Identity
  (Maybe [String]
   -> Maybe (Maybe Natural)
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe (Maybe Natural)
   -> Maybe Bool
   -> Maybe (Maybe String)
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe FeedbackPhase
   -> SolutionConfigOpt)
-> Identity (Maybe [String])
-> Identity
     (Maybe (Maybe Natural)
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe (Maybe Natural)
      -> Maybe Bool
      -> Maybe (Maybe String)
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe FeedbackPhase
      -> SolutionConfigOpt)
forall a b. Identity (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([String] -> Maybe [String])
-> Identity [String] -> Identity (Maybe [String])
forall a b. (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> Maybe [String]
forall a. a -> Maybe a
Just Identity [String]
configGhcWarnings
  Identity
  (Maybe (Maybe Natural)
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe (Maybe Natural)
   -> Maybe Bool
   -> Maybe (Maybe String)
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe FeedbackPhase
   -> SolutionConfigOpt)
-> Identity (Maybe (Maybe Natural))
-> Identity
     (Maybe [String]
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe (Maybe Natural)
      -> Maybe Bool
      -> Maybe (Maybe String)
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe FeedbackPhase
      -> SolutionConfigOpt)
forall a b. Identity (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe Natural -> Maybe (Maybe Natural))
-> Identity (Maybe Natural) -> Identity (Maybe (Maybe Natural))
forall a b. (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Natural -> Maybe (Maybe Natural)
forall a. a -> Maybe a
Just Identity (Maybe Natural)
configHlintSuggestionsLimit
  Identity
  (Maybe [String]
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe (Maybe Natural)
   -> Maybe Bool
   -> Maybe (Maybe String)
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe FeedbackPhase
   -> SolutionConfigOpt)
-> Identity (Maybe [String])
-> Identity
     (Maybe [String]
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe (Maybe Natural)
      -> Maybe Bool
      -> Maybe (Maybe String)
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe FeedbackPhase
      -> SolutionConfigOpt)
forall a b. Identity (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([String] -> Maybe [String])
-> Identity [String] -> Identity (Maybe [String])
forall a b. (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> Maybe [String]
forall a. a -> Maybe a
Just Identity [String]
configHlintErrors
  Identity
  (Maybe [String]
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe (Maybe Natural)
   -> Maybe Bool
   -> Maybe (Maybe String)
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe FeedbackPhase
   -> SolutionConfigOpt)
-> Identity (Maybe [String])
-> Identity
     (Maybe [String]
      -> Maybe [String]
      -> Maybe [String]
      -> Maybe (Maybe Natural)
      -> Maybe Bool
      -> Maybe (Maybe String)
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe FeedbackPhase
      -> SolutionConfigOpt)
forall a b. Identity (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([String] -> Maybe [String])
-> Identity [String] -> Identity (Maybe [String])
forall a b. (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> Maybe [String]
forall a. a -> Maybe a
Just Identity [String]
configHlintGroups
  Identity
  (Maybe [String]
   -> Maybe [String]
   -> Maybe [String]
   -> Maybe (Maybe Natural)
   -> Maybe Bool
   -> Maybe (Maybe String)
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe FeedbackPhase
   -> SolutionConfigOpt)
-> Identity (Maybe [String])
-> Identity
     (Maybe [String]
      -> Maybe [String]
      -> Maybe (Maybe Natural)
      -> Maybe Bool
      -> Maybe (Maybe String)
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe FeedbackPhase
      -> SolutionConfigOpt)
forall a b. Identity (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([String] -> Maybe [String])
-> Identity [String] -> Identity (Maybe [String])
forall a b. (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> Maybe [String]
forall a. a -> Maybe a
Just Identity [String]
configHlintRules
  Identity
  (Maybe [String]
   -> Maybe [String]
   -> Maybe (Maybe Natural)
   -> Maybe Bool
   -> Maybe (Maybe String)
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe FeedbackPhase
   -> SolutionConfigOpt)
-> Identity (Maybe [String])
-> Identity
     (Maybe [String]
      -> Maybe (Maybe Natural)
      -> Maybe Bool
      -> Maybe (Maybe String)
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe FeedbackPhase
      -> SolutionConfigOpt)
forall a b. Identity (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([String] -> Maybe [String])
-> Identity [String] -> Identity (Maybe [String])
forall a b. (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> Maybe [String]
forall a. a -> Maybe a
Just Identity [String]
configHlintSuggestions
  Identity
  (Maybe [String]
   -> Maybe (Maybe Natural)
   -> Maybe Bool
   -> Maybe (Maybe String)
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe FeedbackPhase
   -> SolutionConfigOpt)
-> Identity (Maybe [String])
-> Identity
     (Maybe (Maybe Natural)
      -> Maybe Bool
      -> Maybe (Maybe String)
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe FeedbackPhase
      -> SolutionConfigOpt)
forall a b. Identity (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([String] -> Maybe [String])
-> Identity [String] -> Identity (Maybe [String])
forall a b. (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> Maybe [String]
forall a. a -> Maybe a
Just Identity [String]
configLanguageExtensions
  Identity
  (Maybe (Maybe Natural)
   -> Maybe Bool
   -> Maybe (Maybe String)
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe FeedbackPhase
   -> SolutionConfigOpt)
-> Identity (Maybe (Maybe Natural))
-> Identity
     (Maybe Bool
      -> Maybe (Maybe String)
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe FeedbackPhase
      -> SolutionConfigOpt)
forall a b. Identity (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe Natural -> Maybe (Maybe Natural))
-> Identity (Maybe Natural) -> Identity (Maybe (Maybe Natural))
forall a b. (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Natural -> Maybe (Maybe Natural)
forall a. a -> Maybe a
Just Identity (Maybe Natural)
maxLineLength
  Identity
  (Maybe Bool
   -> Maybe (Maybe String)
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe FeedbackPhase
   -> SolutionConfigOpt)
-> Identity (Maybe Bool)
-> Identity
     (Maybe (Maybe String)
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe FeedbackPhase
      -> SolutionConfigOpt)
forall a b. Identity (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool -> Maybe Bool) -> Identity Bool -> Identity (Maybe Bool)
forall a b. (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Maybe Bool
forall a. a -> Maybe a
Just Identity Bool
provideSampleSolution
  Identity
  (Maybe (Maybe String)
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe FeedbackPhase
   -> SolutionConfigOpt)
-> Identity (Maybe (Maybe String))
-> Identity
     (Maybe Bool
      -> Maybe Bool -> Maybe FeedbackPhase -> SolutionConfigOpt)
forall a b. Identity (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe String -> Maybe (Maybe String))
-> Identity (Maybe String) -> Identity (Maybe (Maybe String))
forall a b. (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe String -> Maybe (Maybe String)
forall a. a -> Maybe a
Just Identity (Maybe String)
messageOnCloningSampleSolution
  Identity
  (Maybe Bool
   -> Maybe Bool -> Maybe FeedbackPhase -> SolutionConfigOpt)
-> Identity (Maybe Bool)
-> Identity
     (Maybe Bool -> Maybe FeedbackPhase -> SolutionConfigOpt)
forall a b. Identity (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool -> Maybe Bool) -> Identity Bool -> Identity (Maybe Bool)
forall a b. (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Maybe Bool
forall a. a -> Maybe a
Just Identity Bool
disableSemantics
  Identity (Maybe Bool -> Maybe FeedbackPhase -> SolutionConfigOpt)
-> Identity (Maybe Bool)
-> Identity (Maybe FeedbackPhase -> SolutionConfigOpt)
forall a b. Identity (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool -> Maybe Bool) -> Identity Bool -> Identity (Maybe Bool)
forall a b. (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Maybe Bool
forall a. a -> Maybe a
Just Identity Bool
rigorousValidation
  Identity (Maybe FeedbackPhase -> SolutionConfigOpt)
-> Identity (Maybe FeedbackPhase) -> Identity SolutionConfigOpt
forall a b. Identity (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (FeedbackPhase -> Maybe FeedbackPhase)
-> Identity FeedbackPhase -> Identity (Maybe FeedbackPhase)
forall a b. (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FeedbackPhase -> Maybe FeedbackPhase
forall a. a -> Maybe a
Just Identity FeedbackPhase
syntaxCutoff

finaliseConfigs :: [SolutionConfigOpt] -> Maybe SolutionConfig
finaliseConfigs :: [SolutionConfigOpt] -> Maybe SolutionConfig
finaliseConfigs = SolutionConfigOpt -> Maybe SolutionConfig
finaliseConfig (SolutionConfigOpt -> Maybe SolutionConfig)
-> ([SolutionConfigOpt] -> SolutionConfigOpt)
-> [SolutionConfigOpt]
-> Maybe SolutionConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SolutionConfigOpt -> SolutionConfigOpt -> SolutionConfigOpt)
-> SolutionConfigOpt -> [SolutionConfigOpt] -> SolutionConfigOpt
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl SolutionConfigOpt -> SolutionConfigOpt -> SolutionConfigOpt
forall {m :: * -> *}.
Alternative m =>
FSolutionConfig m -> FSolutionConfig m -> FSolutionConfig m
combineConfigs SolutionConfigOpt
emptyConfig
  where
    finaliseConfig :: SolutionConfigOpt -> Maybe SolutionConfig
    finaliseConfig :: SolutionConfigOpt -> Maybe SolutionConfig
finaliseConfig SolutionConfig {Maybe Bool
Maybe [String]
Maybe (Maybe Natural)
Maybe (Maybe String)
Maybe FeedbackPhase
allowAdding :: forall (m :: * -> *). FSolutionConfig m -> m Bool
allowModifying :: forall (m :: * -> *). FSolutionConfig m -> m Bool
allowRemoving :: forall (m :: * -> *). FSolutionConfig m -> m Bool
addCodeWorldButton :: forall (m :: * -> *). FSolutionConfig m -> m Bool
addCodeWorldRenderButton :: forall (m :: * -> *). FSolutionConfig m -> m Bool
addCodeWorldPartialRenderButton :: forall (m :: * -> *). FSolutionConfig m -> m Bool
configGhcLimit :: forall (m :: * -> *). FSolutionConfig m -> m (Maybe Natural)
configGhcErrors :: forall (m :: * -> *). FSolutionConfig m -> m [String]
configGhcWarnings :: forall (m :: * -> *). FSolutionConfig m -> m [String]
configHlintSuggestionsLimit :: forall (m :: * -> *). FSolutionConfig m -> m (Maybe Natural)
configHlintErrors :: forall (m :: * -> *). FSolutionConfig m -> m [String]
configHlintGroups :: forall (m :: * -> *). FSolutionConfig m -> m [String]
configHlintRules :: forall (m :: * -> *). FSolutionConfig m -> m [String]
configHlintSuggestions :: forall (m :: * -> *). FSolutionConfig m -> m [String]
configLanguageExtensions :: forall (m :: * -> *). FSolutionConfig m -> m [String]
maxLineLength :: forall (m :: * -> *). FSolutionConfig m -> m (Maybe Natural)
provideSampleSolution :: forall (m :: * -> *). FSolutionConfig m -> m Bool
messageOnCloningSampleSolution :: forall (m :: * -> *). FSolutionConfig m -> m (Maybe String)
disableSemantics :: forall (m :: * -> *). FSolutionConfig m -> m Bool
rigorousValidation :: forall (m :: * -> *). FSolutionConfig m -> m Bool
syntaxCutoff :: forall (m :: * -> *). FSolutionConfig m -> m FeedbackPhase
allowAdding :: Maybe Bool
allowModifying :: Maybe Bool
allowRemoving :: Maybe Bool
addCodeWorldButton :: Maybe Bool
addCodeWorldRenderButton :: Maybe Bool
addCodeWorldPartialRenderButton :: Maybe Bool
configGhcLimit :: Maybe (Maybe Natural)
configGhcErrors :: Maybe [String]
configGhcWarnings :: Maybe [String]
configHlintSuggestionsLimit :: Maybe (Maybe Natural)
configHlintErrors :: Maybe [String]
configHlintGroups :: Maybe [String]
configHlintRules :: Maybe [String]
configHlintSuggestions :: Maybe [String]
configLanguageExtensions :: Maybe [String]
maxLineLength :: Maybe (Maybe Natural)
provideSampleSolution :: Maybe Bool
messageOnCloningSampleSolution :: Maybe (Maybe String)
disableSemantics :: Maybe Bool
rigorousValidation :: Maybe Bool
syntaxCutoff :: Maybe FeedbackPhase
..} = Identity Bool
-> Identity Bool
-> Identity Bool
-> Identity Bool
-> Identity Bool
-> Identity Bool
-> Identity (Maybe Natural)
-> Identity [String]
-> Identity [String]
-> Identity (Maybe Natural)
-> Identity [String]
-> Identity [String]
-> Identity [String]
-> Identity [String]
-> Identity [String]
-> Identity (Maybe Natural)
-> Identity Bool
-> Identity (Maybe String)
-> Identity Bool
-> Identity Bool
-> Identity FeedbackPhase
-> SolutionConfig
forall (m :: * -> *).
m Bool
-> m Bool
-> m Bool
-> m Bool
-> m Bool
-> m Bool
-> m (Maybe Natural)
-> m [String]
-> m [String]
-> m (Maybe Natural)
-> m [String]
-> m [String]
-> m [String]
-> m [String]
-> m [String]
-> m (Maybe Natural)
-> m Bool
-> m (Maybe String)
-> m Bool
-> m Bool
-> m FeedbackPhase
-> FSolutionConfig m
SolutionConfig
      (Identity Bool
 -> Identity Bool
 -> Identity Bool
 -> Identity Bool
 -> Identity Bool
 -> Identity Bool
 -> Identity (Maybe Natural)
 -> Identity [String]
 -> Identity [String]
 -> Identity (Maybe Natural)
 -> Identity [String]
 -> Identity [String]
 -> Identity [String]
 -> Identity [String]
 -> Identity [String]
 -> Identity (Maybe Natural)
 -> Identity Bool
 -> Identity (Maybe String)
 -> Identity Bool
 -> Identity Bool
 -> Identity FeedbackPhase
 -> SolutionConfig)
-> Maybe (Identity Bool)
-> Maybe
     (Identity Bool
      -> Identity Bool
      -> Identity Bool
      -> Identity Bool
      -> Identity Bool
      -> Identity (Maybe Natural)
      -> Identity [String]
      -> Identity [String]
      -> Identity (Maybe Natural)
      -> Identity [String]
      -> Identity [String]
      -> Identity [String]
      -> Identity [String]
      -> Identity [String]
      -> Identity (Maybe Natural)
      -> Identity Bool
      -> Identity (Maybe String)
      -> Identity Bool
      -> Identity Bool
      -> Identity FeedbackPhase
      -> SolutionConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool -> Identity Bool) -> Maybe Bool -> Maybe (Identity Bool)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Identity Bool
forall a. a -> Identity a
Identity Maybe Bool
allowAdding
      Maybe
  (Identity Bool
   -> Identity Bool
   -> Identity Bool
   -> Identity Bool
   -> Identity Bool
   -> Identity (Maybe Natural)
   -> Identity [String]
   -> Identity [String]
   -> Identity (Maybe Natural)
   -> Identity [String]
   -> Identity [String]
   -> Identity [String]
   -> Identity [String]
   -> Identity [String]
   -> Identity (Maybe Natural)
   -> Identity Bool
   -> Identity (Maybe String)
   -> Identity Bool
   -> Identity Bool
   -> Identity FeedbackPhase
   -> SolutionConfig)
-> Maybe (Identity Bool)
-> Maybe
     (Identity Bool
      -> Identity Bool
      -> Identity Bool
      -> Identity Bool
      -> Identity (Maybe Natural)
      -> Identity [String]
      -> Identity [String]
      -> Identity (Maybe Natural)
      -> Identity [String]
      -> Identity [String]
      -> Identity [String]
      -> Identity [String]
      -> Identity [String]
      -> Identity (Maybe Natural)
      -> Identity Bool
      -> Identity (Maybe String)
      -> Identity Bool
      -> Identity Bool
      -> Identity FeedbackPhase
      -> SolutionConfig)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool -> Identity Bool) -> Maybe Bool -> Maybe (Identity Bool)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Identity Bool
forall a. a -> Identity a
Identity Maybe Bool
allowModifying
      Maybe
  (Identity Bool
   -> Identity Bool
   -> Identity Bool
   -> Identity Bool
   -> Identity (Maybe Natural)
   -> Identity [String]
   -> Identity [String]
   -> Identity (Maybe Natural)
   -> Identity [String]
   -> Identity [String]
   -> Identity [String]
   -> Identity [String]
   -> Identity [String]
   -> Identity (Maybe Natural)
   -> Identity Bool
   -> Identity (Maybe String)
   -> Identity Bool
   -> Identity Bool
   -> Identity FeedbackPhase
   -> SolutionConfig)
-> Maybe (Identity Bool)
-> Maybe
     (Identity Bool
      -> Identity Bool
      -> Identity Bool
      -> Identity (Maybe Natural)
      -> Identity [String]
      -> Identity [String]
      -> Identity (Maybe Natural)
      -> Identity [String]
      -> Identity [String]
      -> Identity [String]
      -> Identity [String]
      -> Identity [String]
      -> Identity (Maybe Natural)
      -> Identity Bool
      -> Identity (Maybe String)
      -> Identity Bool
      -> Identity Bool
      -> Identity FeedbackPhase
      -> SolutionConfig)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool -> Identity Bool) -> Maybe Bool -> Maybe (Identity Bool)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Identity Bool
forall a. a -> Identity a
Identity Maybe Bool
allowRemoving
      Maybe
  (Identity Bool
   -> Identity Bool
   -> Identity Bool
   -> Identity (Maybe Natural)
   -> Identity [String]
   -> Identity [String]
   -> Identity (Maybe Natural)
   -> Identity [String]
   -> Identity [String]
   -> Identity [String]
   -> Identity [String]
   -> Identity [String]
   -> Identity (Maybe Natural)
   -> Identity Bool
   -> Identity (Maybe String)
   -> Identity Bool
   -> Identity Bool
   -> Identity FeedbackPhase
   -> SolutionConfig)
-> Maybe (Identity Bool)
-> Maybe
     (Identity Bool
      -> Identity Bool
      -> Identity (Maybe Natural)
      -> Identity [String]
      -> Identity [String]
      -> Identity (Maybe Natural)
      -> Identity [String]
      -> Identity [String]
      -> Identity [String]
      -> Identity [String]
      -> Identity [String]
      -> Identity (Maybe Natural)
      -> Identity Bool
      -> Identity (Maybe String)
      -> Identity Bool
      -> Identity Bool
      -> Identity FeedbackPhase
      -> SolutionConfig)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool -> Identity Bool) -> Maybe Bool -> Maybe (Identity Bool)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Identity Bool
forall a. a -> Identity a
Identity Maybe Bool
addCodeWorldButton
      Maybe
  (Identity Bool
   -> Identity Bool
   -> Identity (Maybe Natural)
   -> Identity [String]
   -> Identity [String]
   -> Identity (Maybe Natural)
   -> Identity [String]
   -> Identity [String]
   -> Identity [String]
   -> Identity [String]
   -> Identity [String]
   -> Identity (Maybe Natural)
   -> Identity Bool
   -> Identity (Maybe String)
   -> Identity Bool
   -> Identity Bool
   -> Identity FeedbackPhase
   -> SolutionConfig)
-> Maybe (Identity Bool)
-> Maybe
     (Identity Bool
      -> Identity (Maybe Natural)
      -> Identity [String]
      -> Identity [String]
      -> Identity (Maybe Natural)
      -> Identity [String]
      -> Identity [String]
      -> Identity [String]
      -> Identity [String]
      -> Identity [String]
      -> Identity (Maybe Natural)
      -> Identity Bool
      -> Identity (Maybe String)
      -> Identity Bool
      -> Identity Bool
      -> Identity FeedbackPhase
      -> SolutionConfig)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool -> Identity Bool) -> Maybe Bool -> Maybe (Identity Bool)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Identity Bool
forall a. a -> Identity a
Identity Maybe Bool
addCodeWorldRenderButton
      Maybe
  (Identity Bool
   -> Identity (Maybe Natural)
   -> Identity [String]
   -> Identity [String]
   -> Identity (Maybe Natural)
   -> Identity [String]
   -> Identity [String]
   -> Identity [String]
   -> Identity [String]
   -> Identity [String]
   -> Identity (Maybe Natural)
   -> Identity Bool
   -> Identity (Maybe String)
   -> Identity Bool
   -> Identity Bool
   -> Identity FeedbackPhase
   -> SolutionConfig)
-> Maybe (Identity Bool)
-> Maybe
     (Identity (Maybe Natural)
      -> Identity [String]
      -> Identity [String]
      -> Identity (Maybe Natural)
      -> Identity [String]
      -> Identity [String]
      -> Identity [String]
      -> Identity [String]
      -> Identity [String]
      -> Identity (Maybe Natural)
      -> Identity Bool
      -> Identity (Maybe String)
      -> Identity Bool
      -> Identity Bool
      -> Identity FeedbackPhase
      -> SolutionConfig)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool -> Identity Bool) -> Maybe Bool -> Maybe (Identity Bool)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Identity Bool
forall a. a -> Identity a
Identity Maybe Bool
addCodeWorldPartialRenderButton
      Maybe
  (Identity (Maybe Natural)
   -> Identity [String]
   -> Identity [String]
   -> Identity (Maybe Natural)
   -> Identity [String]
   -> Identity [String]
   -> Identity [String]
   -> Identity [String]
   -> Identity [String]
   -> Identity (Maybe Natural)
   -> Identity Bool
   -> Identity (Maybe String)
   -> Identity Bool
   -> Identity Bool
   -> Identity FeedbackPhase
   -> SolutionConfig)
-> Maybe (Identity (Maybe Natural))
-> Maybe
     (Identity [String]
      -> Identity [String]
      -> Identity (Maybe Natural)
      -> Identity [String]
      -> Identity [String]
      -> Identity [String]
      -> Identity [String]
      -> Identity [String]
      -> Identity (Maybe Natural)
      -> Identity Bool
      -> Identity (Maybe String)
      -> Identity Bool
      -> Identity Bool
      -> Identity FeedbackPhase
      -> SolutionConfig)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe Natural -> Identity (Maybe Natural))
-> Maybe (Maybe Natural) -> Maybe (Identity (Maybe Natural))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Natural -> Identity (Maybe Natural)
forall a. a -> Identity a
Identity Maybe (Maybe Natural)
configGhcLimit
      Maybe
  (Identity [String]
   -> Identity [String]
   -> Identity (Maybe Natural)
   -> Identity [String]
   -> Identity [String]
   -> Identity [String]
   -> Identity [String]
   -> Identity [String]
   -> Identity (Maybe Natural)
   -> Identity Bool
   -> Identity (Maybe String)
   -> Identity Bool
   -> Identity Bool
   -> Identity FeedbackPhase
   -> SolutionConfig)
-> Maybe (Identity [String])
-> Maybe
     (Identity [String]
      -> Identity (Maybe Natural)
      -> Identity [String]
      -> Identity [String]
      -> Identity [String]
      -> Identity [String]
      -> Identity [String]
      -> Identity (Maybe Natural)
      -> Identity Bool
      -> Identity (Maybe String)
      -> Identity Bool
      -> Identity Bool
      -> Identity FeedbackPhase
      -> SolutionConfig)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([String] -> Identity [String])
-> Maybe [String] -> Maybe (Identity [String])
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> Identity [String]
forall a. a -> Identity a
Identity Maybe [String]
configGhcErrors
      Maybe
  (Identity [String]
   -> Identity (Maybe Natural)
   -> Identity [String]
   -> Identity [String]
   -> Identity [String]
   -> Identity [String]
   -> Identity [String]
   -> Identity (Maybe Natural)
   -> Identity Bool
   -> Identity (Maybe String)
   -> Identity Bool
   -> Identity Bool
   -> Identity FeedbackPhase
   -> SolutionConfig)
-> Maybe (Identity [String])
-> Maybe
     (Identity (Maybe Natural)
      -> Identity [String]
      -> Identity [String]
      -> Identity [String]
      -> Identity [String]
      -> Identity [String]
      -> Identity (Maybe Natural)
      -> Identity Bool
      -> Identity (Maybe String)
      -> Identity Bool
      -> Identity Bool
      -> Identity FeedbackPhase
      -> SolutionConfig)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([String] -> Identity [String])
-> Maybe [String] -> Maybe (Identity [String])
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> Identity [String]
forall a. a -> Identity a
Identity Maybe [String]
configGhcWarnings
      Maybe
  (Identity (Maybe Natural)
   -> Identity [String]
   -> Identity [String]
   -> Identity [String]
   -> Identity [String]
   -> Identity [String]
   -> Identity (Maybe Natural)
   -> Identity Bool
   -> Identity (Maybe String)
   -> Identity Bool
   -> Identity Bool
   -> Identity FeedbackPhase
   -> SolutionConfig)
-> Maybe (Identity (Maybe Natural))
-> Maybe
     (Identity [String]
      -> Identity [String]
      -> Identity [String]
      -> Identity [String]
      -> Identity [String]
      -> Identity (Maybe Natural)
      -> Identity Bool
      -> Identity (Maybe String)
      -> Identity Bool
      -> Identity Bool
      -> Identity FeedbackPhase
      -> SolutionConfig)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe Natural -> Identity (Maybe Natural))
-> Maybe (Maybe Natural) -> Maybe (Identity (Maybe Natural))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Natural -> Identity (Maybe Natural)
forall a. a -> Identity a
Identity Maybe (Maybe Natural)
configHlintSuggestionsLimit
      Maybe
  (Identity [String]
   -> Identity [String]
   -> Identity [String]
   -> Identity [String]
   -> Identity [String]
   -> Identity (Maybe Natural)
   -> Identity Bool
   -> Identity (Maybe String)
   -> Identity Bool
   -> Identity Bool
   -> Identity FeedbackPhase
   -> SolutionConfig)
-> Maybe (Identity [String])
-> Maybe
     (Identity [String]
      -> Identity [String]
      -> Identity [String]
      -> Identity [String]
      -> Identity (Maybe Natural)
      -> Identity Bool
      -> Identity (Maybe String)
      -> Identity Bool
      -> Identity Bool
      -> Identity FeedbackPhase
      -> SolutionConfig)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([String] -> Identity [String])
-> Maybe [String] -> Maybe (Identity [String])
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> Identity [String]
forall a. a -> Identity a
Identity Maybe [String]
configHlintErrors
      Maybe
  (Identity [String]
   -> Identity [String]
   -> Identity [String]
   -> Identity [String]
   -> Identity (Maybe Natural)
   -> Identity Bool
   -> Identity (Maybe String)
   -> Identity Bool
   -> Identity Bool
   -> Identity FeedbackPhase
   -> SolutionConfig)
-> Maybe (Identity [String])
-> Maybe
     (Identity [String]
      -> Identity [String]
      -> Identity [String]
      -> Identity (Maybe Natural)
      -> Identity Bool
      -> Identity (Maybe String)
      -> Identity Bool
      -> Identity Bool
      -> Identity FeedbackPhase
      -> SolutionConfig)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([String] -> Identity [String])
-> Maybe [String] -> Maybe (Identity [String])
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> Identity [String]
forall a. a -> Identity a
Identity Maybe [String]
configHlintGroups
      Maybe
  (Identity [String]
   -> Identity [String]
   -> Identity [String]
   -> Identity (Maybe Natural)
   -> Identity Bool
   -> Identity (Maybe String)
   -> Identity Bool
   -> Identity Bool
   -> Identity FeedbackPhase
   -> SolutionConfig)
-> Maybe (Identity [String])
-> Maybe
     (Identity [String]
      -> Identity [String]
      -> Identity (Maybe Natural)
      -> Identity Bool
      -> Identity (Maybe String)
      -> Identity Bool
      -> Identity Bool
      -> Identity FeedbackPhase
      -> SolutionConfig)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([String] -> Identity [String])
-> Maybe [String] -> Maybe (Identity [String])
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> Identity [String]
forall a. a -> Identity a
Identity Maybe [String]
configHlintRules
      Maybe
  (Identity [String]
   -> Identity [String]
   -> Identity (Maybe Natural)
   -> Identity Bool
   -> Identity (Maybe String)
   -> Identity Bool
   -> Identity Bool
   -> Identity FeedbackPhase
   -> SolutionConfig)
-> Maybe (Identity [String])
-> Maybe
     (Identity [String]
      -> Identity (Maybe Natural)
      -> Identity Bool
      -> Identity (Maybe String)
      -> Identity Bool
      -> Identity Bool
      -> Identity FeedbackPhase
      -> SolutionConfig)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([String] -> Identity [String])
-> Maybe [String] -> Maybe (Identity [String])
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> Identity [String]
forall a. a -> Identity a
Identity Maybe [String]
configHlintSuggestions
      Maybe
  (Identity [String]
   -> Identity (Maybe Natural)
   -> Identity Bool
   -> Identity (Maybe String)
   -> Identity Bool
   -> Identity Bool
   -> Identity FeedbackPhase
   -> SolutionConfig)
-> Maybe (Identity [String])
-> Maybe
     (Identity (Maybe Natural)
      -> Identity Bool
      -> Identity (Maybe String)
      -> Identity Bool
      -> Identity Bool
      -> Identity FeedbackPhase
      -> SolutionConfig)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([String] -> Identity [String])
-> Maybe [String] -> Maybe (Identity [String])
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> Identity [String]
forall a. a -> Identity a
Identity Maybe [String]
configLanguageExtensions
      Maybe
  (Identity (Maybe Natural)
   -> Identity Bool
   -> Identity (Maybe String)
   -> Identity Bool
   -> Identity Bool
   -> Identity FeedbackPhase
   -> SolutionConfig)
-> Maybe (Identity (Maybe Natural))
-> Maybe
     (Identity Bool
      -> Identity (Maybe String)
      -> Identity Bool
      -> Identity Bool
      -> Identity FeedbackPhase
      -> SolutionConfig)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe Natural -> Identity (Maybe Natural))
-> Maybe (Maybe Natural) -> Maybe (Identity (Maybe Natural))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Natural -> Identity (Maybe Natural)
forall a. a -> Identity a
Identity Maybe (Maybe Natural)
maxLineLength
      Maybe
  (Identity Bool
   -> Identity (Maybe String)
   -> Identity Bool
   -> Identity Bool
   -> Identity FeedbackPhase
   -> SolutionConfig)
-> Maybe (Identity Bool)
-> Maybe
     (Identity (Maybe String)
      -> Identity Bool
      -> Identity Bool
      -> Identity FeedbackPhase
      -> SolutionConfig)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool -> Identity Bool) -> Maybe Bool -> Maybe (Identity Bool)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Identity Bool
forall a. a -> Identity a
Identity Maybe Bool
provideSampleSolution
      Maybe
  (Identity (Maybe String)
   -> Identity Bool
   -> Identity Bool
   -> Identity FeedbackPhase
   -> SolutionConfig)
-> Maybe (Identity (Maybe String))
-> Maybe
     (Identity Bool
      -> Identity Bool -> Identity FeedbackPhase -> SolutionConfig)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe String -> Identity (Maybe String))
-> Maybe (Maybe String) -> Maybe (Identity (Maybe String))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe String -> Identity (Maybe String)
forall a. a -> Identity a
Identity Maybe (Maybe String)
messageOnCloningSampleSolution
      Maybe
  (Identity Bool
   -> Identity Bool -> Identity FeedbackPhase -> SolutionConfig)
-> Maybe (Identity Bool)
-> Maybe
     (Identity Bool -> Identity FeedbackPhase -> SolutionConfig)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool -> Identity Bool) -> Maybe Bool -> Maybe (Identity Bool)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Identity Bool
forall a. a -> Identity a
Identity Maybe Bool
disableSemantics
      Maybe (Identity Bool -> Identity FeedbackPhase -> SolutionConfig)
-> Maybe (Identity Bool)
-> Maybe (Identity FeedbackPhase -> SolutionConfig)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool -> Identity Bool) -> Maybe Bool -> Maybe (Identity Bool)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Identity Bool
forall a. a -> Identity a
Identity Maybe Bool
rigorousValidation
      Maybe (Identity FeedbackPhase -> SolutionConfig)
-> Maybe (Identity FeedbackPhase) -> Maybe SolutionConfig
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (FeedbackPhase -> Identity FeedbackPhase)
-> Maybe FeedbackPhase -> Maybe (Identity FeedbackPhase)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FeedbackPhase -> Identity FeedbackPhase
forall a. a -> Identity a
Identity Maybe FeedbackPhase
syntaxCutoff
    combineConfigs :: FSolutionConfig m -> FSolutionConfig m -> FSolutionConfig m
combineConfigs FSolutionConfig m
x FSolutionConfig m
y = SolutionConfig {
        allowAdding :: m Bool
allowAdding                 = FSolutionConfig m -> m Bool
forall (m :: * -> *). FSolutionConfig m -> m Bool
allowAdding                 FSolutionConfig m
x m Bool -> m Bool -> m Bool
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FSolutionConfig m -> m Bool
forall (m :: * -> *). FSolutionConfig m -> m Bool
allowAdding                 FSolutionConfig m
y,
        allowModifying :: m Bool
allowModifying              = FSolutionConfig m -> m Bool
forall (m :: * -> *). FSolutionConfig m -> m Bool
allowModifying              FSolutionConfig m
x m Bool -> m Bool -> m Bool
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FSolutionConfig m -> m Bool
forall (m :: * -> *). FSolutionConfig m -> m Bool
allowModifying              FSolutionConfig m
y,
        allowRemoving :: m Bool
allowRemoving               = FSolutionConfig m -> m Bool
forall (m :: * -> *). FSolutionConfig m -> m Bool
allowRemoving               FSolutionConfig m
x m Bool -> m Bool -> m Bool
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FSolutionConfig m -> m Bool
forall (m :: * -> *). FSolutionConfig m -> m Bool
allowRemoving               FSolutionConfig m
y,
        addCodeWorldButton :: m Bool
addCodeWorldButton          = FSolutionConfig m -> m Bool
forall (m :: * -> *). FSolutionConfig m -> m Bool
addCodeWorldButton          FSolutionConfig m
x m Bool -> m Bool -> m Bool
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FSolutionConfig m -> m Bool
forall (m :: * -> *). FSolutionConfig m -> m Bool
addCodeWorldButton          FSolutionConfig m
y,
        addCodeWorldRenderButton :: m Bool
addCodeWorldRenderButton    = FSolutionConfig m -> m Bool
forall (m :: * -> *). FSolutionConfig m -> m Bool
addCodeWorldRenderButton    FSolutionConfig m
x m Bool -> m Bool -> m Bool
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FSolutionConfig m -> m Bool
forall (m :: * -> *). FSolutionConfig m -> m Bool
addCodeWorldRenderButton    FSolutionConfig m
y,
        addCodeWorldPartialRenderButton :: m Bool
addCodeWorldPartialRenderButton = FSolutionConfig m -> m Bool
forall (m :: * -> *). FSolutionConfig m -> m Bool
addCodeWorldPartialRenderButton FSolutionConfig m
x m Bool -> m Bool -> m Bool
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FSolutionConfig m -> m Bool
forall (m :: * -> *). FSolutionConfig m -> m Bool
addCodeWorldPartialRenderButton FSolutionConfig m
y,
        configGhcLimit :: m (Maybe Natural)
configGhcLimit              = FSolutionConfig m -> m (Maybe Natural)
forall (m :: * -> *). FSolutionConfig m -> m (Maybe Natural)
configGhcLimit              FSolutionConfig m
x m (Maybe Natural) -> m (Maybe Natural) -> m (Maybe Natural)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FSolutionConfig m -> m (Maybe Natural)
forall (m :: * -> *). FSolutionConfig m -> m (Maybe Natural)
configGhcLimit              FSolutionConfig m
y,
        configGhcErrors :: m [String]
configGhcErrors             = FSolutionConfig m -> m [String]
forall (m :: * -> *). FSolutionConfig m -> m [String]
configGhcErrors             FSolutionConfig m
x m [String] -> m [String] -> m [String]
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FSolutionConfig m -> m [String]
forall (m :: * -> *). FSolutionConfig m -> m [String]
configGhcErrors             FSolutionConfig m
y,
        configGhcWarnings :: m [String]
configGhcWarnings           = FSolutionConfig m -> m [String]
forall (m :: * -> *). FSolutionConfig m -> m [String]
configGhcWarnings           FSolutionConfig m
x m [String] -> m [String] -> m [String]
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FSolutionConfig m -> m [String]
forall (m :: * -> *). FSolutionConfig m -> m [String]
configGhcWarnings           FSolutionConfig m
y,
        configHlintSuggestionsLimit :: m (Maybe Natural)
configHlintSuggestionsLimit = FSolutionConfig m -> m (Maybe Natural)
forall (m :: * -> *). FSolutionConfig m -> m (Maybe Natural)
configHlintSuggestionsLimit FSolutionConfig m
x m (Maybe Natural) -> m (Maybe Natural) -> m (Maybe Natural)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FSolutionConfig m -> m (Maybe Natural)
forall (m :: * -> *). FSolutionConfig m -> m (Maybe Natural)
configHlintSuggestionsLimit FSolutionConfig m
y,
        configHlintErrors :: m [String]
configHlintErrors           = FSolutionConfig m -> m [String]
forall (m :: * -> *). FSolutionConfig m -> m [String]
configHlintErrors           FSolutionConfig m
x m [String] -> m [String] -> m [String]
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FSolutionConfig m -> m [String]
forall (m :: * -> *). FSolutionConfig m -> m [String]
configHlintErrors           FSolutionConfig m
y,
        configHlintGroups :: m [String]
configHlintGroups           = FSolutionConfig m -> m [String]
forall (m :: * -> *). FSolutionConfig m -> m [String]
configHlintGroups           FSolutionConfig m
x m [String] -> m [String] -> m [String]
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FSolutionConfig m -> m [String]
forall (m :: * -> *). FSolutionConfig m -> m [String]
configHlintGroups           FSolutionConfig m
y,
        configHlintRules :: m [String]
configHlintRules            = FSolutionConfig m -> m [String]
forall (m :: * -> *). FSolutionConfig m -> m [String]
configHlintRules            FSolutionConfig m
x m [String] -> m [String] -> m [String]
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FSolutionConfig m -> m [String]
forall (m :: * -> *). FSolutionConfig m -> m [String]
configHlintRules            FSolutionConfig m
y,
        configHlintSuggestions :: m [String]
configHlintSuggestions      = FSolutionConfig m -> m [String]
forall (m :: * -> *). FSolutionConfig m -> m [String]
configHlintSuggestions      FSolutionConfig m
x m [String] -> m [String] -> m [String]
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FSolutionConfig m -> m [String]
forall (m :: * -> *). FSolutionConfig m -> m [String]
configHlintSuggestions      FSolutionConfig m
y,
        configLanguageExtensions :: m [String]
configLanguageExtensions    = FSolutionConfig m -> m [String]
forall (m :: * -> *). FSolutionConfig m -> m [String]
configLanguageExtensions    FSolutionConfig m
x m [String] -> m [String] -> m [String]
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FSolutionConfig m -> m [String]
forall (m :: * -> *). FSolutionConfig m -> m [String]
configLanguageExtensions    FSolutionConfig m
y,
        maxLineLength :: m (Maybe Natural)
maxLineLength               = FSolutionConfig m -> m (Maybe Natural)
forall (m :: * -> *). FSolutionConfig m -> m (Maybe Natural)
maxLineLength               FSolutionConfig m
x m (Maybe Natural) -> m (Maybe Natural) -> m (Maybe Natural)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FSolutionConfig m -> m (Maybe Natural)
forall (m :: * -> *). FSolutionConfig m -> m (Maybe Natural)
maxLineLength               FSolutionConfig m
y,
        provideSampleSolution :: m Bool
provideSampleSolution       = FSolutionConfig m -> m Bool
forall (m :: * -> *). FSolutionConfig m -> m Bool
provideSampleSolution       FSolutionConfig m
x m Bool -> m Bool -> m Bool
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FSolutionConfig m -> m Bool
forall (m :: * -> *). FSolutionConfig m -> m Bool
provideSampleSolution       FSolutionConfig m
y,
        messageOnCloningSampleSolution :: m (Maybe String)
messageOnCloningSampleSolution = FSolutionConfig m -> m (Maybe String)
forall (m :: * -> *). FSolutionConfig m -> m (Maybe String)
messageOnCloningSampleSolution FSolutionConfig m
x m (Maybe String) -> m (Maybe String) -> m (Maybe String)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FSolutionConfig m -> m (Maybe String)
forall (m :: * -> *). FSolutionConfig m -> m (Maybe String)
messageOnCloningSampleSolution FSolutionConfig m
y,
        disableSemantics :: m Bool
disableSemantics            = FSolutionConfig m -> m Bool
forall (m :: * -> *). FSolutionConfig m -> m Bool
disableSemantics            FSolutionConfig m
x m Bool -> m Bool -> m Bool
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FSolutionConfig m -> m Bool
forall (m :: * -> *). FSolutionConfig m -> m Bool
disableSemantics            FSolutionConfig m
y,
        rigorousValidation :: m Bool
rigorousValidation          = FSolutionConfig m -> m Bool
forall (m :: * -> *). FSolutionConfig m -> m Bool
rigorousValidation          FSolutionConfig m
x m Bool -> m Bool -> m Bool
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FSolutionConfig m -> m Bool
forall (m :: * -> *). FSolutionConfig m -> m Bool
rigorousValidation          FSolutionConfig m
y,
        syntaxCutoff :: m FeedbackPhase
syntaxCutoff                = FSolutionConfig m -> m FeedbackPhase
forall (m :: * -> *). FSolutionConfig m -> m FeedbackPhase
syntaxCutoff                FSolutionConfig m
x m FeedbackPhase -> m FeedbackPhase -> m FeedbackPhase
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FSolutionConfig m -> m FeedbackPhase
forall (m :: * -> *). FSolutionConfig m -> m FeedbackPhase
syntaxCutoff                FSolutionConfig m
y
      }
    emptyConfig :: SolutionConfigOpt
emptyConfig = SolutionConfig {
        allowAdding :: Maybe Bool
allowAdding                 = Maybe Bool
forall a. Maybe a
Nothing,
        allowRemoving :: Maybe Bool
allowRemoving               = Maybe Bool
forall a. Maybe a
Nothing,
        allowModifying :: Maybe Bool
allowModifying              = Maybe Bool
forall a. Maybe a
Nothing,
        addCodeWorldButton :: Maybe Bool
addCodeWorldButton          = Maybe Bool
forall a. Maybe a
Nothing,
        addCodeWorldRenderButton :: Maybe Bool
addCodeWorldRenderButton    = Maybe Bool
forall a. Maybe a
Nothing,
        addCodeWorldPartialRenderButton :: Maybe Bool
addCodeWorldPartialRenderButton = Maybe Bool
forall a. Maybe a
Nothing,
        configGhcLimit :: Maybe (Maybe Natural)
configGhcLimit              = Maybe (Maybe Natural)
forall a. Maybe a
Nothing,
        configGhcErrors :: Maybe [String]
configGhcErrors             = Maybe [String]
forall a. Maybe a
Nothing,
        configGhcWarnings :: Maybe [String]
configGhcWarnings           = Maybe [String]
forall a. Maybe a
Nothing,
        configHlintSuggestionsLimit :: Maybe (Maybe Natural)
configHlintSuggestionsLimit = Maybe (Maybe Natural)
forall a. Maybe a
Nothing,
        configHlintErrors :: Maybe [String]
configHlintErrors           = Maybe [String]
forall a. Maybe a
Nothing,
        configHlintGroups :: Maybe [String]
configHlintGroups           = Maybe [String]
forall a. Maybe a
Nothing,
        configHlintRules :: Maybe [String]
configHlintRules            = Maybe [String]
forall a. Maybe a
Nothing,
        configHlintSuggestions :: Maybe [String]
configHlintSuggestions      = Maybe [String]
forall a. Maybe a
Nothing,
        configLanguageExtensions :: Maybe [String]
configLanguageExtensions    = Maybe [String]
forall a. Maybe a
Nothing,
        maxLineLength :: Maybe (Maybe Natural)
maxLineLength               = Maybe (Maybe Natural)
forall a. Maybe a
Nothing,
        provideSampleSolution :: Maybe Bool
provideSampleSolution       = Maybe Bool
forall a. Maybe a
Nothing,
        messageOnCloningSampleSolution :: Maybe (Maybe String)
messageOnCloningSampleSolution = Maybe (Maybe String)
forall a. Maybe a
Nothing,
        disableSemantics :: Maybe Bool
disableSemantics            = Maybe Bool
forall a. Maybe a
Nothing,
        rigorousValidation :: Maybe Bool
rigorousValidation          = Maybe Bool
forall a. Maybe a
Nothing,
        syntaxCutoff :: Maybe FeedbackPhase
syntaxCutoff                = Maybe FeedbackPhase
forall a. Maybe a
Nothing
      }

string :: String -> Doc
string :: String -> Doc
string = Text -> Doc
text (Text -> Doc) -> (String -> Text) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack

check
  :: MonadIO m
  => (forall a. Doc -> m a)
  -> (Doc -> m ())
  -> FilePath
  -> String
  -> m ()
check :: forall (m :: * -> *).
MonadIO m =>
(forall a. Doc -> m a) -> (Doc -> m ()) -> String -> String -> m ()
check forall a. Doc -> m a
reject Doc -> m ()
inform String
path String
i = do
  (forall a. Doc -> m a) -> String -> m ()
forall (m :: * -> *).
Monad m =>
(forall a. Doc -> m a) -> String -> m ()
checkUnsafe Doc -> m a
forall a. Doc -> m a
reject String
i
  (config :: SolutionConfig
config@SolutionConfig{Identity Bool
Identity [String]
Identity (Maybe Natural)
Identity (Maybe String)
Identity FeedbackPhase
allowAdding :: forall (m :: * -> *). FSolutionConfig m -> m Bool
allowModifying :: forall (m :: * -> *). FSolutionConfig m -> m Bool
allowRemoving :: forall (m :: * -> *). FSolutionConfig m -> m Bool
addCodeWorldButton :: forall (m :: * -> *). FSolutionConfig m -> m Bool
addCodeWorldRenderButton :: forall (m :: * -> *). FSolutionConfig m -> m Bool
addCodeWorldPartialRenderButton :: forall (m :: * -> *). FSolutionConfig m -> m Bool
configGhcLimit :: forall (m :: * -> *). FSolutionConfig m -> m (Maybe Natural)
configGhcErrors :: forall (m :: * -> *). FSolutionConfig m -> m [String]
configGhcWarnings :: forall (m :: * -> *). FSolutionConfig m -> m [String]
configHlintSuggestionsLimit :: forall (m :: * -> *). FSolutionConfig m -> m (Maybe Natural)
configHlintErrors :: forall (m :: * -> *). FSolutionConfig m -> m [String]
configHlintGroups :: forall (m :: * -> *). FSolutionConfig m -> m [String]
configHlintRules :: forall (m :: * -> *). FSolutionConfig m -> m [String]
configHlintSuggestions :: forall (m :: * -> *). FSolutionConfig m -> m [String]
configLanguageExtensions :: forall (m :: * -> *). FSolutionConfig m -> m [String]
maxLineLength :: forall (m :: * -> *). FSolutionConfig m -> m (Maybe Natural)
provideSampleSolution :: forall (m :: * -> *). FSolutionConfig m -> m Bool
messageOnCloningSampleSolution :: forall (m :: * -> *). FSolutionConfig m -> m (Maybe String)
disableSemantics :: forall (m :: * -> *). FSolutionConfig m -> m Bool
rigorousValidation :: forall (m :: * -> *). FSolutionConfig m -> m Bool
syntaxCutoff :: forall (m :: * -> *). FSolutionConfig m -> m FeedbackPhase
allowAdding :: Identity Bool
allowModifying :: Identity Bool
allowRemoving :: Identity Bool
addCodeWorldButton :: Identity Bool
addCodeWorldRenderButton :: Identity Bool
addCodeWorldPartialRenderButton :: Identity Bool
configGhcLimit :: Identity (Maybe Natural)
configGhcErrors :: Identity [String]
configGhcWarnings :: Identity [String]
configHlintSuggestionsLimit :: Identity (Maybe Natural)
configHlintErrors :: Identity [String]
configHlintGroups :: Identity [String]
configHlintRules :: Identity [String]
configHlintSuggestions :: Identity [String]
configLanguageExtensions :: Identity [String]
maxLineLength :: Identity (Maybe Natural)
provideSampleSolution :: Identity Bool
messageOnCloningSampleSolution :: Identity (Maybe String)
disableSemantics :: Identity Bool
rigorousValidation :: Identity Bool
syntaxCutoff :: Identity FeedbackPhase
..}, [Extension]
exts, (String
m,String
s), [(String, String)]
ms) <- (forall a. Doc -> m a)
-> (Doc -> m ())
-> String
-> m (SolutionConfig, [Extension], (String, String),
      [(String, String)])
forall (m :: * -> *).
Monad m =>
(forall a. Doc -> m a)
-> (Doc -> m ())
-> String
-> m (SolutionConfig, [Extension], (String, String),
      [(String, String)])
processConfig Doc -> m a
forall a. Doc -> m a
reject Doc -> m ()
inform String
i
  [String] -> m ()
forall {a}. Ord a => [a] -> m ()
checkUniqueness (String
m 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) -> a
fst [(String, String)]
ms)
  Doc -> m ()
inform (Doc -> m ()) -> Doc -> m ()
forall a b. (a -> b) -> a -> b
$ String -> Doc
string (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
"Parsing template module " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
m
  m (Module SrcSpanInfo) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Module SrcSpanInfo) -> m ()) -> m (Module SrcSpanInfo) -> m ()
forall a b. (a -> b) -> a -> b
$ (forall a. Doc -> m a)
-> [Extension] -> String -> m (Module SrcSpanInfo)
forall (m :: * -> *).
Monad m =>
(forall a. Doc -> m a)
-> [Extension] -> String -> m (Module SrcSpanInfo)
parse Doc -> m a
forall a. Doc -> m a
reject [Extension]
exts String
s
  (Natural -> m ()) -> Maybe Natural -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((forall a. Doc -> m a) -> String -> Natural -> m ()
forall (m :: * -> *).
Applicative m =>
(forall a. Doc -> m a) -> String -> Natural -> m ()
checkLineLength Doc -> m a
forall a. Doc -> m a
reject String
s) (Maybe Natural -> m ()) -> Maybe Natural -> m ()
forall a b. (a -> b) -> a -> b
$ Identity (Maybe Natural) -> Maybe Natural
forall a. Identity a -> a
runIdentity Identity (Maybe Natural)
maxLineLength
  m [Module SrcSpanInfo] -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m [Module SrcSpanInfo] -> m ()) -> m [Module SrcSpanInfo] -> m ()
forall a b. (a -> b) -> a -> b
$ [Extension] -> (String, String) -> m (Module SrcSpanInfo)
parseModule [Extension]
exts ((String, String) -> m (Module SrcSpanInfo))
-> [(String, String)] -> m [Module SrcSpanInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
`mapM` [(String, String)]
ms
  let mSampleSolution :: Maybe String
mSampleSolution = String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"SampleSolution" [(String, String)]
ms
  -- This step is currently optional and will not run if no sample solution is provided
  case Maybe String
mSampleSolution of
    Maybe String
Nothing -> do
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Identity Bool -> Bool
forall a. Identity a -> a
runIdentity Identity Bool
provideSampleSolution) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        Doc -> m ()
forall a. Doc -> m a
reject Doc
"'provideSampleSolution' is set, but there is no sample solution in the config."
      Maybe String -> (String -> m ()) -> m ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust (Identity (Maybe String) -> Maybe String
forall a. Identity a -> a
runIdentity Identity (Maybe String)
messageOnCloningSampleSolution) ((String -> m ()) -> m ()) -> (String -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ m () -> String -> m ()
forall a b. a -> b -> a
const (m () -> String -> m ()) -> m () -> String -> m ()
forall a b. (a -> b) -> a -> b
$
        Doc -> m ()
forall a. Doc -> m a
reject Doc
"'messageOnCloningSampleSolution' is set, but there is no sample solution in the config."
    Just String
sampleSolution -> Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Identity Bool -> Bool
forall a. Identity a -> a
runIdentity Identity Bool
rigorousValidation) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
      let stricterConfig :: SolutionConfig
stricterConfig = SolutionConfig
config
            { configGhcErrors :: Identity [String]
configGhcErrors = Identity [String]
configGhcWarnings Identity [String] -> Identity [String] -> Identity [String]
forall a. Semigroup a => a -> a -> a
<> Identity [String]
configGhcErrors
            , configHlintErrors :: Identity [String]
configHlintErrors = Identity [String]
configHlintSuggestions Identity [String] -> Identity [String] -> Identity [String]
forall a. Semigroup a => a -> a -> a
<> Identity [String]
configHlintErrors
            , configGhcWarnings :: Identity [String]
configGhcWarnings = Identity [String]
forall a. Monoid a => a
mempty
            , configHlintSuggestions :: Identity [String]
configHlintSuggestions = Identity [String]
forall a. Monoid a => a
mempty
            , configGhcLimit :: Identity (Maybe Natural)
configGhcLimit = Maybe Natural -> Identity (Maybe Natural)
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Natural
forall a. Maybe a
Nothing
            }
      let others :: [(String, String)]
others = ((String, String) -> Bool)
-> [(String, String)] -> [(String, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/=String
"SampleSolution") (String -> Bool)
-> ((String, String) -> String) -> (String, String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> a
fst) [(String, String)]
ms
      let content :: String
content = String -> String -> String -> String
forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace String
"module SampleSolution" (String
"module " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
m) String
sampleSolution
      (Natural -> m ()) -> Maybe Natural -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((forall a. Doc -> m a) -> String -> Natural -> m ()
forall (m :: * -> *).
Applicative m =>
(forall a. Doc -> m a) -> String -> Natural -> m ()
checkLineLength Doc -> m a
forall a. Doc -> m a
reject String
content) (Maybe Natural -> m ()) -> Maybe Natural -> m ()
forall a b. (a -> b) -> a -> b
$ Identity (Maybe Natural) -> Maybe Natural
forall a. Identity a -> a
runIdentity Identity (Maybe Natural)
maxLineLength
      ([String]
modules, String
solutionFile) <- (String, String)
-> [(String, String)] -> String -> m ([String], String)
forall (m :: * -> *).
MonadIO m =>
(String, String)
-> [(String, String)] -> String -> m ([String], String)
writeModules (String
m, String
content) [(String, String)]
others String
path
      [m ()] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([m ()] -> m ()) -> [m ()] -> m ()
forall a b. (a -> b) -> a -> b
$ (forall a. Doc -> m a)
-> (Doc -> m ())
-> String
-> String
-> [String]
-> SolutionConfig
-> [Extension]
-> String
-> String
-> [m ()]
forall (m :: * -> *).
MonadIO m =>
(forall a. Doc -> m a)
-> (Doc -> m ())
-> String
-> String
-> [String]
-> SolutionConfig
-> [Extension]
-> String
-> String
-> [m ()]
testPhases Doc -> m a
forall a. Doc -> m a
reject Doc -> m ()
inform String
s String
solutionFile [String]
modules SolutionConfig
stricterConfig [Extension]
exts String
content String
path
  where
    parseModule :: [Extension] -> (String, String) -> m (Module SrcSpanInfo)
parseModule [Extension]
exts (String
m, String
s) = do
      Doc -> m ()
inform (Doc -> m ()) -> Doc -> m ()
forall a b. (a -> b) -> a -> b
$ String -> Doc
string (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
"Parsing module " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
m
      (forall a. Doc -> m a)
-> [Extension] -> String -> m (Module SrcSpanInfo)
forall (m :: * -> *).
Monad m =>
(forall a. Doc -> m a)
-> [Extension] -> String -> m (Module SrcSpanInfo)
parse Doc -> m a
forall a. Doc -> m a
reject [Extension]
exts String
s
    checkUniqueness :: [a] -> m ()
checkUniqueness [a]
xs = Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([a] -> [a]
forall a. Ord a => [a] -> [a]
nubOrd [a]
xs [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
/= [a]
xs) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Doc -> m ()
forall a. Doc -> m a
reject Doc
"duplicate module name"

{- |
Extract the sample solution if one was provided, 'provideSampleSolution' is enabled
and 'disableSemantics' is not enabled.
-}
maybeSampleSolution :: String -> Maybe Doc
maybeSampleSolution :: String -> Maybe Doc
maybeSampleSolution String
task = do
  (SolutionConfigOpt
config, [String]
modules) <- (forall a. Doc -> Maybe a)
-> String -> Maybe (SolutionConfigOpt, [String])
forall (m :: * -> *).
Monad m =>
(forall a. Doc -> m a) -> String -> m (SolutionConfigOpt, [String])
splitConfigAndModules Doc -> Maybe a
forall a. Doc -> Maybe a
forall {b} {a}. b -> Maybe a
abort String
task
  SolutionConfig {Identity Bool
Identity [String]
Identity (Maybe Natural)
Identity (Maybe String)
Identity FeedbackPhase
allowAdding :: forall (m :: * -> *). FSolutionConfig m -> m Bool
allowModifying :: forall (m :: * -> *). FSolutionConfig m -> m Bool
allowRemoving :: forall (m :: * -> *). FSolutionConfig m -> m Bool
addCodeWorldButton :: forall (m :: * -> *). FSolutionConfig m -> m Bool
addCodeWorldRenderButton :: forall (m :: * -> *). FSolutionConfig m -> m Bool
addCodeWorldPartialRenderButton :: forall (m :: * -> *). FSolutionConfig m -> m Bool
configGhcLimit :: forall (m :: * -> *). FSolutionConfig m -> m (Maybe Natural)
configGhcErrors :: forall (m :: * -> *). FSolutionConfig m -> m [String]
configGhcWarnings :: forall (m :: * -> *). FSolutionConfig m -> m [String]
configHlintSuggestionsLimit :: forall (m :: * -> *). FSolutionConfig m -> m (Maybe Natural)
configHlintErrors :: forall (m :: * -> *). FSolutionConfig m -> m [String]
configHlintGroups :: forall (m :: * -> *). FSolutionConfig m -> m [String]
configHlintRules :: forall (m :: * -> *). FSolutionConfig m -> m [String]
configHlintSuggestions :: forall (m :: * -> *). FSolutionConfig m -> m [String]
configLanguageExtensions :: forall (m :: * -> *). FSolutionConfig m -> m [String]
maxLineLength :: forall (m :: * -> *). FSolutionConfig m -> m (Maybe Natural)
provideSampleSolution :: forall (m :: * -> *). FSolutionConfig m -> m Bool
messageOnCloningSampleSolution :: forall (m :: * -> *). FSolutionConfig m -> m (Maybe String)
disableSemantics :: forall (m :: * -> *). FSolutionConfig m -> m Bool
rigorousValidation :: forall (m :: * -> *). FSolutionConfig m -> m Bool
syntaxCutoff :: forall (m :: * -> *). FSolutionConfig m -> m FeedbackPhase
allowAdding :: Identity Bool
allowModifying :: Identity Bool
allowRemoving :: Identity Bool
addCodeWorldButton :: Identity Bool
addCodeWorldRenderButton :: Identity Bool
addCodeWorldPartialRenderButton :: Identity Bool
configGhcLimit :: Identity (Maybe Natural)
configGhcErrors :: Identity [String]
configGhcWarnings :: Identity [String]
configHlintSuggestionsLimit :: Identity (Maybe Natural)
configHlintErrors :: Identity [String]
configHlintGroups :: Identity [String]
configHlintRules :: Identity [String]
configHlintSuggestions :: Identity [String]
configLanguageExtensions :: Identity [String]
maxLineLength :: Identity (Maybe Natural)
provideSampleSolution :: Identity Bool
messageOnCloningSampleSolution :: Identity (Maybe String)
disableSemantics :: Identity Bool
rigorousValidation :: Identity Bool
syntaxCutoff :: Identity FeedbackPhase
..} <- (forall a. Doc -> Maybe a)
-> SolutionConfigOpt -> Maybe SolutionConfig
forall (m :: * -> *).
Monad m =>
(forall a. Doc -> m a) -> SolutionConfigOpt -> m SolutionConfig
addDefaults Doc -> Maybe a
forall a. Doc -> Maybe a
forall {b} {a}. b -> Maybe a
abort SolutionConfigOpt
config
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Identity Bool -> Bool
forall a. Identity a -> a
runIdentity (Identity Bool -> Bool) -> Identity Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Bool
(&&) (Bool -> Bool -> Bool) -> Identity Bool -> Identity (Bool -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Identity Bool
provideSampleSolution Identity (Bool -> Bool) -> Identity Bool -> Identity Bool
forall a b. Identity (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool -> Bool) -> Identity Bool -> Identity Bool
forall a b. (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not Identity Bool
disableSemantics
  [Extension]
exts <- SolutionConfig -> [Extension]
extensionsOf (SolutionConfig -> [Extension])
-> Maybe SolutionConfig -> Maybe [Extension]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Doc -> Maybe a)
-> SolutionConfigOpt -> Maybe SolutionConfig
forall (m :: * -> *).
Monad m =>
(forall a. Doc -> m a) -> SolutionConfigOpt -> m SolutionConfig
addDefaults Doc -> Maybe a
forall a. Doc -> Maybe a
forall {b} {a}. b -> Maybe a
abort SolutionConfigOpt
config
  ((String
taskName,String
_), [(String, String)]
otherModules) <- (forall a. String -> Maybe a)
-> [Extension]
-> [String]
-> Maybe ((String, String), [(String, String)])
forall (m :: * -> *).
Monad m =>
(forall a. String -> m a)
-> [Extension]
-> [String]
-> m ((String, String), [(String, String)])
nameModules String -> Maybe a
forall a. String -> Maybe a
forall {b} {a}. b -> Maybe a
abort [Extension]
exts [String]
modules
  String
sampleSolution <- String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"SampleSolution" [(String, String)]
otherModules
  Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
string (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String
forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace String
"SampleSolution" String
taskName String
sampleSolution
  where
    abort :: b -> Maybe a
abort = Maybe a -> b -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing

{-|
Extract the value of the `addCodeWorldButton` option.
Defaults to `False` if not specified.
Also returns `False` in case the config cannot be read.
-}
getCodeWorldButtonOption :: String -> Bool
getCodeWorldButtonOption :: String -> Bool
getCodeWorldButtonOption String
s = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False Maybe Bool
mOption
  where
    mOption :: Maybe Bool
mOption = (forall a. Doc -> Maybe a)
-> String -> Maybe (SolutionConfigOpt, [String])
forall (m :: * -> *).
Monad m =>
(forall a. Doc -> m a) -> String -> m (SolutionConfigOpt, [String])
splitConfigAndModules (Maybe a -> Doc -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) String
s Maybe (SolutionConfigOpt, [String])
-> ((SolutionConfigOpt, [String]) -> Maybe Bool) -> Maybe Bool
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SolutionConfigOpt -> Maybe Bool
forall (m :: * -> *). FSolutionConfig m -> m Bool
addCodeWorldButton (SolutionConfigOpt -> Maybe Bool)
-> ((SolutionConfigOpt, [String]) -> SolutionConfigOpt)
-> (SolutionConfigOpt, [String])
-> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SolutionConfigOpt, [String]) -> SolutionConfigOpt
forall a b. (a, b) -> a
fst

{-|
Extract the value of the `addCodeWorldRenderButton` option.
Defaults to `False` if not specified.
Also returns `False` in case the config cannot be read.
-}
getCodeWorldRenderButtonOption :: String -> Bool
getCodeWorldRenderButtonOption :: String -> Bool
getCodeWorldRenderButtonOption String
s = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False Maybe Bool
mOption
  where
    mOption :: Maybe Bool
mOption = (forall a. Doc -> Maybe a)
-> String -> Maybe (SolutionConfigOpt, [String])
forall (m :: * -> *).
Monad m =>
(forall a. Doc -> m a) -> String -> m (SolutionConfigOpt, [String])
splitConfigAndModules (Maybe a -> Doc -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) String
s Maybe (SolutionConfigOpt, [String])
-> ((SolutionConfigOpt, [String]) -> Maybe Bool) -> Maybe Bool
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SolutionConfigOpt -> Maybe Bool
forall (m :: * -> *). FSolutionConfig m -> m Bool
addCodeWorldRenderButton (SolutionConfigOpt -> Maybe Bool)
-> ((SolutionConfigOpt, [String]) -> SolutionConfigOpt)
-> (SolutionConfigOpt, [String])
-> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SolutionConfigOpt, [String]) -> SolutionConfigOpt
forall a b. (a, b) -> a
fst

{-|
Extract the value of the `addCodeWorldPartialRenderButton` option.
Defaults to `False` if not specified.
Also returns `False` in case the config cannot be read.
-}
getCodeWorldPartialRenderButtonOption :: String -> Bool
getCodeWorldPartialRenderButtonOption :: String -> Bool
getCodeWorldPartialRenderButtonOption String
s = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False Maybe Bool
mOption
  where
    mOption :: Maybe Bool
mOption = (forall a. Doc -> Maybe a)
-> String -> Maybe (SolutionConfigOpt, [String])
forall (m :: * -> *).
Monad m =>
(forall a. Doc -> m a) -> String -> m (SolutionConfigOpt, [String])
splitConfigAndModules (Maybe a -> Doc -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) String
s Maybe (SolutionConfigOpt, [String])
-> ((SolutionConfigOpt, [String]) -> Maybe Bool) -> Maybe Bool
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SolutionConfigOpt -> Maybe Bool
forall (m :: * -> *). FSolutionConfig m -> m Bool
addCodeWorldPartialRenderButton (SolutionConfigOpt -> Maybe Bool)
-> ((SolutionConfigOpt, [String]) -> SolutionConfigOpt)
-> (SolutionConfigOpt, [String])
-> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SolutionConfigOpt, [String]) -> SolutionConfigOpt
forall a b. (a, b) -> a
fst

{-|
Enforces completely writing the file by flushing the output,
closing the handle and waiting for it to being closed.
-}
strictWriteFile :: FilePath -> String -> IO ()
strictWriteFile :: String -> String -> IO ()
strictWriteFile String
f String
x = String -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
IO.withFile String
f IOMode
IO.WriteMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
  Handle -> String -> IO ()
IO.hPutStr Handle
h String
x
  Handle -> IO ()
IO.hFlush Handle
h
  Handle -> IO ()
IO.hClose Handle
h
  Handle -> IO ()
whileOpen Handle
h

{-|
Actively wait until the Handle is closed.
-}
whileOpen :: IO.Handle -> IO ()
whileOpen :: Handle -> IO ()
whileOpen Handle
h =
  Handle -> IO Bool
IO.hIsClosed Handle
h IO Bool -> (Bool -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool -> IO () -> IO ()) -> IO () -> Bool -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Handle -> IO ()
whileOpen Handle
h)

{-|
Generate consecutive syntax and possible semantics feedback in the context of an evaluation Monad.

This Monad is expected to provide a mechanism to prematurely end the evaluation
in case of failure.

This function returns an encapsulated Bool value if all tests pass.
It will only be `True` if the submission contains a clone of the sample solution,
the semantics phase is not disabled by 'disableSemantics' and
the task was also configured to add a custom message on clones via 'messageOnCloningSampleSolution'.
Otherwise, the value will always be `False`.
This can be used by the caller to conditionally add the sample solution
after the grading is already completed, with `maybeSampleSolution`.
-}
grade
  :: MonadIO m
  => (m () -> m ())
  -- ^ Evaluation function for the syntax phase
  -> (m () -> m ())
  -- ^ Evaluation function for the semantics phase
  -> (forall c. Doc -> m c)
  -- ^ display a message and fail
  -> (Doc -> m ())
  -- ^ display a message and continue
  -> FilePath
  -- ^ parent directory to use for file operations
  -> String
  -- ^ the task
  -> String
  -- ^ the submission
  -> m Bool
  -- ^ whether the conditions outlined in the description apply or not
grade :: forall (m :: * -> *).
MonadIO m =>
(m () -> m ())
-> (m () -> m ())
-> (forall c. Doc -> m c)
-> (Doc -> m ())
-> String
-> String
-> String
-> m Bool
grade m () -> m ()
withSyntax m () -> m ()
withSemantics forall c. Doc -> m c
reject Doc -> m ()
inform String
dirname String
task String
submission = do
    m () -> m ()
withSyntax (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ (forall c. Doc -> m c) -> String -> m ()
forall (m :: * -> *).
Monad m =>
(forall a. Doc -> m a) -> String -> m ()
checkUnsafe Doc -> m a
forall c. Doc -> m c
reject String
submission
    (config :: SolutionConfig
config@SolutionConfig{Identity Bool
Identity [String]
Identity (Maybe Natural)
Identity (Maybe String)
Identity FeedbackPhase
allowAdding :: forall (m :: * -> *). FSolutionConfig m -> m Bool
allowModifying :: forall (m :: * -> *). FSolutionConfig m -> m Bool
allowRemoving :: forall (m :: * -> *). FSolutionConfig m -> m Bool
addCodeWorldButton :: forall (m :: * -> *). FSolutionConfig m -> m Bool
addCodeWorldRenderButton :: forall (m :: * -> *). FSolutionConfig m -> m Bool
addCodeWorldPartialRenderButton :: forall (m :: * -> *). FSolutionConfig m -> m Bool
configGhcLimit :: forall (m :: * -> *). FSolutionConfig m -> m (Maybe Natural)
configGhcErrors :: forall (m :: * -> *). FSolutionConfig m -> m [String]
configGhcWarnings :: forall (m :: * -> *). FSolutionConfig m -> m [String]
configHlintSuggestionsLimit :: forall (m :: * -> *). FSolutionConfig m -> m (Maybe Natural)
configHlintErrors :: forall (m :: * -> *). FSolutionConfig m -> m [String]
configHlintGroups :: forall (m :: * -> *). FSolutionConfig m -> m [String]
configHlintRules :: forall (m :: * -> *). FSolutionConfig m -> m [String]
configHlintSuggestions :: forall (m :: * -> *). FSolutionConfig m -> m [String]
configLanguageExtensions :: forall (m :: * -> *). FSolutionConfig m -> m [String]
maxLineLength :: forall (m :: * -> *). FSolutionConfig m -> m (Maybe Natural)
provideSampleSolution :: forall (m :: * -> *). FSolutionConfig m -> m Bool
messageOnCloningSampleSolution :: forall (m :: * -> *). FSolutionConfig m -> m (Maybe String)
disableSemantics :: forall (m :: * -> *). FSolutionConfig m -> m Bool
rigorousValidation :: forall (m :: * -> *). FSolutionConfig m -> m Bool
syntaxCutoff :: forall (m :: * -> *). FSolutionConfig m -> m FeedbackPhase
allowAdding :: Identity Bool
allowModifying :: Identity Bool
allowRemoving :: Identity Bool
addCodeWorldButton :: Identity Bool
addCodeWorldRenderButton :: Identity Bool
addCodeWorldPartialRenderButton :: Identity Bool
configGhcLimit :: Identity (Maybe Natural)
configGhcErrors :: Identity [String]
configGhcWarnings :: Identity [String]
configHlintSuggestionsLimit :: Identity (Maybe Natural)
configHlintErrors :: Identity [String]
configHlintGroups :: Identity [String]
configHlintRules :: Identity [String]
configHlintSuggestions :: Identity [String]
configLanguageExtensions :: Identity [String]
maxLineLength :: Identity (Maybe Natural)
provideSampleSolution :: Identity Bool
messageOnCloningSampleSolution :: Identity (Maybe String)
disableSemantics :: Identity Bool
rigorousValidation :: Identity Bool
syntaxCutoff :: Identity FeedbackPhase
..}, [Extension]
exts, (String
moduleName', String
template), [(String, String)]
others) <- (forall c. Doc -> m c)
-> (Doc -> m ())
-> String
-> m (SolutionConfig, [Extension], (String, String),
      [(String, String)])
forall (m :: * -> *).
Monad m =>
(forall a. Doc -> m a)
-> (Doc -> m ())
-> String
-> m (SolutionConfig, [Extension], (String, String),
      [(String, String)])
processConfig
      ((forall c. Doc -> m c) -> Doc -> Doc -> m a
forall (m :: * -> *) b. (forall a. Doc -> m a) -> Doc -> Doc -> m b
rejectWithMessage Doc -> m a
forall c. Doc -> m c
reject (Doc -> Doc -> m a) -> Doc -> Doc -> m a
forall a b. (a -> b) -> a -> b
$ String -> Doc
string String
informTutorMessage)
      (m () -> Doc -> m ()
forall a b. a -> b -> a
const (m () -> Doc -> m ()) -> m () -> Doc -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
      String
task
    m () -> m ()
withSyntax (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ (Natural -> m ()) -> Maybe Natural -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((forall c. Doc -> m c) -> String -> Natural -> m ()
forall (m :: * -> *).
Applicative m =>
(forall a. Doc -> m a) -> String -> Natural -> m ()
checkLineLength Doc -> m a
forall c. Doc -> m c
reject String
submission) (Maybe Natural -> m ()) -> Maybe Natural -> m ()
forall a b. (a -> b) -> a -> b
$ Identity (Maybe Natural) -> Maybe Natural
forall a. Identity a -> a
runIdentity Identity (Maybe Natural)
maxLineLength
    ([String]
modules, String
submissionFile) <- if Identity Bool -> Bool
forall a. Identity a -> a
runIdentity (Identity Bool -> Bool) -> Identity Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (FeedbackPhase -> Bool) -> Identity FeedbackPhase -> Identity Bool
forall a b. (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FeedbackPhase -> FeedbackPhase -> Bool
forall a. Eq a => a -> a -> Bool
== FeedbackPhase
CodeWidth) Identity FeedbackPhase
syntaxCutoff Identity Bool -> Identity Bool -> Identity Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
&&^ Identity Bool
disableSemantics
      -- Completely skip file writing if code length is the only syntax phase action
      -- and semantics phase is disabled.
      then ([String], String) -> m ([String], String)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([String]
forall a. HasCallStack => a
undefined, String
forall a. HasCallStack => a
undefined)
      else (String, String)
-> [(String, String)] -> String -> m ([String], String)
forall (m :: * -> *).
MonadIO m =>
(String, String)
-> [(String, String)] -> String -> m ([String], String)
writeModules (String
moduleName', String
submission) [(String, String)]
others String
dirname
    let
     ([m ()]
syntax, [m ()]
semantics) = Int -> [m ()] -> ([m ()], [m ()])
forall a. Int -> [a] -> ([a], [a])
splitAt (Identity FeedbackPhase -> Int
forall a. Enum a => a -> Int
fromEnum Identity FeedbackPhase
syntaxCutoff)
      ([m ()] -> ([m ()], [m ()])) -> [m ()] -> ([m ()], [m ()])
forall a b. (a -> b) -> a -> b
$ (forall c. Doc -> m c)
-> (Doc -> m ())
-> String
-> String
-> [String]
-> SolutionConfig
-> [Extension]
-> String
-> String
-> [m ()]
forall (m :: * -> *).
MonadIO m =>
(forall a. Doc -> m a)
-> (Doc -> m ())
-> String
-> String
-> [String]
-> SolutionConfig
-> [Extension]
-> String
-> String
-> [m ()]
testPhases Doc -> m a
forall c. Doc -> m c
reject Doc -> m ()
inform String
template String
submissionFile [String]
modules SolutionConfig
config [Extension]
exts String
submission String
dirname
    m () -> m ()
withSyntax (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ [m ()] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [m ()]
syntax
    if Identity Bool -> Bool
forall a. Identity a -> a
runIdentity Identity Bool
disableSemantics
    then Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
    else do
     m () -> m ()
withSemantics (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ [m ()] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [m ()]
semantics
     case
      (,) (String -> String -> (String, String))
-> Maybe String -> Maybe (String -> (String, String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"SampleSolution" [(String, String)]
others
          Maybe (String -> (String, String))
-> Maybe String -> Maybe (String, String)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Identity (Maybe String) -> Maybe String
forall a. Identity a -> a
runIdentity Identity (Maybe String)
messageOnCloningSampleSolution
      of
        Maybe (String, String)
Nothing                       -> Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
        Just (String
sampleSolution,String
message) -> (forall c. Doc -> m c)
-> m () -> [Extension] -> String -> String -> m Bool
forall (m :: * -> *).
Monad m =>
(forall a. Doc -> m a)
-> m () -> [Extension] -> String -> String -> m Bool
catchSampleSolutionClone
          Doc -> m a
forall c. Doc -> m c
reject
          (Doc -> m ()
inform (Doc -> m ()) -> Doc -> m ()
forall a b. (a -> b) -> a -> b
$ String -> Doc
string String
message)
          [Extension]
exts
          (String -> String -> String -> String
forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace String
"SampleSolution" String
moduleName' String
sampleSolution)
          String
submission

rejectHint :: Doc
rejectHint :: Doc
rejectHint = [SI.iii|
  Unless you fix the above,
  your submission will not be considered further
  (e.g., no tests being run on it).
  |]

extensionsOf :: SolutionConfig -> [E.Extension]
extensionsOf :: SolutionConfig -> [Extension]
extensionsOf = (String -> Extension) -> [String] -> [Extension]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Extension
readAll ([String] -> [Extension])
-> (SolutionConfig -> [String]) -> SolutionConfig -> [Extension]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity [String] -> [String]
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum (Identity [String] -> [String])
-> (SolutionConfig -> Identity [String])
-> SolutionConfig
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SolutionConfig -> Identity [String]
forall (m :: * -> *). FSolutionConfig m -> m [String]
configLanguageExtensions
  where
    readAll :: String -> Extension
readAll (Char
'N':Char
'o':Char
y:String
ys) | Char -> Bool
isUpper Char
y = (KnownExtension -> Extension) -> String -> Extension
readExtension KnownExtension -> Extension
E.DisableExtension (Char
y Char -> String -> String
forall a. a -> [a] -> [a]
: String
ys)
    readAll String
x                          = (KnownExtension -> Extension) -> String -> Extension
readExtension KnownExtension -> Extension
E.EnableExtension String
x
    readExtension :: (E.KnownExtension -> E.Extension) -> String -> E.Extension
    readExtension :: (KnownExtension -> Extension) -> String -> Extension
readExtension KnownExtension -> Extension
e String
x = Extension
-> (KnownExtension -> Extension)
-> Maybe KnownExtension
-> Extension
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Extension
E.UnknownExtension String
x) KnownExtension -> Extension
e (Maybe KnownExtension -> Extension)
-> Maybe KnownExtension -> Extension
forall a b. (a -> b) -> a -> b
$ String -> Maybe KnownExtension
forall a. Read a => String -> Maybe a
readMaybe String
x

getHlintFeedback
  :: MonadIO m
  => (Doc -> m a)
  -> SolutionConfig
  -> FilePath
  -- ^ directory where to write @additional.yaml@ for hints to check to
  -> String
  -> (SolutionConfig -> Identity [String])
  -> m [a]
getHlintFeedback :: forall (m :: * -> *) a.
MonadIO m =>
(Doc -> m a)
-> SolutionConfig
-> String
-> String
-> (SolutionConfig -> Identity [String])
-> m [a]
getHlintFeedback Doc -> m a
documentInfo SolutionConfig
config String
dir String
file SolutionConfig -> Identity [String]
selectHints = case [String]
hints of
  [] -> [a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
  [String]
_  -> do
    IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
strictWriteFile String
additional (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
hlintConfig [String]
rules
    [Idea]
feedbackIdeas <- IO [Idea] -> m [Idea]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Idea] -> m [Idea]) -> IO [Idea] -> m [Idea]
forall a b. (a -> b) -> a -> b
$ [String] -> IO [Idea]
hlint ([String] -> IO [Idea]) -> [String] -> IO [Idea]
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
addRules ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$
      String
file
      String -> [String] -> [String]
forall a. a -> [a] -> [a]
:  (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String
"--only=" String -> String -> String
forall a. [a] -> [a] -> [a]
++) [String]
hints
      [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"--with-group=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
group | String
group <- Identity [String] -> [String]
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum (Identity [String] -> [String]) -> Identity [String] -> [String]
forall a b. (a -> b) -> a -> b
$ SolutionConfig -> Identity [String]
forall (m :: * -> *). FSolutionConfig m -> m [String]
configHlintGroups SolutionConfig
config]
      [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"--language=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ext | String
ext <- Identity [String] -> [String]
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum (Identity [String] -> [String]) -> Identity [String] -> [String]
forall a b. (a -> b) -> a -> b
$ SolutionConfig -> Identity [String]
forall (m :: * -> *). FSolutionConfig m -> m [String]
configLanguageExtensions SolutionConfig
config]
      [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"--quiet"]
    [m a] -> m [a]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([m a] -> m [a]) -> [m a] -> m [a]
forall a b. (a -> b) -> a -> b
$ [Idea] -> [m a]
forall {a}. Show a => [a] -> [m a]
hlintFeedback [Idea]
feedbackIdeas
  where
    addRules :: [String] -> [String]
addRules
      | [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
rules = [String] -> [String]
forall a. a -> a
id
      | Bool
otherwise  = (:) (String
"--hint=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
additional)
    additional :: String
additional = String
dir String -> String -> String
</> String
"additional.yaml"
    rules :: [String]
rules = Identity [String] -> [String]
forall a. Identity a -> a
runIdentity (Identity [String] -> [String]) -> Identity [String] -> [String]
forall a b. (a -> b) -> a -> b
$ SolutionConfig -> Identity [String]
forall (m :: * -> *). FSolutionConfig m -> m [String]
configHlintRules SolutionConfig
config
    hints :: [String]
hints = Identity [String] -> [String]
forall a. Identity a -> a
runIdentity (Identity [String] -> [String]) -> Identity [String] -> [String]
forall a b. (a -> b) -> a -> b
$ SolutionConfig -> Identity [String]
selectHints SolutionConfig
config
    hintLimit :: [a] -> [a]
hintLimit =
      ([a] -> [a])
-> (Natural -> [a] -> [a]) -> Maybe Natural -> [a] -> [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [a] -> [a]
forall a. a -> a
id Natural -> [a] -> [a]
forall i a. Integral i => i -> [a] -> [a]
genericTake (Maybe Natural -> [a] -> [a]) -> Maybe Natural -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ Identity (Maybe Natural) -> Maybe Natural
forall a. Identity a -> a
runIdentity (Identity (Maybe Natural) -> Maybe Natural)
-> Identity (Maybe Natural) -> Maybe Natural
forall a b. (a -> b) -> a -> b
$ SolutionConfig -> Identity (Maybe Natural)
forall (m :: * -> *). FSolutionConfig m -> m (Maybe Natural)
configHlintSuggestionsLimit SolutionConfig
config
    hlintFeedback :: [a] -> [m a]
hlintFeedback [a]
feedbackIdeas =
      [m a] -> [m a]
forall {a}. [a] -> [a]
hintLimit [Doc -> m a
documentInfo (Doc -> m a) -> Doc -> m a
forall a b. (a -> b) -> a -> b
$ String -> Doc
string (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String -> String
editFeedback (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
comment | a
comment <- [a]
feedbackIdeas]

editFeedback :: String -> String
editFeedback :: String -> String
editFeedback String
xs = case Char -> String -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Char
':' String
xs of
      Just Int
index ->
        let (String
path, String
position) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
index String
xs
        in (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
pathSeparator) String
path String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
position String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
      Maybe Int
Nothing    -> String
xs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"

hlintConfig :: [String] -> String
hlintConfig :: [String] -> String
hlintConfig [String]
rules = [String] -> String
unlines [String
"- " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
r | String
r <- [String]
rules]

compileWithArgsAndCheck
  :: MonadIO m
  => FilePath
  -> (forall b. Doc -> m b)
  -> (Doc -> m ())
  -> SolutionConfig
  -> [String]
  -> (SolutionConfig -> Identity [String])
  -> m ()
compileWithArgsAndCheck :: forall (m :: * -> *).
MonadIO m =>
String
-> (forall b. Doc -> m b)
-> (Doc -> m ())
-> SolutionConfig
-> [String]
-> (SolutionConfig -> Identity [String])
-> m ()
compileWithArgsAndCheck String
dirname forall b. Doc -> m b
reject Doc -> m ()
how SolutionConfig
config [String]
modules SolutionConfig -> Identity [String]
selectWarnings = Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
warnings) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  Either InterpreterError Bool
ghcErrors <-
    IO (Either InterpreterError Bool)
-> m (Either InterpreterError Bool)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either InterpreterError Bool)
 -> m (Either InterpreterError Bool))
-> IO (Either InterpreterError Bool)
-> m (Either InterpreterError Bool)
forall a b. (a -> b) -> a -> b
$ [String]
-> InterpreterT IO Bool -> IO (Either InterpreterError Bool)
forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
[String] -> InterpreterT m a -> m (Either InterpreterError a)
unsafeRunInterpreterWithArgs [String]
ghcOpts (String -> [Extension] -> [String] -> InterpreterT IO Bool
forall (m :: * -> *).
MonadInterpreter m =>
String -> [Extension] -> [String] -> m Bool
compiler String
dirname [Extension]
extensions [String]
modules)
  (forall b. Doc -> m b)
-> Either InterpreterError Bool
-> (Doc -> m ())
-> Maybe Natural
-> (Bool -> m ())
-> m ()
forall (m :: * -> *) a.
Monad m =>
(forall b. Doc -> m b)
-> Either InterpreterError a
-> (Doc -> m ())
-> Maybe Natural
-> (a -> m ())
-> m ()
checkResult Doc -> m b
forall b. Doc -> m b
reject Either InterpreterError Bool
ghcErrors Doc -> m ()
how Maybe Natural
howMany ((Bool -> m ()) -> m ()) -> (Bool -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ m () -> Bool -> m ()
forall a b. a -> b -> a
const (m () -> Bool -> m ()) -> m () -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    warnings :: [String]
warnings = Identity [String] -> [String]
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum (SolutionConfig -> Identity [String]
selectWarnings SolutionConfig
config)
    makeOpts :: [String] -> [String]
makeOpts [String]
xs = (String
"-w"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String
"-Werror=" String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
xs
    ghcOpts :: [String]
ghcOpts  = [String] -> [String]
makeOpts [String]
warnings
    howMany :: Maybe Natural
howMany = Identity (Maybe Natural) -> Maybe Natural
forall a. Identity a -> a
runIdentity (Identity (Maybe Natural) -> Maybe Natural)
-> Identity (Maybe Natural) -> Maybe Natural
forall a b. (a -> b) -> a -> b
$ SolutionConfig -> Identity (Maybe Natural)
forall (m :: * -> *). FSolutionConfig m -> m (Maybe Natural)
configGhcLimit SolutionConfig
config
    extensions :: [Extension]
extensions = SolutionConfig -> [Extension]
extensionsOf SolutionConfig
config

matchTemplate
  :: Monad m
  => (forall a. Doc -> m a)
  -> SolutionConfig
  -> Int
  -> [E.Extension]
  -> String
  -> String
  -> m ()
matchTemplate :: forall (m :: * -> *).
Monad m =>
(forall a. Doc -> m a)
-> SolutionConfig -> Int -> [Extension] -> String -> String -> m ()
matchTemplate forall a. Doc -> m a
reject SolutionConfig
config Int
context [Extension]
exts String
template String
submission =
  (forall a. Doc -> m a)
-> [Extension] -> String -> String -> (Result () -> m ()) -> m ()
forall (m :: * -> *) b.
Monad m =>
(forall a. Doc -> m a)
-> [Extension] -> String -> String -> (Result () -> m b) -> m b
runMatchTestOn Doc -> m a
forall a. Doc -> m a
reject [Extension]
exts String
template String
submission ((Result () -> m ()) -> m ()) -> (Result () -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \case
    Fail [Location]
loc -> (Location -> m ()) -> [Location] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((forall a. Doc -> m a)
-> SolutionConfig -> Int -> String -> String -> Location -> m ()
forall (m :: * -> *).
Applicative m =>
(forall a. Doc -> m a)
-> SolutionConfig -> Int -> String -> String -> Location -> m ()
rejectMatch Doc -> m a
forall a. Doc -> m a
rejectWithHint SolutionConfig
config Int
context String
template String
submission) [Location]
loc
      where
        rejectWithHint :: Doc -> m b
rejectWithHint = (forall a. Doc -> m a) -> Doc -> Doc -> m b
forall (m :: * -> *) b. (forall a. Doc -> m a) -> Doc -> Doc -> m b
rejectWithMessage Doc -> m a
forall a. Doc -> m a
reject Doc
rejectHint
    Ok ()    -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

catchSampleSolutionClone
  :: Monad m
  => (forall a. Doc -> m a)
  -> m ()
  -> [E.Extension]
  -> String
  -> String
  -> m Bool
catchSampleSolutionClone :: forall (m :: * -> *).
Monad m =>
(forall a. Doc -> m a)
-> m () -> [Extension] -> String -> String -> m Bool
catchSampleSolutionClone forall a. Doc -> m a
reject m ()
displayMessage [Extension]
exts String
sample String
submission =
  (forall a. Doc -> m a)
-> [Extension]
-> String
-> String
-> (Result () -> m Bool)
-> m Bool
forall (m :: * -> *) b.
Monad m =>
(forall a. Doc -> m a)
-> [Extension] -> String -> String -> (Result () -> m b) -> m b
runMatchTestOn Doc -> m a
forall a. Doc -> m a
reject [Extension]
exts String
sample String
submission ((Result () -> m Bool) -> m Bool)
-> (Result () -> m Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ \case
    Fail [Location]
loc | (Location -> Bool) -> [Location] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Location -> Bool
missingOrDifferent [Location]
loc
      -> Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
    Result ()
_ -> m ()
displayMessage m () -> m Bool -> m Bool
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
  where
    missingOrDifferent :: Location -> Bool
missingOrDifferent (SrcSpanInfo What
_ Where
OnlySubmission SrcSpanInfo
_) = Bool
False
    missingOrDifferent Location
_                                = Bool
True

runMatchTestOn
  :: Monad m
  => (forall a. Doc -> m a)
  -> [E.Extension]
  -> String
  -> String
  -> (Result () -> m b)
  -> m b
runMatchTestOn :: forall (m :: * -> *) b.
Monad m =>
(forall a. Doc -> m a)
-> [Extension] -> String -> String -> (Result () -> m b) -> m b
runMatchTestOn forall a. Doc -> m a
reject [Extension]
exts String
rawTemplate String
rawSubmission Result () -> m b
whatToDo = do
  Module SrcSpanInfo
template  <- (forall a. Doc -> m a)
-> [Extension] -> String -> m (Module SrcSpanInfo)
forall (m :: * -> *).
Monad m =>
(forall a. Doc -> m a)
-> [Extension] -> String -> m (Module SrcSpanInfo)
parse Doc -> m a
forall a. Doc -> m a
reject [Extension]
exts String
rawTemplate
  Module SrcSpanInfo
submission <- (forall a. Doc -> m a)
-> [Extension] -> String -> m (Module SrcSpanInfo)
forall (m :: * -> *).
Monad m =>
(forall a. Doc -> m a)
-> [Extension] -> String -> m (Module SrcSpanInfo)
parse Doc -> m a
forall a. Doc -> m a
reject [Extension]
exts String
rawSubmission
  case Module SrcSpanInfo -> Module SrcSpanInfo -> Result ()
Match.test Module SrcSpanInfo
template Module SrcSpanInfo
submission of
    Result ()
Continue -> Doc -> m b
forall a. Doc -> m a
reject [SI.i|Haskell.Template.Central.matchTemplate:
#{informTutorMessage}|]
    Result ()
otherResult -> Result () -> m b
whatToDo Result ()
otherResult

deriving instance Typeable Counts

handleCounts
  :: MonadIO m
  => (forall a. Doc -> m a)
  -> IO (Counts, String -> String)
  -> m ()
handleCounts :: forall (m :: * -> *).
MonadIO m =>
(forall a. Doc -> m a) -> IO (Counts, String -> String) -> m ()
handleCounts forall a. Doc -> m a
reject IO (Counts, String -> String)
runResult = do
  (Counts, String -> String)
result <- IO (Counts, String -> String) -> m (Counts, String -> String)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Counts, String -> String)
runResult
  case (Counts, String -> String)
result of
    (Counts {errors :: Counts -> Int
errors = Int
0, failures :: Counts -> Int
failures = Int
0}, String -> String
_) -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    (Counts {failures :: Counts -> Int
failures = Int
0}, String -> String
f) -> do
      Doc -> m ()
forall a. Doc -> m a
reject (Doc -> m ()) -> Doc -> m ()
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat [ Doc
"Some error(s) occurred before fully testing the submission:", Doc
empty, String -> Doc
string (String -> String
f String
"") ]
      -- e.g. quickcheck timeout errors
    (Counts
_, String -> String
f) -> Doc -> m ()
forall a. Doc -> m a
reject (String -> Doc
string (String -> String
f String
""))

checkResult
  :: Monad m
  => (forall b. Doc -> m b)
  -> Either InterpreterError a
  -> (Doc -> m ())
  -> Maybe Natural
  -> (a -> m ())
  -> m ()
checkResult :: forall (m :: * -> *) a.
Monad m =>
(forall b. Doc -> m b)
-> Either InterpreterError a
-> (Doc -> m ())
-> Maybe Natural
-> (a -> m ())
-> m ()
checkResult forall b. Doc -> m b
reject Either InterpreterError a
result Doc -> m ()
handleError Maybe Natural
mErrorLimit a -> m ()
handleResult = case Either InterpreterError a
result of
  Right a
result' -> a -> m ()
handleResult a
result'
  Left (WontCompile [GhcError]
msgs) -> Doc -> m ()
handleError (Doc -> m ()) -> Doc -> m ()
forall a b. (a -> b) -> a -> b
$ String -> Doc
string
    (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall {a}. [a] -> [a]
amount
      ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String
editFeedback (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
formatHyperlinks) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [GhcError] -> [String]
filterWerrors [GhcError]
msgs
  Left InterpreterError
err -> Doc -> m ()
forall b. Doc -> m b
reject (Doc -> m ()) -> Doc -> m ()
forall a b. (a -> b) -> a -> b
$
    [Doc] -> Doc
vcat [Doc
"An unexpected error occurred.",
          Doc
"This is usually not caused by a fault within your submission.",
          Doc
"Please contact your lecturers, providing the following error message:",
          Int -> Doc -> Doc
nest Int
4 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
string (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ InterpreterError -> String
forall a. Show a => a -> String
show InterpreterError
err]
  where
    amount :: [a] -> [a]
amount = ([a] -> [a])
-> (Natural -> [a] -> [a]) -> Maybe Natural -> [a] -> [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [a] -> [a]
forall a. a -> a
id Natural -> [a] -> [a]
forall i a. Integral i => i -> [a] -> [a]
genericTake Maybe Natural
mErrorLimit
    filterWerrors :: [GhcError] -> [String]
filterWerrors [GhcError]
xs = [String] -> [String]
forall a. Ord a => [a] -> [a]
nubOrd
      -- 'nubOrd' is used only because hint provides duplicates for each error:
      -- issue filed at: https://github.com/haskell-hint/hint/issues/83
      [String
x | GhcError String
x <- [GhcError]
xs
         , String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"<no location info>: error: \nFailing due to -Werror."]
    -- This fixes the broken formatting of terminal hyperlinks in an error message
    formatHyperlinks :: String -> String
formatHyperlinks = Regex -> ([String] -> String) -> String -> String
forall a r.
(ConvertibleStrings ByteString a, ConvertibleStrings a ByteString,
 RegexReplacement r) =>
Regex -> r -> a -> a
sub
      [re|(?x)
        \[
        \x1b]8;;
        (https?://[\w\.-]+(?:/[\w-]*)*/?)
        \x1b\\
        [\w-]*
        \x1b]8;;
        \x1b\\
        \]
      |]
      (\case
          -- only keep the capture group (valid link) and discard rest of the match
          (String
link:[String]
_) -> String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
link String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]";
          []       -> []
      )

interpreter
  :: MonadInterpreter m
  => FilePath
  -> [E.Extension]
  -> [String]
  -> m (IO (Counts, ShowS))
interpreter :: forall (m :: * -> *).
MonadInterpreter m =>
String
-> [Extension] -> [String] -> m (IO (Counts, String -> String))
interpreter String
dirname [Extension]
exts [String]
modules = do
  String -> [Extension] -> [String] -> m ()
forall (m :: * -> *).
MonadInterpreter m =>
String -> [Extension] -> [String] -> m ()
prepareInterpreter String
dirname [Extension]
exts [String]
modules
  String
-> IO (Counts, String -> String)
-> m (IO (Counts, String -> String))
forall (m :: * -> *) a.
(MonadInterpreter m, Typeable a) =>
String -> a -> m a
interpret String
"TestHarness.run Test.test" (IO (Counts, String -> String)
forall a. Typeable a => a
as :: IO (Counts, ShowS))

compiler :: MonadInterpreter m => FilePath -> [E.Extension] -> [String] -> m Bool
compiler :: forall (m :: * -> *).
MonadInterpreter m =>
String -> [Extension] -> [String] -> m Bool
compiler String
dirname [Extension]
exts [String]
modules = do
  String -> [Extension] -> [String] -> m ()
forall (m :: * -> *).
MonadInterpreter m =>
String -> [Extension] -> [String] -> m ()
prepareInterpreter String
dirname [Extension]
exts [String]
modules
  String -> Bool -> m Bool
forall (m :: * -> *) a.
(MonadInterpreter m, Typeable a) =>
String -> a -> m a
interpret String
"Prelude.True" (Bool
forall a. Typeable a => a
as :: Bool)

prepareInterpreter :: MonadInterpreter m => FilePath -> [E.Extension] -> [String] -> m ()
prepareInterpreter :: forall (m :: * -> *).
MonadInterpreter m =>
String -> [Extension] -> [String] -> m ()
prepareInterpreter String
dirname [Extension]
exts [String]
modules = do
  [OptionVal m] -> m ()
forall (m :: * -> *). MonadInterpreter m => [OptionVal m] -> m ()
set [Option m [Extension]
forall (m :: * -> *). MonadInterpreter m => Option m [Extension]
languageExtensions Option m [Extension] -> [Extension] -> OptionVal m
forall (m :: * -> *) a. Option m a -> a -> OptionVal m
:= (Extension -> Extension) -> [Extension] -> [Extension]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Extension
readExt (String -> Extension)
-> (Extension -> String) -> Extension -> Extension
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extension -> String
E.prettyExtension) [Extension]
exts]
  m ()
forall (m :: * -> *). MonadInterpreter m => m ()
reset -- Make sure nothing is available
  [OptionVal m] -> m ()
forall (m :: * -> *). MonadInterpreter m => [OptionVal m] -> m ()
set [Option m Bool
forall (m :: * -> *). MonadInterpreter m => Option m Bool
installedModulesInScope Option m Bool -> Bool -> OptionVal m
forall (m :: * -> *) a. Option m a -> a -> OptionVal m
:= Bool
False]
  [OptionVal m] -> m ()
forall (m :: * -> *). MonadInterpreter m => [OptionVal m] -> m ()
set [Option m [String]
forall (m :: * -> *). MonadInterpreter m => Option m [String]
searchPath Option m [String] -> [String] -> OptionVal m
forall (m :: * -> *) a. Option m a -> a -> OptionVal m
:= [String
dirname]]
  -- All modules can be imported in source files
  [String] -> m ()
forall (m :: * -> *). MonadInterpreter m => [String] -> m ()
loadModules (String
"TestHarness" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
modules)
  -- All export items from these modules are in scope for the interpreter evaluation
  [String] -> m ()
forall (m :: * -> *). MonadInterpreter m => [String] -> m ()
setImports ([String] -> m ()) -> [String] -> m ()
forall a b. (a -> b) -> a -> b
$ [String
"Prelude", String
"Test.HUnit", String
"TestHarness"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"Test" | String
"Test" String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
modules]
  where
    readExt :: String -> Extension
readExt String
input = Extension -> Maybe Extension -> Extension
forall a. a -> Maybe a -> a
fromMaybe (String -> Extension
UnknownExtension String
input) (Maybe Extension -> Extension) -> Maybe Extension -> Extension
forall a b. (a -> b) -> a -> b
$ String -> Maybe Extension
forall a. Read a => String -> Maybe a
readMaybe String
input

parse
  :: Monad m
  => (forall a. Doc -> m a)
  -> [E.Extension]
  -> String
  -> m (E.Module E.SrcSpanInfo)
parse :: forall (m :: * -> *).
Monad m =>
(forall a. Doc -> m a)
-> [Extension] -> String -> m (Module SrcSpanInfo)
parse forall a. Doc -> m a
reject' [Extension]
exts' String
m = case String -> Maybe (Maybe Language, [Extension])
E.readExtensions String
m of
  Maybe (Maybe Language, [Extension])
Nothing -> Doc -> m (Module SrcSpanInfo)
forall a. Doc -> m a
reject' Doc
"cannot parse LANGUAGE pragmas at top of file"
  Just (Maybe Language
_, [Extension]
exts) ->
    let parseMode :: ParseMode
parseMode = ParseMode
P.defaultParseMode
                    { extensions :: [Extension]
P.extensions = [Extension]
exts [Extension] -> [Extension] -> [Extension]
forall a. [a] -> [a] -> [a]
++ [Extension]
exts' }
    in case ParseMode -> String -> ParseResult (Module SrcSpanInfo)
P.parseModuleWithMode ParseMode
parseMode String
m of
         P.ParseOk Module SrcSpanInfo
a -> Module SrcSpanInfo -> m (Module SrcSpanInfo)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Module SrcSpanInfo
a
         P.ParseFailed SrcLoc
loc String
msg ->
           (Doc -> m (Module SrcSpanInfo))
-> String -> SrcLoc -> String -> m (Module SrcSpanInfo)
forall t. (Doc -> t) -> String -> SrcLoc -> String -> t
rejectParse Doc -> m (Module SrcSpanInfo)
forall a. Doc -> m a
reject' String
m SrcLoc
loc String
msg

rejectParse :: (Doc -> t) -> String -> E.SrcLoc -> String -> t
rejectParse :: forall t. (Doc -> t) -> String -> SrcLoc -> String -> t
rejectParse Doc -> t
reject' String
m SrcLoc
loc String
msg =
  let ([String]
lPre, [String]
_) = Int -> [String] -> ([String], [String])
forall a. Int -> [a] -> ([a], [a])
splitAt (SrcLoc -> Int
E.srcLine SrcLoc
loc) ([String] -> ([String], [String]))
-> [String] -> ([String], [String])
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
m
      lPre' :: [String]
lPre'     = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
takeEnd Int
3 [String]
lPre
      tag :: String
tag       = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (SrcLoc -> Int
E.srcColumn SrcLoc
loc Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Char
'.' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"^"
  in Doc -> t
reject' (Doc -> t) -> Doc -> t
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat
       [Doc
"Syntax error (your submission is no Haskell program):",
        [String] -> Doc
bloc ([String] -> Doc) -> [String] -> Doc
forall a b. (a -> b) -> a -> b
$ [String]
lPre' [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
tag],
        String -> Doc
string String
msg]

rejectMatch
  :: Applicative m
  => (forall a. Doc -> m a)
  -> SolutionConfig
  -> Int
  -> String
  -> String
  -> Location
  -> m ()
rejectMatch :: forall (m :: * -> *).
Applicative m =>
(forall a. Doc -> m a)
-> SolutionConfig -> Int -> String -> String -> Location -> m ()
rejectMatch forall a. Doc -> m a
reject SolutionConfig
config Int
context String
i String
b Location
l = case Location
l of
  SrcSpanInfoPair What
w SrcSpanInfo
sp1 SrcSpanInfo
sp2 ->
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (What -> (SolutionConfig -> Identity Bool) -> Bool
allowedOperation What
w SolutionConfig -> Identity Bool
forall (m :: * -> *). FSolutionConfig m -> m Bool
allowModifying) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Doc -> m ()
forall a. Doc -> m a
reject (Doc -> m ()) -> Doc -> m ()
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat
      [Doc
"Your submission does not fit the template:" , Doc
empty,
       Doc
"Template:"   , [String] -> Doc
bloc ([String] -> Doc) -> [String] -> Doc
forall a b. (a -> b) -> a -> b
$ SrcSpanInfo -> Int -> String -> [String]
highlight_ssi SrcSpanInfo
sp1 Int
context String
i,
       Doc
"Submission:" , [String] -> Doc
bloc ([String] -> Doc) -> [String] -> Doc
forall a b. (a -> b) -> a -> b
$ SrcSpanInfo -> Int -> String -> [String]
highlight_ssi SrcSpanInfo
sp2 Int
context String
b]
  SrcSpanInfo What
w Where
OnlyTemplate SrcSpanInfo
sp ->
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (What -> (SolutionConfig -> Identity Bool) -> Bool
allowedOperation What
w SolutionConfig -> Identity Bool
forall (m :: * -> *). FSolutionConfig m -> m Bool
allowRemoving) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Doc -> m ()
forall a. Doc -> m a
reject (Doc -> m ()) -> Doc -> m ()
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat
      [Doc
"Missing within your submission:",
       Doc
"Template:",
       [String] -> Doc
bloc ([String] -> Doc) -> [String] -> Doc
forall a b. (a -> b) -> a -> b
$ SrcSpanInfo -> Int -> String -> [String]
highlight_ssi SrcSpanInfo
sp Int
context String
i]
  SrcSpanInfo What
w Where
OnlySubmission SrcSpanInfo
sp ->
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (What -> (SolutionConfig -> Identity Bool) -> Bool
allowedOperation What
w SolutionConfig -> Identity Bool
forall (m :: * -> *). FSolutionConfig m -> m Bool
allowAdding) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Doc -> m ()
forall a. Doc -> m a
reject (Doc -> m ()) -> Doc -> m ()
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat
      [Doc
"Only within your submission (but not within the template):",
       [String] -> Doc
bloc ([String] -> Doc) -> [String] -> Doc
forall a b. (a -> b) -> a -> b
$ SrcSpanInfo -> Int -> String -> [String]
highlight_ssi SrcSpanInfo
sp Int
context String
b]
  where
    allowedOperation :: What -> (SolutionConfig -> Identity Bool) -> Bool
allowedOperation What
what SolutionConfig -> Identity Bool
conf = What
what What -> [What] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [What]
preventChangeTo
      Bool -> Bool -> Bool
&& Identity Bool -> Bool
forall a. Identity a -> a
runIdentity (SolutionConfig -> Identity Bool
conf SolutionConfig
config)
    preventChangeTo :: [What]
preventChangeTo = [What
CompleteModule, What
HeadOfModule, What
ModuleImport, What
Pragma]

bloc :: [String] -> Doc
bloc :: [String] -> Doc
bloc [String]
codeLines =
  let dash :: Doc
dash = String -> Doc
string (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Char
'+' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
30 Char
'-'
  in  [Doc] -> Doc
vcat [ Doc
dash, [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Doc
string (String -> Doc) -> (String -> String) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"| " String -> String -> String
forall a. [a] -> [a] -> [a]
++)) [String]
codeLines, Doc
dash ]

splitConfigAndModules
  :: Monad m
  => (forall a. Doc -> m a)
  -> String -> m (SolutionConfigOpt, [String])
splitConfigAndModules :: forall (m :: * -> *).
Monad m =>
(forall a. Doc -> m a) -> String -> m (SolutionConfigOpt, [String])
splitConfigAndModules forall a. Doc -> m a
reject String
configAndModules =
  (ParseException -> m (SolutionConfigOpt, [String]))
-> (SolutionConfigOpt -> m (SolutionConfigOpt, [String]))
-> Either ParseException SolutionConfigOpt
-> m (SolutionConfigOpt, [String])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Doc -> m (SolutionConfigOpt, [String])
forall a. Doc -> m a
reject (Doc -> m (SolutionConfigOpt, [String]))
-> (ParseException -> Doc)
-> ParseException
-> m (SolutionConfigOpt, [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
string (String -> Doc)
-> (ParseException -> String) -> ParseException -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"Error while parsing config:\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<>) (String -> String)
-> (ParseException -> String) -> ParseException -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseException -> String
forall a. Show a => a -> String
show)
         ((SolutionConfigOpt, [String]) -> m (SolutionConfigOpt, [String])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((SolutionConfigOpt, [String]) -> m (SolutionConfigOpt, [String]))
-> (SolutionConfigOpt -> (SolutionConfigOpt, [String]))
-> SolutionConfigOpt
-> m (SolutionConfigOpt, [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,[String]
rawModules))
         Either ParseException SolutionConfigOpt
eConfig
  where
    String
configJson:[String]
rawModules = Bool -> String -> [String]
splitModules Bool
False String
configAndModules
    eConfig :: Either ParseException SolutionConfigOpt
    eConfig :: Either ParseException SolutionConfigOpt
eConfig = ByteString -> Either ParseException SolutionConfigOpt
forall a. FromJSON a => ByteString -> Either ParseException a
decodeEither' (ByteString -> Either ParseException SolutionConfigOpt)
-> ByteString -> Either ParseException SolutionConfigOpt
forall a b. (a -> b) -> a -> b
$ String -> ByteString
BS.pack String
configJson

addDefaults :: Monad m => (forall a. Doc -> m a) -> SolutionConfigOpt -> m SolutionConfig
addDefaults :: forall (m :: * -> *).
Monad m =>
(forall a. Doc -> m a) -> SolutionConfigOpt -> m SolutionConfig
addDefaults forall a. Doc -> m a
reject SolutionConfigOpt
f = m SolutionConfig
-> (SolutionConfig -> m SolutionConfig)
-> Maybe SolutionConfig
-> m SolutionConfig
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
  (Doc -> m SolutionConfig
forall a. Doc -> m a
reject Doc
"There is a required configuration parameter missing")
  SolutionConfig -> m SolutionConfig
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
  (Maybe SolutionConfig -> m SolutionConfig)
-> Maybe SolutionConfig -> m SolutionConfig
forall a b. (a -> b) -> a -> b
$ [SolutionConfigOpt] -> Maybe SolutionConfig
finaliseConfigs [SolutionConfigOpt
f, SolutionConfigOpt
defaultSolutionConfig]

splitModules :: Bool -> String -> [String]
splitModules :: Bool -> String -> [String]
splitModules Bool
dropFirst = ([String] -> String) -> [[String]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map [String] -> String
unlines
  ([[String]] -> [String])
-> (String -> [[String]]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Bool
dropFirst then Int -> [[String]] -> [[String]]
forall a. Int -> [a] -> [a]
drop Int
1 else [[String]] -> [[String]]
forall a. a -> a
id)
  ([[String]] -> [[String]])
-> (String -> [[String]]) -> String -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [[String]]
forall t. (t -> Bool) -> [t] -> [[t]]
splitBy (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"---")
  ([String] -> [[String]])
-> (String -> [String]) -> String -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines

splitBy :: (t -> Bool) -> [t] -> [[t]]
splitBy :: forall t. (t -> Bool) -> [t] -> [[t]]
splitBy t -> Bool
p = [[t]] -> [[t]]
forall {a}. [a] -> [a]
dropOdd ([[t]] -> [[t]]) -> ([t] -> [[t]]) -> [t] -> [[t]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t -> t -> Bool) -> [t] -> [[t]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\t
l t
r -> Bool -> Bool
not (t -> Bool
p t
l) Bool -> Bool -> Bool
&& Bool -> Bool
not (t -> Bool
p t
r))
  where
   dropOdd :: [a] -> [a]
dropOdd [] = []
   dropOdd [a
x] = [a
x]
   dropOdd (a
x:a
_:[a]
xs) = a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a] -> [a]
dropOdd [a]
xs

unsafeTemplateSegment :: String -> String
unsafeTemplateSegment :: String -> String
unsafeTemplateSegment String
task = (String -> String)
-> (String -> String) -> Either String String -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> String
forall a. a -> a
id String -> String
forall a. a -> a
id (Either String String -> String) -> Either String String -> String
forall a b. (a -> b) -> a -> b
$ do
  let (SolutionConfigOpt
config, [String]
modules) = (SolutionConfigOpt, [String])
-> Maybe (SolutionConfigOpt, [String])
-> (SolutionConfigOpt, [String])
forall a. a -> Maybe a -> a
fromMaybe (SolutionConfigOpt
defaultSolutionConfig, []) (Maybe (SolutionConfigOpt, [String])
 -> (SolutionConfigOpt, [String]))
-> Maybe (SolutionConfigOpt, [String])
-> (SolutionConfigOpt, [String])
forall a b. (a -> b) -> a -> b
$
        (forall a. Doc -> Maybe a)
-> String -> Maybe (SolutionConfigOpt, [String])
forall (m :: * -> *).
Monad m =>
(forall a. Doc -> m a) -> String -> m (SolutionConfigOpt, [String])
splitConfigAndModules (Maybe a -> Doc -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) String
task
      exts :: [Extension]
exts = [Extension]
-> (SolutionConfig -> [Extension])
-> Maybe SolutionConfig
-> [Extension]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] SolutionConfig -> [Extension]
extensionsOf (Maybe SolutionConfig -> [Extension])
-> Maybe SolutionConfig -> [Extension]
forall a b. (a -> b) -> a -> b
$ (forall a. Doc -> Maybe a)
-> SolutionConfigOpt -> Maybe SolutionConfig
forall (m :: * -> *).
Monad m =>
(forall a. Doc -> m a) -> SolutionConfigOpt -> m SolutionConfig
addDefaults (Maybe a -> Doc -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) SolutionConfigOpt
config
  (String, String) -> String
forall a b. (a, b) -> b
snd ((String, String) -> String)
-> (((String, String), [(String, String)]) -> (String, String))
-> ((String, String), [(String, String)])
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String), [(String, String)]) -> (String, String)
forall a b. (a, b) -> a
fst (((String, String), [(String, String)]) -> String)
-> Either String ((String, String), [(String, String)])
-> Either String String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. String -> Either String a)
-> [Extension]
-> [String]
-> Either String ((String, String), [(String, String)])
forall (m :: * -> *).
Monad m =>
(forall a. String -> m a)
-> [Extension]
-> [String]
-> m ((String, String), [(String, String)])
nameModules String -> Either String a
forall a. String -> Either String a
forall a b. a -> Either a b
Left [Extension]
exts [String]
modules

nameModules
  :: Monad m
  => (forall a. String -> m a)
  -> [E.Extension]
  -> [String]
  -> m ((String, String), [(String, String)])
nameModules :: forall (m :: * -> *).
Monad m =>
(forall a. String -> m a)
-> [Extension]
-> [String]
-> m ((String, String), [(String, String)])
nameModules forall a. String -> m a
reject [Extension]
exts [String]
modules =
  case [Extension] -> [String] -> ParseResult [(String, String)]
withNames [Extension]
exts [String]
modules of
    P.ParseFailed SrcLoc
_   String
msg  ->
      String -> m ((String, String), [(String, String)])
forall a. String -> m a
reject (String -> m ((String, String), [(String, String)]))
-> String -> m ((String, String), [(String, String)])
forall a b. (a -> b) -> a -> b
$ String
"Please contact a tutor sending the following error report:\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
msg
    P.ParseOk [] -> String -> m ((String, String), [(String, String)])
forall a. String -> m a
reject String
"No modules"
    P.ParseOk ((String, String)
m:[(String, String)]
ms) -> ((String, String), [(String, String)])
-> m ((String, String), [(String, String)])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((String, String)
m,[(String, String)]
ms)

withNames :: [E.Extension] -> [String] -> P.ParseResult [(String, String)]
withNames :: [Extension] -> [String] -> ParseResult [(String, String)]
withNames [Extension]
exts [String]
mods =
  ([String] -> [String] -> [(String, String)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [String]
mods) ([String] -> [(String, String)])
-> ParseResult [String] -> ParseResult [(String, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ParseResult String) -> [String] -> ParseResult [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Module SrcSpanInfo -> String)
-> ParseResult (Module SrcSpanInfo) -> ParseResult String
forall a b. (a -> b) -> ParseResult a -> ParseResult b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Module SrcSpanInfo -> String
forall l. Module l -> String
moduleName (ParseResult (Module SrcSpanInfo) -> ParseResult String)
-> (String -> ParseResult (Module SrcSpanInfo))
-> String
-> ParseResult String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Extension] -> String -> ParseResult (Module SrcSpanInfo)
E.parseFileContentsWithExts [Extension]
exts) [String]
mods

moduleName :: E.Module l -> String
moduleName :: forall l. Module l -> String
moduleName (E.Module l
_ (Just (E.ModuleHead l
_ (E.ModuleName l
_ String
n) Maybe (WarningText l)
_ Maybe (ExportSpecList l)
_)) [ModulePragma l]
_ [ImportDecl l]
_ [Decl l]
_) = String
n
moduleName (E.Module l
_ Maybe (ModuleHead l)
Nothing [ModulePragma l]
_ [ImportDecl l]
_ [Decl l]
_) = String
"Main"
moduleName Module l
_                          = String -> String
forall a. HasCallStack => String -> a
error String
"unsupported module type"

processConfig
  :: Monad m
  => (forall a. Doc -> m a)
  -- ^ display a message and fail
  -> (Doc -> m ())
  -- ^ display a message and continue
  -> String
  -- ^ raw configuration
  -> m (FSolutionConfig Identity, [E.Extension], (String,String), [(String,String)])
processConfig :: forall (m :: * -> *).
Monad m =>
(forall a. Doc -> m a)
-> (Doc -> m ())
-> String
-> m (SolutionConfig, [Extension], (String, String),
      [(String, String)])
processConfig forall a. Doc -> m a
reject Doc -> m ()
inform String
rawConfig = do
  (SolutionConfigOpt
config, [String]
modules) <- (forall a. Doc -> m a) -> String -> m (SolutionConfigOpt, [String])
forall (m :: * -> *).
Monad m =>
(forall a. Doc -> m a) -> String -> m (SolutionConfigOpt, [String])
splitConfigAndModules Doc -> m a
forall a. Doc -> m a
reject String
rawConfig
  Doc -> m ()
inform (Doc -> m ()) -> Doc -> m ()
forall a b. (a -> b) -> a -> b
$ String -> Doc
string (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
"Parsed the following setting options:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ SolutionConfigOpt -> String
forall a. Show a => a -> String
show SolutionConfigOpt
config
  SolutionConfig
completedConfig <- (forall a. Doc -> m a) -> SolutionConfigOpt -> m SolutionConfig
forall (m :: * -> *).
Monad m =>
(forall a. Doc -> m a) -> SolutionConfigOpt -> m SolutionConfig
addDefaults Doc -> m a
forall a. Doc -> m a
reject SolutionConfigOpt
config
  Doc -> m ()
inform (Doc -> m ()) -> Doc -> m ()
forall a b. (a -> b) -> a -> b
$ String -> Doc
string (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
"Completed configuration to:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ SolutionConfig -> String
forall a. Show a => a -> String
show SolutionConfig
completedConfig
  let exts :: [Extension]
exts = SolutionConfig -> [Extension]
extensionsOf SolutionConfig
completedConfig
  ((String
m,String
s), [(String, String)]
ms) <- (forall a. String -> m a)
-> [Extension]
-> [String]
-> m ((String, String), [(String, String)])
forall (m :: * -> *).
Monad m =>
(forall a. String -> m a)
-> [Extension]
-> [String]
-> m ((String, String), [(String, String)])
nameModules (Doc -> m a
forall a. Doc -> m a
reject (Doc -> m a) -> (String -> Doc) -> String -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
string) [Extension]
exts [String]
modules
  (SolutionConfig, [Extension], (String, String), [(String, String)])
-> m (SolutionConfig, [Extension], (String, String),
      [(String, String)])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SolutionConfig
completedConfig, [Extension]
exts, (String
m,String
s), [(String, String)]
ms)

checkUnsafe :: Monad m => (forall a. Doc -> m a) -> String -> m ()
checkUnsafe :: forall (m :: * -> *).
Monad m =>
(forall a. Doc -> m a) -> String -> m ()
checkUnsafe forall a. Doc -> m a
reject String
rawFile =  do
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
"System.IO.Unsafe" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
rawFile)
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Doc -> m ()
forall a. Doc -> m a
reject Doc
"wants to use System.IO.Unsafe"
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
"unsafePerformIO"  String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
rawFile)
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Doc -> m ()
forall a. Doc -> m a
reject Doc
"wants to use unsafePerformIO"

informTutorMessage :: String
informTutorMessage :: String
informTutorMessage =
  [SI.i|Please inform a tutor about this issue providing your submission and this message.|]

rejectWithMessage :: (forall a. Doc -> m a) -> Doc -> Doc -> m b
rejectWithMessage :: forall (m :: * -> *) b. (forall a. Doc -> m a) -> Doc -> Doc -> m b
rejectWithMessage forall a. Doc -> m a
reject Doc
m = Doc -> m b
forall a. Doc -> m a
reject (Doc -> m b) -> (Doc -> Doc) -> Doc -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
vcat ([Doc] -> Doc) -> (Doc -> [Doc]) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: [Doc
empty, Doc
m])

writeModules
  :: MonadIO m
  => (FilePath, String)
  -> [(FilePath, String)]
  -> [Char]
  -> m ([String], String)
writeModules :: forall (m :: * -> *).
MonadIO m =>
(String, String)
-> [(String, String)] -> String -> m ([String], String)
writeModules (String
moduleName', String
submission) [(String, String)]
others String
dirname = do
  [String]
files <- IO [String] -> m [String]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String] -> m [String]) -> IO [String] -> m [String]
forall a b. (a -> b) -> a -> b
$ ((String
moduleName', String
submission) (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: [(String, String)]
others)
    [(String, String)]
-> ((String, String) -> IO String) -> IO [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
`forM` \(String
mName, String
contents) -> do
    let fname :: String
fname = String
dirname String -> String -> String
</> String
mName String -> String -> String
<.> String
"hs"
    String -> String -> IO ()
strictWriteFile String
fname String
contents
    String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
fname
  let existingModules :: [String]
existingModules = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
takeBaseName
        ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String
".hs" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==) (String -> Bool) -> (String -> String) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
takeExtension)
        ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String
".",String
".."]) [String]
files
      modules :: [String]
modules = [String
"Test"] [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
`union` [String]
existingModules
      submissionFile :: String
submissionFile = String
dirname String -> String -> String
</> (String
moduleName' String -> String -> String
<.> String
"hs")
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String
"Test" String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
existingModules) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      String -> String -> IO ()
strictWriteFile (String
dirname String -> String -> String
</> String
"Test" String -> String -> String
<.> String
"hs") (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
testModule String
moduleName'
    String -> String -> IO ()
strictWriteFile (String
dirname String -> String -> String
</> String
"TestHelper" String -> String -> String
<.> String
"hs") String
testHelperContents
    String -> String -> IO ()
strictWriteFile (String
dirname String -> String -> String
</> String
"TestHarness" String -> String -> String
<.> String
"hs")
      (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
testHarnessFor String
submissionFile
  ([String], String) -> m ([String], String)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([String]
modules, String
submissionFile)
  where
    testHarnessFor :: String -> String
testHarnessFor String
file =
      let quoted :: String -> String
quoted String
xs = Char
'"' Char -> String -> String
forall a. a -> [a] -> [a]
: String
xs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\""
      in String -> String -> String -> String
forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace (String -> String
quoted String
"Submission.hs") (String -> String
quoted String
file) String
testHarnessContents
    testModule :: String -> String
    testModule :: String -> String
testModule String
s = [SI.i|module Test (test) where
import qualified #{s} (test)
test = #{s}.test|]

testPhases
  :: MonadIO m
  => (forall a. Doc -> m a)
  -> (Doc -> m ())
  -> String
  -> String
  -> [String]
  -> SolutionConfig
  -> [E.Extension]
  -> String
  -> FilePath
  -> [m ()]
testPhases :: forall (m :: * -> *).
MonadIO m =>
(forall a. Doc -> m a)
-> (Doc -> m ())
-> String
-> String
-> [String]
-> SolutionConfig
-> [Extension]
-> String
-> String
-> [m ()]
testPhases forall a. Doc -> m a
reject Doc -> m ()
inform String
template String
submissionFile [String]
modules SolutionConfig
config [Extension]
exts String
submission String
dirname =
  [
    do
    -- Reject if submission does not compile with provided hidden modules,
    -- but without Test module.
    Either InterpreterError Bool
compilation <- IO (Either InterpreterError Bool)
-> m (Either InterpreterError Bool)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either InterpreterError Bool)
 -> m (Either InterpreterError Bool))
-> IO (Either InterpreterError Bool)
-> m (Either InterpreterError Bool)
forall a b. (a -> b) -> a -> b
$ [String]
-> InterpreterT IO Bool -> IO (Either InterpreterError Bool)
forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
[String] -> InterpreterT m a -> m (Either InterpreterError a)
unsafeRunInterpreterWithArgs
      -- disable default warnings (bleed into error report if code doesn't compile)
      [String
"-w"]
      (String -> [Extension] -> [String] -> InterpreterT IO Bool
forall (m :: * -> *).
MonadInterpreter m =>
String -> [Extension] -> [String] -> m Bool
compiler String
dirname [Extension]
exts [String]
noTest)
    (forall a. Doc -> m a)
-> Either InterpreterError Bool
-> (Doc -> m ())
-> Maybe Natural
-> (Bool -> m ())
-> m ()
forall (m :: * -> *) a.
Monad m =>
(forall b. Doc -> m b)
-> Either InterpreterError a
-> (Doc -> m ())
-> Maybe Natural
-> (a -> m ())
-> m ()
checkResult Doc -> m b
forall a. Doc -> m a
reject Either InterpreterError Bool
compilation Doc -> m ()
forall a. Doc -> m a
reject Maybe Natural
forall a. Maybe a
Nothing ((Bool -> m ()) -> m ()) -> (Bool -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ m () -> Bool -> m ()
forall a b. a -> b -> a
const (m () -> Bool -> m ()) -> m () -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    -- Reject if submission does not compile with provided hidden modules.
    -- This only runs when allowModifying is set to True in the config
    -- and displays a custom message telling students not to change type signatures.
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Identity Bool -> Bool
forall a. Identity a -> a
runIdentity (Identity Bool -> Bool) -> Identity Bool -> Bool
forall a b. (a -> b) -> a -> b
$ SolutionConfig -> Identity Bool
forall (m :: * -> *). FSolutionConfig m -> m Bool
allowModifying SolutionConfig
config) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
      Either InterpreterError Bool
compilationWithTests <- IO (Either InterpreterError Bool)
-> m (Either InterpreterError Bool)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either InterpreterError Bool)
 -> m (Either InterpreterError Bool))
-> IO (Either InterpreterError Bool)
-> m (Either InterpreterError Bool)
forall a b. (a -> b) -> a -> b
$ InterpreterT IO Bool -> IO (Either InterpreterError Bool)
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
InterpreterT m a -> m (Either InterpreterError a)
runInterpreter (InterpreterT IO Bool -> IO (Either InterpreterError Bool))
-> InterpreterT IO Bool -> IO (Either InterpreterError Bool)
forall a b. (a -> b) -> a -> b
$
        String -> [Extension] -> [String] -> InterpreterT IO Bool
forall (m :: * -> *).
MonadInterpreter m =>
String -> [Extension] -> [String] -> m Bool
compiler String
dirname [Extension]
exts [String]
modules
      (forall a. Doc -> m a)
-> Either InterpreterError Bool
-> (Doc -> m ())
-> Maybe Natural
-> (Bool -> m ())
-> m ()
forall (m :: * -> *) a.
Monad m =>
(forall b. Doc -> m b)
-> Either InterpreterError a
-> (Doc -> m ())
-> Maybe Natural
-> (a -> m ())
-> m ()
checkResult Doc -> m b
forall a. Doc -> m a
reject Either InterpreterError Bool
compilationWithTests Doc -> m ()
forall {b} {b}. b -> m b
signatureError Maybe Natural
forall a. Maybe a
Nothing ((Bool -> m ()) -> m ()) -> (Bool -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ m () -> Bool -> m ()
forall a b. a -> b -> a
const (m () -> Bool -> m ()) -> m () -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  ,
    -- Reject if GHC warnings configured as errors are triggered by submission.
    String
-> (forall a. Doc -> m a)
-> (Doc -> m ())
-> SolutionConfig
-> [String]
-> (SolutionConfig -> Identity [String])
-> m ()
forall (m :: * -> *).
MonadIO m =>
String
-> (forall b. Doc -> m b)
-> (Doc -> m ())
-> SolutionConfig
-> [String]
-> (SolutionConfig -> Identity [String])
-> m ()
compileWithArgsAndCheck String
dirname Doc -> m b
forall a. Doc -> m a
reject Doc -> m ()
forall a. Doc -> m a
rejectWithHint SolutionConfig
config [String]
noTest SolutionConfig -> Identity [String]
forall (m :: * -> *). FSolutionConfig m -> m [String]
configGhcErrors
  ,
    -- Reject if HLint warnings configured as errors are triggered by submission.
    m [Any] -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m [Any] -> m ()) -> m [Any] -> m ()
forall a b. (a -> b) -> a -> b
$ (Doc -> m Any)
-> SolutionConfig
-> String
-> String
-> (SolutionConfig -> Identity [String])
-> m [Any]
forall (m :: * -> *) a.
MonadIO m =>
(Doc -> m a)
-> SolutionConfig
-> String
-> String
-> (SolutionConfig -> Identity [String])
-> m [a]
getHlintFeedback Doc -> m Any
forall a. Doc -> m a
rejectWithHint SolutionConfig
config String
dirname String
submissionFile SolutionConfig -> Identity [String]
forall (m :: * -> *). FSolutionConfig m -> m [String]
configHlintErrors
  ,
    -- Reject on task template violations according to settings (modifying, adding, deleting).
    (forall a. Doc -> m a)
-> SolutionConfig -> Int -> [Extension] -> String -> String -> m ()
forall (m :: * -> *).
Monad m =>
(forall a. Doc -> m a)
-> SolutionConfig -> Int -> [Extension] -> String -> String -> m ()
matchTemplate Doc -> m a
forall a. Doc -> m a
reject SolutionConfig
config Int
2 [Extension]
exts String
template String
submission
  ,
    do
    -- Reject if test suite fails for submission.
    Either InterpreterError (IO (Counts, String -> String))
result <- IO (Either InterpreterError (IO (Counts, String -> String)))
-> m (Either InterpreterError (IO (Counts, String -> String)))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either InterpreterError (IO (Counts, String -> String)))
 -> m (Either InterpreterError (IO (Counts, String -> String))))
-> IO (Either InterpreterError (IO (Counts, String -> String)))
-> m (Either InterpreterError (IO (Counts, String -> String)))
forall a b. (a -> b) -> a -> b
$ InterpreterT IO (IO (Counts, String -> String))
-> IO (Either InterpreterError (IO (Counts, String -> String)))
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
InterpreterT m a -> m (Either InterpreterError a)
runInterpreter (String
-> [Extension]
-> [String]
-> InterpreterT IO (IO (Counts, String -> String))
forall (m :: * -> *).
MonadInterpreter m =>
String
-> [Extension] -> [String] -> m (IO (Counts, String -> String))
interpreter String
dirname [Extension]
exts [String]
modules)
    (forall a. Doc -> m a)
-> Either InterpreterError (IO (Counts, String -> String))
-> (Doc -> m ())
-> Maybe Natural
-> (IO (Counts, String -> String) -> m ())
-> m ()
forall (m :: * -> *) a.
Monad m =>
(forall b. Doc -> m b)
-> Either InterpreterError a
-> (Doc -> m ())
-> Maybe Natural
-> (a -> m ())
-> m ()
checkResult Doc -> m b
forall a. Doc -> m a
reject Either InterpreterError (IO (Counts, String -> String))
result Doc -> m ()
forall a. Doc -> m a
reject Maybe Natural
forall a. Maybe a
Nothing ((IO (Counts, String -> String) -> m ()) -> m ())
-> (IO (Counts, String -> String) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ (forall a. Doc -> m a) -> IO (Counts, String -> String) -> m ()
forall (m :: * -> *).
MonadIO m =>
(forall a. Doc -> m a) -> IO (Counts, String -> String) -> m ()
handleCounts Doc -> m a
forall a. Doc -> m a
reject
  ,
    do
    -- Displays GHC warnings configured as non-errors triggered by submission.
    String
-> (forall a. Doc -> m a)
-> (Doc -> m ())
-> SolutionConfig
-> [String]
-> (SolutionConfig -> Identity [String])
-> m ()
forall (m :: * -> *).
MonadIO m =>
String
-> (forall b. Doc -> m b)
-> (Doc -> m ())
-> SolutionConfig
-> [String]
-> (SolutionConfig -> Identity [String])
-> m ()
compileWithArgsAndCheck String
dirname Doc -> m b
forall a. Doc -> m a
reject Doc -> m ()
inform SolutionConfig
config [String]
noTest SolutionConfig -> Identity [String]
forall (m :: * -> *). FSolutionConfig m -> m [String]
configGhcWarnings

    -- Displays HLint suggestions configured as non-errors triggered by submission.
    m [()] -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m [()] -> m ()) -> m [()] -> m ()
forall a b. (a -> b) -> a -> b
$ (Doc -> m ())
-> SolutionConfig
-> String
-> String
-> (SolutionConfig -> Identity [String])
-> m [()]
forall (m :: * -> *) a.
MonadIO m =>
(Doc -> m a)
-> SolutionConfig
-> String
-> String
-> (SolutionConfig -> Identity [String])
-> m [a]
getHlintFeedback Doc -> m ()
inform SolutionConfig
config String
dirname String
submissionFile SolutionConfig -> Identity [String]
forall (m :: * -> *). FSolutionConfig m -> m [String]
configHlintSuggestions
  ]
  where
    noTest :: [String]
noTest = String -> [String] -> [String]
forall a. Eq a => a -> [a] -> [a]
delete String
"Test" [String]
modules

    rejectWithHint :: Doc -> m b
rejectWithHint = (forall a. Doc -> m a) -> Doc -> Doc -> m b
forall (m :: * -> *) b. (forall a. Doc -> m a) -> Doc -> Doc -> m b
rejectWithMessage Doc -> m a
forall a. Doc -> m a
reject Doc
rejectHint

    signatureError :: b -> m b
signatureError = m b -> b -> m b
forall a b. a -> b -> a
const (m b -> b -> m b) -> m b -> b -> m b
forall a b. (a -> b) -> a -> b
$ Doc -> m b
forall a. Doc -> m a
rejectWithHint (Doc -> m b) -> Doc -> m b
forall a b. (a -> b) -> a -> b
$ String -> Doc
string [SI.iii|
      Your code is not compatible with the test suite.
      Please do adhere to type requirements expressed in the given code template.
      |]

checkLineLength :: Applicative m => (forall a. Doc -> m a) -> String -> Natural -> m ()
checkLineLength :: forall (m :: * -> *).
Applicative m =>
(forall a. Doc -> m a) -> String -> Natural -> m ()
checkLineLength forall a. Doc -> m a
reject String
code Natural
maxLength = case [Doc]
hasLonger of
  [] -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  [Doc]
xs -> Doc -> m ()
forall a. Doc -> m a
rejectWithHint (Doc -> m ()) -> Doc -> m ()
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
separated
    [ Doc
"Your submission contains overlong lines:"
    , [Doc] -> Doc
separated [Doc]
xs
    , Doc
"The maximum line length allowed is" Doc -> Doc -> Doc
<+> String -> Doc
string (Natural -> String
forall a. Show a => a -> String
show Natural
maxLength) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"."
    ]
  where
    codeLines :: [String]
codeLines = String -> [String]
lines String
code
    hasLonger :: [Doc]
hasLonger =
      [ Int -> String -> Int -> Doc
format Int
i String
l Int
lineLength
      | (Int
i, String
l) <- [Int] -> [String] -> [(Int, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [String]
codeLines
      , let lineLength :: Int
lineLength = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
l
      , Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lineLength Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Natural
maxLength
      ]
    format :: Int -> String -> Int -> Doc
format Int
i String
l Int
lineLength = Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat
      [ Doc
"Line" Doc -> Doc -> Doc
<+> Int -> Doc
int Int
i Doc -> Doc -> Doc
<+> Doc
"(length" Doc -> Doc -> Doc
<+> Int -> Doc
int Int
lineLength Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"):"
      , String -> Doc
string String
l
      ]
    separated :: [Doc] -> Doc
separated = [Doc] -> Doc
vcat ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
linebreak
    rejectWithHint :: Doc -> m b
rejectWithHint = (forall a. Doc -> m a) -> Doc -> Doc -> m b
forall (m :: * -> *) b. (forall a. Doc -> m a) -> Doc -> Doc -> m b
rejectWithMessage Doc -> m a
forall a. Doc -> m a
reject Doc
rejectHint