chore: add property-based tests for Configuration.Dotenv.Parse (#168)

* add QuickCheck * replace parse specs with property-based tests * fix: Little formatting fixes --------- Co-authored-by: CristhianMotoche <[email protected]>
stackbuilders · Jan 9, 2024 · 4dc84d8 · 4dc84d8
1 parent de1572f
commit 4dc84d8
Show file tree

Hide file tree

Showing 2 changed files with 172 additions and 58 deletions.
diff --git a/dotenv.cabal b/dotenv.cabal
@@ -125,6 +125,8 @@ test-suite dotenv-test
                      , process
                      , text
                      , hspec-megaparsec >= 2.0 && < 3.0
+                     , data-default-class >= 0.1.2 && < 0.2
+                     , QuickCheck >= 2.8 && < 3.0
 
   build-tools:        hspec-discover   >= 2.0 && < 3.0
 

diff --git a/spec/Configuration/Dotenv/ParseSpec.hs b/spec/Configuration/Dotenv/ParseSpec.hs
@@ -1,50 +1,46 @@
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Configuration.Dotenv.ParseSpec (main, spec) where
 
-import           Configuration.Dotenv.Internal (ParsedVariable (..),
-                                                VarFragment (..), VarValue (..),
-                                                configParser)
-import           Data.Void                     (Void)
-import           Test.Hspec                    (Spec, context, describe, hspec,
-                                                it)
-import           Test.Hspec.Megaparsec         (shouldFailOn, shouldParse,
-                                                shouldSucceedOn)
-import           Text.Megaparsec               (ParseErrorBundle, parse)
+import Configuration.Dotenv.Internal 
+  ( ParsedVariable (..),
+    VarFragment (..),
+    VarValue (..),
+    configParser
+  )
+import Data.Void (Void)
+import Test.Hspec (Spec, context, describe, hspec, it)
+import Test.Hspec.Megaparsec (shouldFailOn, shouldParse, shouldSucceedOn)
+import Test.QuickCheck
+  ( Arbitrary,
+    Gen,
+    arbitrary,
+    arbitraryPrintableChar,
+    choose,
+    elements,
+    forAll,
+    listOf,
+    listOf1,
+    property,
+    resize,
+    sized,
+    suchThat,
+  )
+import Text.Megaparsec (ParseErrorBundle, parse)
 
 main :: IO ()
-main = hspec spec
+main = hspec $ do
+  spec
+  specProperty
 
 spec :: Spec
 spec = describe "parse" $ do
-  it "parses unquoted values" $
-    parseConfig "FOO=bar"
-      `shouldParse` [ParsedVariable "FOO" (Unquoted [VarLiteral "bar"])]
-
-  it "parses values with spaces around equal signs" $ do
-    parseConfig "FOO =bar"
-      `shouldParse` [ParsedVariable "FOO" (Unquoted [VarLiteral "bar"])]
-    parseConfig "FOO= bar"
-      `shouldParse` [ParsedVariable "FOO" (Unquoted [VarLiteral "bar"])]
-    parseConfig "FOO =\t bar"
-      `shouldParse` [ParsedVariable "FOO" (Unquoted [VarLiteral "bar"])]
-
-  it "parses double-quoted values" $
-    parseConfig "FOO=\"bar\""
-      `shouldParse` [ParsedVariable "FOO" (DoubleQuoted [VarLiteral "bar"])]
-
-  it "parses single-quoted values" $
-    parseConfig "FOO='bar'"
-      `shouldParse` [ParsedVariable "FOO" (SingleQuoted [VarLiteral "bar"])]
-
-  it "parses escaped double quotes" $
-    parseConfig "FOO=\"escaped\\\"bar\""
-      `shouldParse` [ParsedVariable "FOO" (DoubleQuoted [VarLiteral "escaped\"bar"])]
-
   it "supports CRLF line breaks" $
     parseConfig "FOO=bar\r\nbaz=fbb"
-      `shouldParse` [ParsedVariable "FOO" (Unquoted [VarLiteral "bar"]),
-                     ParsedVariable "baz" (Unquoted [VarLiteral "fbb"])]
+      `shouldParse` [ ParsedVariable "FOO" (Unquoted [VarLiteral "bar"]),
+                      ParsedVariable "baz" (Unquoted [VarLiteral "fbb"])
+                    ]
 
   it "parses empty values" $
     parseConfig "FOO="
@@ -54,28 +50,48 @@ spec = describe "parse" $ do
     parseConfig "FOO=$HOME"
       `shouldParse` [ParsedVariable "FOO" (Unquoted [VarInterpolation "HOME"])]
     parseConfig "FOO=abc_$HOME"
-      `shouldParse` [ParsedVariable "FOO" (Unquoted [VarLiteral "abc_",
-                                                     VarInterpolation "HOME"])
+      `shouldParse` [ ParsedVariable
+                        "FOO"
+                        ( Unquoted
+                            [ VarLiteral "abc_",
+                              VarInterpolation "HOME"
+                            ]
+                        )
                     ]
     parseConfig "FOO=${HOME}"
       `shouldParse` [ParsedVariable "FOO" (Unquoted [VarInterpolation "HOME"])]
     parseConfig "FOO=abc_${HOME}"
-      `shouldParse` [ParsedVariable "FOO" (Unquoted [VarLiteral "abc_",
-                                                     VarInterpolation "HOME"])
+      `shouldParse` [ ParsedVariable
+                        "FOO"
+                        ( Unquoted
+                            [ VarLiteral "abc_",
+                              VarInterpolation "HOME"
+                            ]
+                        )
                     ]
 
   it "parses double-quoted interpolated values" $ do
     parseConfig "FOO=\"$HOME\""
       `shouldParse` [ParsedVariable "FOO" (DoubleQuoted [VarInterpolation "HOME"])]
     parseConfig "FOO=\"abc_$HOME\""
-      `shouldParse` [ParsedVariable "FOO" (DoubleQuoted [VarLiteral "abc_",
-                                                         VarInterpolation "HOME"])
+      `shouldParse` [ ParsedVariable
+                        "FOO"
+                        ( DoubleQuoted
+                            [ VarLiteral "abc_",
+                              VarInterpolation "HOME"
+                            ]
+                        )
                     ]
     parseConfig "FOO=\"${HOME}\""
       `shouldParse` [ParsedVariable "FOO" (DoubleQuoted [VarInterpolation "HOME"])]
     parseConfig "FOO=\"abc_${HOME}\""
-      `shouldParse` [ParsedVariable "FOO" (DoubleQuoted [VarLiteral "abc_",
-                                                         VarInterpolation "HOME"])
+      `shouldParse` [ ParsedVariable
+                        "FOO"
+                        ( DoubleQuoted
+                            [ VarLiteral "abc_",
+                              VarInterpolation "HOME"
+                            ]
+                        )
                     ]
 
   it "parses single-quoted interpolated values as literals" $ do
@@ -121,20 +137,9 @@ spec = describe "parse" $ do
 
   it "ignores empty lines" $
     parseConfig "\n \t  \nfoo=bar\n \nfizz=buzz"
-      `shouldParse` [ParsedVariable "foo" (Unquoted [VarLiteral "bar"]),
-                     ParsedVariable "fizz" (Unquoted [VarLiteral "buzz"])]
-
-  it "ignores inline comments after unquoted arguments" $
-    parseConfig "FOO=bar # this is foo"
-      `shouldParse` [ParsedVariable "FOO" (Unquoted [VarLiteral "bar"])]
-
-  it "ignores inline comments after quoted arguments" $
-    parseConfig "FOO=\"bar\" # this is foo"
-      `shouldParse` [ParsedVariable "FOO" (DoubleQuoted [VarLiteral "bar"])]
-
-  it "allows \"#\" in quoted values" $
-    parseConfig "foo=\"bar#baz\" # comment"
-      `shouldParse` [ParsedVariable "foo" (DoubleQuoted [VarLiteral "bar#baz"])]
+      `shouldParse` [ ParsedVariable "foo" (Unquoted [VarLiteral "bar"]),
+                      ParsedVariable "fizz" (Unquoted [VarLiteral "buzz"])
+                    ]
 
   it "ignores comment lines" $
     parseConfig "\n\t \n\n # HERE GOES FOO \nfoo=bar"
@@ -167,5 +172,112 @@ spec = describe "parse" $ do
   it "parses empty content (when the file is empty)" $
     parseConfig `shouldSucceedOn` ""
 
+specProperty :: Spec
+specProperty = do
+  it "parses unquoted values as literals" $
+    property $
+      forAll (generateInput `suchThat` validChars) $ \input -> do
+        let value = "FOO=" ++ input
+        parseConfig value `shouldParse` [ParsedVariable "FOO" (Unquoted [VarLiteral input])]
+
+  it "parses single-quoted values as literals" $
+    property $
+      forAll (generateInput `suchThat` validChars) $ \input -> do
+        let quotedInput = "'" ++ input ++ "'"
+        let value = "FOO=" ++ quotedInput
+        parseConfig value `shouldParse` [ParsedVariable "FOO" (SingleQuoted [VarLiteral input])]
+
+  it "parses double-quoted values as literals" $
+    property $
+      forAll (generateInput `suchThat` validChars) $ \input -> do
+        let quotedInput = "\"" ++ input ++ "\""
+        let value = "FOO=" ++ quotedInput
+        parseConfig value `shouldParse` [ParsedVariable "FOO" (DoubleQuoted [VarLiteral input])]
+
+  it "parses escaped values as literals" $
+    property $
+      forAll (generateTextWithChar "\\\"" "\"") $ \input -> do
+        let quotedInput = "\"" ++ fst input ++ "\""
+        let value = "FOO=" ++ quotedInput
+        parseConfig value `shouldParse` [ParsedVariable "FOO" (DoubleQuoted [VarLiteral $ snd input])]
+
+  it "parses # in quoted values" $
+    property $
+      forAll (generateTextWithChar "#" "#") $ \input -> do
+        let quotedInput = "\"" ++ fst input ++ "\""
+        let value = "FOO=" ++ quotedInput
+        parseConfig value `shouldParse` [ParsedVariable "FOO" (DoubleQuoted [VarLiteral $ snd input])]
+
+  it "parses values with spaces around equal signs" $
+    property $
+      forAll generateValidInputWithSpaces $ \input -> do
+        parseConfig (fst input) `shouldParse` [ParsedVariable "FOO" (Unquoted [VarLiteral $ snd input])]
+
+  it "ignores inline comments after unquoted arguments" $
+    property $
+      forAll (generateInput `suchThat` validChars) $ \input -> do
+        let value = "FOO=" ++ input ++ " # comment" ++ input
+        parseConfig value `shouldParse` [ParsedVariable "FOO" (Unquoted [VarLiteral input])]
+
+  it "ignores inline comments after quoted arguments" $
+    property $
+      forAll (generateInput `suchThat` validChars) $ \input -> do
+        let value = "FOO=" ++ "\"" ++ input ++ "\"" ++ " # comment" ++ input
+        parseConfig value `shouldParse` [ParsedVariable "FOO" (DoubleQuoted [VarLiteral input])]
+
+---------------------------------------------------------------------------
+-- Helpers
+
+validChars :: String -> Bool
+validChars str = not (null str) && all (`notElem` ['\\', '$', '\'', '"', '\"', ' ', '#']) str
+
+-- | Generate random text with a specific character and expected output.
+--
+-- This function generates random text that includes a specific character and
+-- produces both the input string and the expected output string. The generated
+-- text is constructed by repeating a non-empty string multiple times and
+-- appending it with the specified character. The size of the generated text is
+-- limited by the 'maxSize' parameter.
+generateTextWithChar
+  -- | The character to include in the generated text
+  :: String
+  -- | The expected output character to include in the generated text
+  -> String
+  -> Gen (String, String)
+generateTextWithChar input expected = do
+  let maxSize = 5
+  nonEmptyString <- resize maxSize $ generateInput `suchThat` validChars
+  strForQuoted <- resize maxSize $ generateInput `suchThat` validChars
+  numRepeat <- choose (1, maxSize)
+  let quotedStr = input ++ strForQuoted
+  let quotedStrForInput = expected ++ strForQuoted
+  return
+    ( concat (replicate numRepeat (nonEmptyString ++ quotedStr)),
+      concat (replicate numRepeat (nonEmptyString ++ quotedStrForInput))
+    )
+
+generateValidInputWithSpaces :: Gen (String, String)
+generateValidInputWithSpaces = do
+  input <- generateInput `suchThat` validChars
+  spacesBefore <- listOf (elements " \t")
+  spacesAfter <- listOf (elements " \t")
+  return ("FOO" ++ spacesBefore ++ "=" ++ spacesAfter ++ input, input)
+
+generateInput :: Gen String
+generateInput = do
+  nonEmptyString <- arbitrary :: Gen NonEmptyPrintableString
+  return (getNonEmptyPrintableString nonEmptyString)
+
+-- Non-empty version of 'PrintableString'
+newtype NonEmptyPrintableString = NonEmptyPrintableString
+  { getNonEmptyPrintableString :: String
+  }
+  deriving (Show)
+
+instance Arbitrary NonEmptyPrintableString where
+  arbitrary = sized $ \s -> do
+    someText <- resize (s * 10) $ listOf1 arbitraryPrintableChar
+    return $ NonEmptyPrintableString someText
+
 parseConfig :: String -> Either (ParseErrorBundle String Void) [ParsedVariable]
 parseConfig = parse configParser ""