delayed parsing

logic-tasks.cabal

@@ -1,6 +1,6 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.35.0.
+-- This file has been generated from package.yaml by hpack version 0.36.0.
 --
 -- see: https://github.com/sol/hpack
 
@@ -54,6 +54,7 @@ library
       Trees.Helpers
       Trees.Generate
       Formula.Parsing
+      Formula.Parsing.Delayed
       Formula.Helpers
       ParsingHelpers
       Config

package.yaml

@@ -16,6 +16,7 @@ dependencies:
   - text
   - output-monad
   - pretty-simple
+  - parsec
   - latex-svg-image >= 0.2
   - bytestring
   - utf8-string
@@ -70,6 +71,7 @@ library:
     - Trees.Helpers
     - Trees.Generate
     - Formula.Parsing
+    - Formula.Parsing.Delayed
     - Formula.Helpers
     - ParsingHelpers
     - Config

src/Formula/Parsing.hs

@@ -82,7 +82,12 @@ instance Parse a => Parse [a] where
         tokenSymbol "]" <|> fail "could not parse an enclosing ']'"
         pure xs
 
-
+instance (Parse a, Parse b) => Parse (a,b) where
+  parser = between (tokenSymbol "(") (tokenSymbol ")") $ do
+    a <- parser
+    tokenSymbol ","
+    b <- parser
+    pure (a,b)
 
 instance Parse Number where
   parser = (lexeme numParse <?> "Number") <|> fail "Could not parse a number"

src/Formula/Parsing/Delayed.hs

@@ -0,0 +1,31 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE DeriveGeneric #-}
+module Formula.Parsing.Delayed where
+
+
+import Text.Parsec
+import Text.Parsec.String (Parser)
+import ParsingHelpers (fully)
+
+import Control.Monad.Output (LangM, english, german, OutputMonad)
+
+import LogicTasks.Helpers (reject)
+
+import Data.Typeable (Typeable)
+import GHC.Generics (Generic)
+
+newtype Delayed a = Delayed String deriving (Eq, Show, Typeable, Generic)
+
+delayed :: String -> Delayed a
+delayed = Delayed
+
+parseDelayed :: Delayed a -> Parser a -> Either ParseError a
+parseDelayed (Delayed str) p = parse p "(delayed input)" str
+
+withDelayed :: OutputMonad m => (a -> LangM m) -> Parser a -> Delayed a -> LangM m
+withDelayed grade p d =
+  case parseDelayed d (fully p) of
+    Left err -> reject $ do
+      english $ show err
+      german $ show err
+    Right x -> grade x

src/LogicTasks/Semantics/Fill.hs

@@ -26,8 +26,6 @@ import LogicTasks.Helpers (example, extra)
 import Data.Foldable.Extra (notNull)
 
 
-
-
 genFillInst :: FillConfig -> Gen FillInst
 genFillInst FillConfig{ cnfConf = CnfConfig { baseConf = BaseConfig{..}, ..}, ..} = do
     cnf <- cnfInRange
@@ -114,8 +112,6 @@ verifyQuiz FillConfig{..}
 start :: [TruthValue]
 start = []
 
-
-
 partialGrade :: OutputMonad m => FillInst -> [TruthValue] -> LangM m
 partialGrade FillInst{..} sol = do
   preventWithHint (solLen /= missingLen)
@@ -134,7 +130,6 @@ partialGrade FillInst{..} sol = do
       solLen = length boolSol
       missingLen = length missing
 
-
 completeGrade :: OutputMonad m => FillInst -> [TruthValue] -> LangM m
 completeGrade FillInst{..} sol = do
   preventWithHint (notNull diff)

src/LogicTasks/Semantics/Max.hs

