diff --git a/dotenv.cabal b/dotenv.cabal index 8b350f9b..aff66e32 100644 --- 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 index d4928d06..5003c3c6 100644 --- 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 ""