From a5984b7a16a36b1a224371ea08b25b3f8e0c2ada Mon Sep 17 00:00:00 2001 From: patritzenfeld Date: Thu, 10 Oct 2024 16:24:50 +0200 Subject: [PATCH 1/4] lint proplogic --- tasks/proplogic.txt | 43 ++++++++++++++----------------------------- 1 file changed, 14 insertions(+), 29 deletions(-) diff --git a/tasks/proplogic.txt b/tasks/proplogic.txt index 122d581..0d7315e 100644 --- a/tasks/proplogic.txt +++ b/tasks/proplogic.txt @@ -35,7 +35,7 @@ import Data.List.Split (chunksOf) import Data.Maybe (fromJust) import Data.Text (Text) import Data.String.Interpolate (i) -import FlexTask.FormUtil (($$>), addCss, getFormData, newFlexId, newFlexName) +import FlexTask.FormUtil (($$>), addCss, getFormData) import FlexTask.Generic.Form ( Alignment(..), FieldInfo, @@ -69,13 +69,13 @@ getParticipants = vectorOf 4 arbitrary `suchThat` or getTask :: Gen (String, String, IO ([String],String)) getTask = do - values@[a,b,c,d] <- getParticipants + [a,b,c,d] <- getParticipants names <- getNames (formula, legend, hints) <- formulaAndHints a b c d names let zipped = [(a, A), (b, B), (c, C), (d, D)] coming = [ n | (True,n) <- zipped ] - pure (show ((legend,hints),coming), checkers formula startingTable False True, getFormData (form names)) + pure (show ((legend,hints),coming), checkers formula False True, getFormData (form names)) where form :: (Text,Text,Text,Text) -> Rendered form n = tableForm ["A","B","C","D"] 16 7 $$> formify (Nothing :: Maybe FormType) (nonTableFields n) @@ -123,7 +123,7 @@ formulaAndHints a b c d (aN,bN,cN,dN) = do auch :: String auch = " auch" - neg b x = if b then Neg (Atomic x) else Atomic x + neg expr x = if expr then Neg (Atomic x) else Atomic x part1 = Assoc Impl (Brackets $ Assoc And (neg b 'B') (neg d 'D')) (neg (not c) 'C') @@ -198,13 +198,13 @@ deriving instance Data (PropFormula Char) startingTable :: [[Maybe Binary]] startingTable = map (Just . Binary . toEnum . digitToInt) <$> - transpose (pad . (`showBin` "") <$> [0..15]) + transpose (pad . (`showBin` "") <$> [0..15 :: Int]) where pad s = replicate (4 - length s) '0' ++ s -checkers :: PropFormula Char -> [[Maybe Binary]] -> Bool -> Bool -> String -checkers fSol startingTable tableRequired showSolution = [i| +checkers :: PropFormula Char -> Bool -> Bool -> String +checkers fSol tableRequired showSolution = [i| {-\# language ApplicativeDo \#-} {-\# language OverloadedStrings \#-} @@ -212,16 +212,14 @@ checkers fSol startingTable tableRequired showSolution = [i| module Check (checkSemantics, checkSyntax) where -import Control.Monad (when, unless) import Control.OutputCapable.Blocks import Control.OutputCapable.Blocks.Generic.Type ( GenericOutput(..) ) import Data.Foldable (toList) -import Data.Functor (($>)) -import Data.List (isInfixOf, transpose) -import Data.Maybe (catMaybes, fromJust, isJust) -import Data.Map ((!), fromList) +import Data.List (isInfixOf) +import Data.Maybe (catMaybes, fromJust) +import Data.Map (fromList) import Data.Ratio (Ratio, (%)) import Data.Tuple (swap) @@ -272,7 +270,7 @@ instance ToSAT (PropFormula Char) where checkSyntax :: OutputCapable m => a -> FilePath -> Submission -> LangM m -checkSyntax _ _ (Table xs,f,n) = do +checkSyntax _ _ (Table xs,_,n) = do assertion (all (`notElem` map (Just . Atomic) "ABCD") nonStaticHeaders) $ translate $ german "Tabellenspalten existieren nur einmal?." assertion (not (null n)) $ translate $ @@ -291,18 +289,18 @@ checkSemantics (_,nSol) _ (Table xs,f,n) = do let subFormulas = all (`isSubFormula` f) $ catMaybes nonStaticHeaders #{checkType} subFormulas $ translate $ german "Tabellenspalten sind Teilformeln der Gesamtformel?" - let correctValues = all correctColumn [(f,b)| (Just f,b) <- drop 4 xs] + let correctValues = all correctColumn [(sf,b)| (Just sf,b) <- drop 4 xs] #{checkType} correctValues $ translate $ german "Tabellenspalten enthalten korrekte Warheitswerte?" yesNo (T.all (`elem` f) "ABCD") $ translate $ german "Formel enthält alle vorkommenden Literale?" - let correctFormula = isSemanticEqual (#{gshow fSol}) f + let correctFormula = isSemanticEqual #{gshow fSol} f yesNo correctFormula $ translate $ german "Die aussagenlogische Formel ist korrekt?" let correctNames = n == nSol yesNo correctNames $ translate $ german "Die Liste der Teilnehmer ist korrekt?" - let correct = filter (==True) [correctStart, correctFormula, correctNames, correctValues] + let correct = filter id [correctStart, correctFormula, correctNames, correctValues] let points = fromIntegral (length correct) % 4 res <- printSolutionAndAssert IndefiniteArticle maybeAnswer points pure res @@ -329,12 +327,10 @@ module Description (description) where import Control.OutputCapable.Blocks import Control.OutputCapable.Blocks.Generic.Type (GenericOutput) -import Data.String.Interpolate (i) import Global - description :: OutputCapable m => FilePath -> ((String,[String]),a) -> LangM m description _ ((legend,hints),_) = do paragraph $ translate $ german @@ -358,9 +354,6 @@ description _ ((legend,hints),_) = do module Parse (parseSubmission) where -import Data.Char (showLitChar) -import Data.String.Interpolate (i) -import Data.Text (Text) import Data.List (transpose) import Data.List.Split (chunksOf) import FlexTask.Generic.Parse ( @@ -372,19 +365,11 @@ import FlexTask.Generic.Parse ( import Text.Parsec ( (<|>), ParseError, - choice, - many1, - parse, string, - try ) -import Text.Parsec.Char (char, oneOf) -import Text.Parsec.String (Parser) - import Trees.Types (PropFormula(..)) import Trees.Parsing () -import qualified Data.Text as T import qualified Formula.Parsing as FP import Global From d4f34c927cf2f331093af4ed1656a9af70ef6ac8 Mon Sep 17 00:00:00 2001 From: patritzenfeld Date: Thu, 10 Oct 2024 16:34:04 +0200 Subject: [PATCH 2/4] lint composeFormula --- tasks/composeFormula.txt | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/tasks/composeFormula.txt b/tasks/composeFormula.txt index 76beae1..5f12486 100644 --- a/tasks/composeFormula.txt +++ b/tasks/composeFormula.txt @@ -15,7 +15,7 @@ import Data.String.Interpolate (i) import FlexTask.FormUtil (getFormData) import FlexTask.Generic.Form import FlexTask.YesodConfig (Rendered) -import Tasks.ComposeFormula.Config (ComposeFormulaInst, defaultComposeFormulaConfig) +import Tasks.ComposeFormula.Config (defaultComposeFormulaConfig) import Tasks.ComposeFormula.Quiz (generateComposeFormulaInst) import Test.QuickCheck.Gen (Gen) @@ -48,12 +48,13 @@ checkers = [i| module Check where -import Control.Monad.IO.Class (MonadIO (liftIO)) +import Control.Monad.IO.Class (MonadIO) import Control.OutputCapable.Blocks import Control.OutputCapable.Blocks.Generic.Type ( GenericOutput ) import Data.Ratio +import Data.Functor (($>)) import Formula.Parsing.Delayed (delayed) import LogicTasks.Syntax.ComposeFormula (partialGrade, completeGrade) import Tasks.ComposeFormula.Config (ComposeFormulaInst(..)) @@ -82,7 +83,7 @@ checkSemantics -> FilePath -> Solution -> Rated m -checkSemantics inst path try = completeGrade path inst (delayed $ toListString try) *> pure 1.0 +checkSemantics inst path try = completeGrade path inst (delayed $ toListString try) $> 1.0 |] @@ -102,7 +103,7 @@ import qualified LogicTasks.Syntax.ComposeFormula as LT description :: (OutputCapable m, MonadIO m) => FilePath -> ComposeFormulaInst -> LangM m -description path inst = LT.description (path <> "/") inst +description path = LT.description (path <> "/") ============================================= From 1ae4ebe6556e3f904615bafcb071d96c0d20d353 Mon Sep 17 00:00:00 2001 From: patritzenfeld Date: Thu, 10 Oct 2024 16:55:25 +0200 Subject: [PATCH 3/4] update default config --- flex-task/src/FlexTask/DefaultConfig.hs | 16 ++-------------- 1 file changed, 2 insertions(+), 14 deletions(-) diff --git a/flex-task/src/FlexTask/DefaultConfig.hs b/flex-task/src/FlexTask/DefaultConfig.hs index b6094e3..bdb20dd 100644 --- a/flex-task/src/FlexTask/DefaultConfig.hs +++ b/flex-task/src/FlexTask/DefaultConfig.hs @@ -97,27 +97,20 @@ Apply 'getFormData' to your finished form to obtain the data for the generator. module TaskData (getTask) where -import Data.Text (Text) import FlexTask.FormUtil (getFormData) import FlexTask.Generic.Form import FlexTask.YesodConfig (Rendered) -import GHC.Generics (Generic) import Data.String.Interpolate (i) import Test.QuickCheck.Gen -import qualified Data.Text as T - import Global -genNumbers = vectorOf 3 $ elements ([1..6] :: [Int]) - - getTask :: Gen (String, String, IO ([String],String)) getTask = do - numbers <- genNumbers + numbers <- vectorOf 3 $ elements [1..6 :: Int] let descData = (numbers !! 0, numbers !! 1, numbers !! 2) checkData = (product numbers, sum numbers) @@ -300,18 +293,13 @@ It only takes your parser as an argument. module Parse (parseSubmission) where -import Data.Text (Text) import FlexTask.Generic.Parse (parseInput, useParser) -import GHC.Generics (Generic) -import Text.Parsec (ParseError, parse) - -import qualified Data.Text as T +import Text.Parsec (ParseError) import Global - parseSubmission :: String -> Either ParseError Solution parseSubmission = useParser parseInput From 9ec9d92d9b3cb008609be08e93b6993e9215245c Mon Sep 17 00:00:00 2001 From: patritzenfeld Date: Fri, 11 Oct 2024 09:00:43 +0200 Subject: [PATCH 4/4] update interpolation test tasks --- tasks/interpolation-test/slowTaskInterpolation.txt | 14 +++----------- .../interpolation-test/slowTaskNoInterpolation.txt | 7 +++---- tasks/interpolation-test/treeInterpolation.txt | 6 ------ tasks/interpolation-test/treeNoInterpolation.txt | 1 - 4 files changed, 6 insertions(+), 22 deletions(-) diff --git a/tasks/interpolation-test/slowTaskInterpolation.txt b/tasks/interpolation-test/slowTaskInterpolation.txt index 40de986..08d93e9 100644 --- a/tasks/interpolation-test/slowTaskInterpolation.txt +++ b/tasks/interpolation-test/slowTaskInterpolation.txt @@ -44,7 +44,6 @@ checkers solution = [i| module Check (checkSemantics, checkSyntax) where -import Control.Monad (when, unless) import Control.OutputCapable.Blocks import Control.OutputCapable.Blocks.Generic.Type ( GenericOutput, @@ -79,9 +78,9 @@ checkSemantics _ _ (a,b) = do |] where neighbourTups = zip3 solution (drop 1 solution) (drop 2 solution) - fromNeighbourTups f = map (\(a,b,c) -> b) $ filter f $ neighbourTups - noNegNeighbours = fromNeighbourTups (\(a,b,c) -> a >= 0 || c >= 0) - noDiv3Neighbours = fromNeighbourTups (\(a,b,c) -> a `mod` 3 /= 0 || c `mod` 3 /= 0) + fromNeighbourTups f = map (\(_,b,_) -> b) $ filter f neighbourTups + noNegNeighbours = fromNeighbourTups (\(a,_,c) -> a >= 0 || c >= 0) + noDiv3Neighbours = fromNeighbourTups (\(a,_,c) -> a `mod` 3 /= 0 || c `mod` 3 /= 0) ============================================= @@ -93,8 +92,6 @@ module Description (description) where import Control.OutputCapable.Blocks import Control.OutputCapable.Blocks.Generic.Type (GenericOutput) -import Global - description :: OutputCapable m => FilePath -> [Int] -> LangM m @@ -124,14 +121,9 @@ description _ input = do module Parse (parseSubmission) where -import Data.String.Interpolate (i) -import Data.Text (Text) import FlexTask.Generic.Parse (parseInput, useParser) -import GHC.Generics (Generic) import Text.Parsec (ParseError) -import qualified Data.Text as T - import Global diff --git a/tasks/interpolation-test/slowTaskNoInterpolation.txt b/tasks/interpolation-test/slowTaskNoInterpolation.txt index c54f80e..a73cddc 100644 --- a/tasks/interpolation-test/slowTaskNoInterpolation.txt +++ b/tasks/interpolation-test/slowTaskNoInterpolation.txt @@ -6,7 +6,6 @@ checkers = [i| module Check (checkSemantics, checkSyntax) where -import Control.Monad (when, unless) import Control.OutputCapable.Blocks import Control.OutputCapable.Blocks.Generic.Type ( GenericOutput, @@ -38,8 +37,8 @@ checkSemantics sol _ (a,b) = do pure 1.0 where neighbourTups = zip3 sol (drop 1 sol) (drop 2 sol) - fromNeighbourTups f = map (\\(a,b,c) -> b) $ filter f $ neighbourTups - noNegNeighbours = fromNeighbourTups (\\(a,b,c) -> a >= 0 || c >= 0) - noDiv3Neighbours = fromNeighbourTups (\\(a,b,c) -> a `mod` 3 /= 0 || c `mod` 3 /= 0) + fromNeighbourTups f = map (\\(_,b,_) -> b) $ filter f neighbourTups + noNegNeighbours = fromNeighbourTups (\\(a,_,c) -> a >= 0 || c >= 0) + noDiv3Neighbours = fromNeighbourTups (\\(a,_,c) -> a `mod` 3 /= 0 || c `mod` 3 /= 0) |] diff --git a/tasks/interpolation-test/treeInterpolation.txt b/tasks/interpolation-test/treeInterpolation.txt index 06e4215..8cb00a7 100644 --- a/tasks/interpolation-test/treeInterpolation.txt +++ b/tasks/interpolation-test/treeInterpolation.txt @@ -78,7 +78,6 @@ checkers solution = [i| module Check (checkSemantics, checkSyntax) where -import Control.Monad (when, unless) import Control.OutputCapable.Blocks import Control.OutputCapable.Blocks.Generic.Type ( GenericOutput @@ -130,14 +129,9 @@ description _ input = do module Parse (parseSubmission) where -import Data.String.Interpolate (i) -import Data.Text (Text) import FlexTask.Generic.Parse (parseInput, useParser) -import GHC.Generics (Generic) import Text.Parsec (ParseError) -import qualified Data.Text as T - import Global diff --git a/tasks/interpolation-test/treeNoInterpolation.txt b/tasks/interpolation-test/treeNoInterpolation.txt index 8901124..c0ac8a8 100644 --- a/tasks/interpolation-test/treeNoInterpolation.txt +++ b/tasks/interpolation-test/treeNoInterpolation.txt @@ -6,7 +6,6 @@ checkers = [i| module Check (checkSemantics, checkSyntax) where -import Control.Monad (when, unless) import Control.OutputCapable.Blocks import Control.OutputCapable.Blocks.Generic.Type ( GenericOutput