@@ -26,7 +26,8 @@ import Formula.Types (Cnf, Formula, Literal(..), amount, atomics, genCnf, getCla
 import LogicTasks.Helpers (formulaKey, example, extra)
 import Util (checkTruthValueRange, pairwiseCheck, prevent, preventWithHint, tryGen, withRatio)
 import Control.Monad (when)
-
+import Formula.Parsing.Delayed (Delayed, withDelayed)
+import Formula.Parsing (Parse(..))
 
 
 
@@ -168,10 +169,11 @@ partialMinMax correctLits correct solution allValidTerms isMaxTermTask = do
       then ("Maxterme", "Klauseln", "maxterms", "clauses") -- no-spell-check
       else ("Minterme", "Konjunktionen", "minterms", "conjunctions") -- no-spell-check
 
+partialGrade :: OutputMonad m => MaxInst -> Delayed Cnf -> LangM m
+partialGrade inst = partialGrade' inst `withDelayed` parser
 
-
-partialGrade :: OutputMonad m => MaxInst -> Cnf -> LangM m
-partialGrade MaxInst{..} sol = partialMinMax corLits cnf sol allMaxTerms True
+partialGrade' :: OutputMonad m => MaxInst -> Cnf -> LangM m
+partialGrade' MaxInst{..} sol = partialMinMax corLits cnf sol allMaxTerms True
   where
     corLits = atomics cnf
     allMaxTerms = not $ all (\c -> amount c == length corLits) $ getClauses sol
@@ -202,7 +204,8 @@ completeMinMax showSolution correct solution =
     solTable = getTable solution
     (_,diff) = pairwiseCheck (zip3 (readEntries solTable) (readEntries $ getTable correct) [1..])
 
+completeGrade :: OutputMonad m => MaxInst -> Delayed Cnf -> LangM m
+completeGrade inst = completeGrade' inst `withDelayed` parser
 
-
-completeGrade :: OutputMonad m => MaxInst -> Cnf -> LangM m
-completeGrade MaxInst{..} = completeMinMax showSolution cnf
+completeGrade' :: OutputMonad m => MaxInst -> Cnf -> LangM m
+completeGrade' MaxInst{..} = completeMinMax showSolution cnf

src/LogicTasks/Semantics/Min.hs

@@ -25,7 +25,8 @@ import Formula.Types (Dnf, Literal(..), amount, atomics, genDnf, getConjunctions
 import Formula.Util (mkCon, mkDnf, hasEmptyCon, isEmptyDnf)
 import LogicTasks.Helpers (extra, formulaKey)
 import Util (tryGen, withRatio)
-
+import Formula.Parsing.Delayed (Delayed, withDelayed)
+import Formula.Parsing (Parse(..))
 
 
 
@@ -85,15 +86,18 @@ verifyQuiz = Max.verifyQuiz
 start :: Dnf
 start = mkDnf [mkCon [Literal 'A']]
 
+partialGrade :: OutputMonad m => MinInst -> Delayed Dnf -> LangM m
+partialGrade inst = partialGrade' inst `withDelayed` parser
 
-
-partialGrade :: OutputMonad m => MinInst -> Dnf -> LangM m
-partialGrade MinInst{..} sol = Max.partialMinMax corLits dnf sol allMinTerms False
+partialGrade' :: OutputMonad m => MinInst -> Dnf -> LangM m
+partialGrade' MinInst{..} sol = Max.partialMinMax corLits dnf sol allMinTerms False
   where
     corLits = atomics dnf
     allMinTerms = not $ all (\c -> amount c == length corLits) $ getConjunctions sol
 
 
+completeGrade :: OutputMonad m => MinInst -> Delayed Dnf -> LangM m
+completeGrade inst = completeGrade' inst `withDelayed` parser
 
-completeGrade :: OutputMonad m => MinInst -> Dnf -> LangM m
-completeGrade MinInst{..} = Max.completeMinMax showSolution dnf
+completeGrade' :: OutputMonad m => MinInst -> Dnf -> LangM m
+completeGrade' MinInst{..} = Max.completeMinMax showSolution dnf

src/LogicTasks/Semantics/Pick.hs

@@ -27,8 +27,6 @@ import Data.Maybe (fromJust)
 import Data.List (nubBy)
 
 
-
-
 genPickInst :: PickConfig -> Gen PickInst
 genPickInst PickConfig{ cnfConf = CnfConfig {baseConf = BaseConfig{..}, ..}, ..} = do
     cnfs <- tryGen (vectorOf amountOfOptions (getCnf usedLiterals)) 100 ((amountOfOptions ==) . length . nubBy isSemanticEqual)
@@ -108,17 +106,13 @@ verifyQuiz PickConfig{..}
 start :: Number
 start = Number Nothing
 
-
-
 partialGrade :: OutputMonad m => PickInst -> Number -> LangM m
 partialGrade _ (Number Nothing) = refuse $ indent $
         translate $ do
           german "Es wurde kein Index angegeben."
           english "You did not give an index."
-
 partialGrade _ _ = pure ()
 
-
 completeGrade :: OutputMonad m => PickInst -> Number -> LangM m
 completeGrade PickInst{..} (Number index) =
     if fromJust index == correct

src/LogicTasks/Semantics/Prolog.hs

@@ -27,7 +27,8 @@ import Util(prevent, preventWithHint)
 import Control.Monad (when)
 import LogicTasks.Helpers (example, extra)
 import Formula.Helpers (hasTheClauseShape)
-
+import Formula.Parsing.Delayed (Delayed, withDelayed)
+import Formula.Parsing (Parse(..))
 
 genPrologInst :: PrologConfig -> Gen PrologInst
 genPrologInst PrologConfig{..} = (do
@@ -130,10 +131,11 @@ verifyQuiz PrologConfig{..}
 start :: (PrologLiteral, PrologClause)
 start = (PrologLiteral True "a" ["x"], mkPrologClause [])
 
+partialGrade :: OutputMonad m => PrologInst -> Delayed (PrologLiteral, PrologClause) -> LangM m
+partialGrade inst = partialGrade' inst `withDelayed` parser
 
-
-partialGrade :: OutputMonad m => PrologInst -> (PrologLiteral, PrologClause) -> LangM m
-partialGrade PrologInst{..} sol = do
+partialGrade' :: OutputMonad m => PrologInst -> (PrologLiteral, PrologClause) -> LangM m
+partialGrade' PrologInst{..} sol = do
   prevent (not (fst sol `member` availLits)) $
     translate $ do
       german "Gewähltes Literal kommt in den Klauseln vor?"
@@ -157,10 +159,11 @@ partialGrade PrologInst{..} sol = do
      solLits = pLiterals $ snd sol
      extraLiterals = toList $ solLits `difference` availLits
 
+completeGrade :: OutputMonad m => PrologInst -> Delayed (PrologLiteral, PrologClause) -> LangM m
+completeGrade inst = completeGrade' inst `withDelayed` parser
 
-
-completeGrade :: OutputMonad m => PrologInst -> (PrologLiteral, PrologClause) -> LangM m
-completeGrade PrologInst{..} sol =
+completeGrade' :: OutputMonad m => PrologInst -> (PrologLiteral, PrologClause) -> LangM m
+completeGrade' PrologInst{..} sol =
     case resolveResult of
         Nothing -> refuse $ indent $  do
           translate $ do

src/LogicTasks/Semantics/Resolve.hs

@@ -33,7 +33,8 @@ import Control.Monad (unless, when)
 import Control.Applicative (Alternative)
 import Data.Foldable.Extra (notNull)
 import Text.PrettyPrint.Leijen.Text (Pretty(pretty))
-
+import Formula.Parsing.Delayed (Delayed, withDelayed)
+import Formula.Parsing (Parse(..))
 
 
 
@@ -197,9 +198,11 @@ gradeSteps steps appliedIsNothing = do
             fromJust (resolve c1 c2 x) /= r) (resolvableWith c1 c2)) steps
       checkEmptyClause = null steps || not (isEmptyClause $ third3 $ last steps)
 
+partialGrade :: OutputMonad m => ResolutionInst -> Delayed [ResStep] -> LangM m
+partialGrade inst = partialGrade' inst `withDelayed` parser
 
-partialGrade :: OutputMonad m => ResolutionInst -> [ResStep] -> LangM m
-partialGrade ResolutionInst{..} sol = do
+partialGrade' :: OutputMonad m => ResolutionInst -> [ResStep] -> LangM m
+partialGrade' ResolutionInst{..} sol = do
   checkMapping
 
   preventWithHint (not $ null wrongLitsSteps)
@@ -228,8 +231,11 @@ partialGrade ResolutionInst{..} sol = do
     applied = applySteps clauses steps
     stepsGraded = gradeSteps steps (isNothing applied)
 
-completeGrade :: (OutputMonad m, Alternative m) => ResolutionInst -> [ResStep] -> LangM m
-completeGrade ResolutionInst{..} sol = (if isCorrect then id else refuse) $ do
+completeGrade :: (OutputMonad m, Alternative m) => ResolutionInst -> Delayed [ResStep] -> LangM m
+completeGrade inst = completeGrade' inst `withDelayed` parser
+
+completeGrade' :: (OutputMonad m, Alternative m) => ResolutionInst -> [ResStep] -> LangM m
+completeGrade' ResolutionInst{..} sol = (if isCorrect then id else refuse) $ do
     unless printFeedbackImmediately $ do
       recoverFrom stepsGraded
 

src/LogicTasks/Semantics/Step.hs

@@ -25,8 +25,8 @@ import Formula.Resolution (resolvable, resolve)
 import LogicTasks.Helpers (clauseKey, example, extra)
 import Util (checkBaseConf, prevent, preventWithHint, tryGen)
 import Control.Monad (when)
-
-
+import Formula.Parsing.Delayed (Delayed, withDelayed)
+import Formula.Parsing (Parse(..))
 
 
 genStepInst :: StepConfig -> Gen StepInst
@@ -92,10 +92,11 @@ verifyQuiz StepConfig{..} = checkBaseConf baseConf
 start :: StepAnswer
 start = StepAnswer Nothing
 
+partialGrade :: OutputMonad m => StepInst -> Delayed StepAnswer -> LangM m
+partialGrade inst = partialGrade' inst `withDelayed` parser
 
-
-partialGrade :: OutputMonad m => StepInst -> StepAnswer -> LangM m
-partialGrade StepInst{..} sol = do
+partialGrade' :: OutputMonad m => StepInst -> StepAnswer -> LangM m
+partialGrade' StepInst{..} sol = do
 
   prevent (isNothing $ step sol) $
     translate $ do
@@ -126,10 +127,12 @@ partialGrade StepInst{..} sol = do
      solLits = fromList $ literals $ snd mSol
      extraLiterals = toList (solLits `difference` availLits)
 
+completeGrade :: OutputMonad m => StepInst -> Delayed StepAnswer -> LangM m
+completeGrade inst = completeGrade' inst `withDelayed` parser
 
 
-completeGrade :: OutputMonad m => StepInst -> StepAnswer -> LangM m
-completeGrade StepInst{..} sol =
+completeGrade' :: OutputMonad m => StepInst -> StepAnswer -> LangM m
+completeGrade' StepInst{..} sol =
     case resolve clause1 clause2 (fst mSol) of
         Nothing -> refuse $ indent $ do
           translate $ do

src/LogicTasks/Syntax/SimplestFormula.hs

@@ -18,6 +18,9 @@ import Tasks.SuperfluousBrackets.Config (
 import Trees.Helpers
 import Trees.Types
 import Control.Monad (when)
+import Formula.Parsing.Delayed (Delayed, withDelayed)
+import Formula.Parsing (Parse(..))
+import Trees.Parsing()
 
 
 
@@ -74,9 +77,11 @@ start :: FormulaAnswer
 start = FormulaAnswer Nothing
 
 
+partialGrade :: OutputMonad m => SuperfluousBracketsInst -> Delayed FormulaAnswer -> LangM m
+partialGrade inst = partialGrade' inst `withDelayed` parser
 
-partialGrade :: OutputMonad m => SuperfluousBracketsInst -> FormulaAnswer -> LangM m
-partialGrade SuperfluousBracketsInst{..} f
+partialGrade' :: OutputMonad m => SuperfluousBracketsInst -> FormulaAnswer -> LangM m
+partialGrade' SuperfluousBracketsInst{..} f
     | isNothing $ maybeForm f =
       reject $ do
         english "Your submission is empty."
@@ -110,10 +115,11 @@ partialGrade SuperfluousBracketsInst{..} f
     correctLits = sort $ nub $ collectLeaves tree
     correctOpsNum = numOfOps tree
 
+completeGrade :: OutputMonad m => SuperfluousBracketsInst -> Delayed FormulaAnswer -> LangM m
+completeGrade inst = completeGrade' inst `withDelayed` parser
 
-
-completeGrade :: OutputMonad m => SuperfluousBracketsInst -> FormulaAnswer -> LangM m
-completeGrade inst sol
+completeGrade' :: OutputMonad m => SuperfluousBracketsInst -> FormulaAnswer -> LangM m
+completeGrade' inst sol
     | show (fromJust (maybeForm sol)) /= simplestString inst = refuse $ do
       instruct $ do
         english "Your solution is incorrect."