diff --git a/package.yaml b/package.yaml index 8983f4e..36f4bdb 100644 --- a/package.yaml +++ b/package.yaml @@ -30,6 +30,8 @@ dependencies: - time - unix - vty +- hspec +- QuickCheck #- containers #- unordered-containers #- transformers diff --git a/test/Spec.hs b/test/Spec.hs index cd4753f..a14b21b 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,2 +1,41 @@ +import Test.Hspec + +import Tests.DateExpr + +{- +parseEval :: String -> Maybe Integer +parseEval str = + let day = ModifiedJulianDay 0 + expr = TM.parseIntExpr str + in expr >>= flip TM.evalIntExpr day + +prop_ParseInteger :: Integer -> Bool +prop_ParseInteger n = parseEval (show n) == Just n + +prop_ParseAddSub :: Integer -> Integer -> Integer -> Integer -> Bool +prop_ParseAddSub a b c d = + let formula = show a ++ "+" ++ show b ++ "- (" ++ show c ++ "+" ++ show d ++ ")" + expected = a + b - (c + d) + in parseEval formula == Just expected + +prop_ParseMultDiv :: Integer -> Integer -> Integer -> Integer -> Property +prop_ParseMultDiv a b c d = + let formula = show a ++ "*" ++ show b ++ "/ (" ++ show c ++ "*" ++ show d ++ ")" + expected = a * b `div` (c * d) + in (c * d /= 0) ==> parseEval formula == Just expected + main :: IO () -main = putStrLn "Test suite not yet implemented" +main = hspec $ do + describe "Expressions" $ do + describe "IntExpr" $ do + it "parses integers" $ property $ prop_ParseInteger + it "parses addition and subtraction" $ property $ prop_ParseAddSub + it "parses multiplication and division" $ property $ prop_ParseMultDiv + it "parses a complicated equation" $ + parseEval "12 - (2 / 5) * 3 + ((37))" `shouldBe` Just (12 - (2 `div` 5) * 3 + 37) + describe "BoolExpr" $ do +-} + +main :: IO () +main = hspec $ do + testDateExpr diff --git a/test/Tests/DateExpr.hs b/test/Tests/DateExpr.hs new file mode 100644 index 0000000..dab2910 --- /dev/null +++ b/test/Tests/DateExpr.hs @@ -0,0 +1,73 @@ +module Tests.DateExpr + ( testDateExpr + ) where + +import Data.Time.Calendar + +import Test.Hspec +import Test.QuickCheck + +import qualified TaskMachine.DateExpr as TM + +parseEvalInt :: String -> Day -> Maybe Integer +parseEvalInt str day = do + expr <- TM.parseIntExpr str + TM.evalIntExpr expr day + +parseEvalBool :: String -> Day -> Maybe Bool +parseEvalBool str day = do + expr <- TM.parseBoolExpr str + TM.evalBoolExpr expr day + +toDay :: Integer -> Day +toDay = ModifiedJulianDay + +anyDay :: Day +anyDay = toDay 0 + +{- + - IntExpr properties + -} + +prop_ParseInteger :: Integer -> Property +prop_ParseInteger n = parseEvalInt (show n) anyDay === Just n + +prop_ParseAddSub :: Integer -> Integer -> Integer -> Integer -> Property +prop_ParseAddSub a b c d = + let formula = show a ++ "+" ++ show b ++ "- (" ++ show c ++ "+" ++ show d ++ ")" + expected = a + b - (c + d) + in parseEvalInt formula anyDay === Just expected + +prop_ParseMultDiv :: Integer -> Integer -> Integer -> Integer -> Property +prop_ParseMultDiv a b c d = + let formula = show a ++ "*" ++ show b ++ "/ (" ++ show c ++ "*" ++ show d ++ ")" + expected = a * b `div` (c * d) + in (c * d /= 0) ==> parseEvalInt formula anyDay === Just expected + +prop_ParseComplicated :: Integer -> Integer -> Integer -> Integer -> Integer -> Property +prop_ParseComplicated a b c d e = + let formula = show a ++ "% -(" ++ show b ++ "/" ++ show c ++ ") +" + ++ show d ++ "* ((" ++ show e ++ "))" + expected = a `mod` (-(b `div` c)) + d * e + in (c /= 0 && (b `div` c) /= 0) ==> parseEvalInt formula anyDay === Just expected + +{- + - BoolExpr properties + -} + +prop_ParseLeapYears :: Integer -> Property +prop_ParseLeapYears a = + let formula = "((year%400 == 0) || ((year%4 == 0) && (year%100 != 0))) == isleapyear" + in parseEvalBool formula (toDay a) === Just True + +testDateExpr :: SpecWith () +testDateExpr = describe "Date expressions" $ do + describe "IntExpr" $ do + it "parses integers" $ property prop_ParseInteger + it "parses addition and subtraction" $ property prop_ParseAddSub + it "parses multiplication and division" $ property prop_ParseMultDiv + it "parses a complicated equation" $ property prop_ParseComplicated + describe "BoolExpr" $ do + it "parses \"true\"" $ parseEvalBool "true" anyDay `shouldBe` Just True + it "parses \"false\"" $ parseEvalBool "false" anyDay `shouldBe` Just False + it "parses leap years" $ property prop_ParseLeapYears