diff --git a/hnix.cabal b/hnix.cabal index 571aac7..4665b0a 100644 --- a/hnix.cabal +++ b/hnix.cabal @@ -2,7 +2,7 @@ -- -- see: https://github.com/sol/hpack -- --- hash: b50a1c4cf11872cb711f0ed200482f16620ea7754fe7bf8cf8892413d0231746 +-- hash: ee27a667ebb4b2c1f121147d9491a677c0d0979c0d6547120ded75758329207a name: hnix version: 0.5.0 @@ -176,6 +176,7 @@ test-suite hnix-tests EvalTests NixLanguageTests ParserTests + PrettyParseTests PrettyTests TestCommon Paths_hnix @@ -183,7 +184,9 @@ test-suite hnix-tests tests ghc-options: -Wall -threaded build-depends: - Glob + Diff + , Glob + , QuickCheck , ansi-wl-pprint , base >=4.9 && <5 , bytestring @@ -194,15 +197,19 @@ test-suite hnix-tests , directory , exceptions , filepath + , generic-random , hnix , interpolate + , megaparsec , mtl , optparse-applicative , process + , quickcheck-instances , serialise , split , tasty , tasty-hunit + , tasty-quickcheck , tasty-th , template-haskell , text diff --git a/package.yaml b/package.yaml index e756b3a..60cabe9 100644 --- a/package.yaml +++ b/package.yaml @@ -125,6 +125,12 @@ tests: - tasty-hunit - tasty-th - unix + - QuickCheck + - quickcheck-instances + - generic-random + - Diff + - megaparsec + - tasty-quickcheck benchmarks: hnix-benchmarks: diff --git a/tests/Main.hs b/tests/Main.hs index 366a112..1220c93 100644 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -25,6 +25,7 @@ import Nix.Value import qualified NixLanguageTests import qualified ParserTests import qualified PrettyTests +import qualified PrettyParseTests import System.Environment import System.FilePath.Glob import System.Posix.Files @@ -92,9 +93,11 @@ main = do [ ParserTests.tests , EvalTests.tests , PrettyTests.tests + , PrettyParseTests.tests , evalComparisonTests ] ++ [ testCase "Nix language tests present" ensureLangTestsPresent | runLangTests ] ++ [ nixLanguageTests | runLangTests ] ++ [ testCase "Nixpkgs parses without errors" ensureNixpkgsCanParse | runNixpkgsTests ] + diff --git a/tests/PrettyParseTests.hs b/tests/PrettyParseTests.hs new file mode 100644 index 0000000..2fb3e6d --- /dev/null +++ b/tests/PrettyParseTests.hs @@ -0,0 +1,165 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MonoLocalBinds #-} +{-# OPTIONS -Wno-orphans#-} +module PrettyParseTests where + +import Test.Tasty.QuickCheck hiding (Success, Failure) +import Test.Tasty +import Test.QuickCheck.Instances.Text () +import Test.QuickCheck.Instances.Semigroup () +import qualified Test.QuickCheck.Property as P + +import Nix.Expr (NExpr, NExprF(..), NString(..), NUnaryOp(..), NBinaryOp(..) + , Params(..), NKeyName(..), Antiquoted(..), Binding(..)) +import Nix.Atoms +import Nix.Pretty +import Nix.Parser +import Generic.Random +import Data.Fix +import Data.Text (Text, pack, unpack) +import Text.Megaparsec (Pos, SourcePos, mkPos) +import Control.Monad +import Data.Algorithm.Diff +import Data.Algorithm.DiffOutput +import Data.Char + +-- Instead of using the Generic arbitrary instance (which doesn't exist +-- anyway for Text), we use a different generator which just prints +-- sensible looking variable names +custom :: GenList '[Text] +custom = asciiText :@ Nil + +asciiString :: Gen String +asciiString = do + n <- choose (1, 15) + replicateM n (elements ['a'..'z']) + +asciiText :: Gen Text +asciiText = pack <$> asciiString + +pcustom :: GenList '[Pos] +pcustom = (arbitrary) :@ Nil + +-- | This generator generates selects one of the constructors uniformly +-- and also decreases the size of the generator by dividing by the +-- branching factor. This ensures sensible termination. +genArb :: (GArbitrary (Options 'Sized '[Text]) a, GUniformWeight a) => Gen a +genArb = genericArbitraryWith (setGenerators custom sizedOpts) uniform + +-- Might want to replace this instance with a constant value +instance Arbitrary Pos where + arbitrary = mkPos <$> (getSmall <$> arbitrary `suchThat` (> 0)) + +instance Arbitrary (f (Fix f)) => Arbitrary (Fix f) where + arbitrary = genArb + +instance Arbitrary f => Arbitrary (NString f) where + arbitrary = genArb + +instance Arbitrary SourcePos where + arbitrary = genericArbitraryWith (setGenerators pcustom sizedOpts) uniform + +instance Arbitrary f => Arbitrary (Binding f) where + arbitrary = genArb + +instance Arbitrary f => Arbitrary (NKeyName f) where + arbitrary = genArb + +instance Arbitrary f => Arbitrary (Params f) where + arbitrary = genArb + +instance Arbitrary NAtom where + arbitrary = genArb + +instance Arbitrary NUnaryOp where + arbitrary = genArb + +instance Arbitrary NBinaryOp where + arbitrary = genArb + +instance (Arbitrary f) => Arbitrary (Antiquoted Text f) where + arbitrary = genArb + +instance (Arbitrary f) => Arbitrary (Antiquoted (NString f) f) where + arbitrary = genArb + +-- This is written by hand so we can use `fairList` rather than +-- the normal list Arbitrary instance which makes the generator +-- terminate. The distribution is not scientifically chosen. +instance Arbitrary f => Arbitrary (NExprF f) where + arbitrary = + sized $ \n -> + if n < 2 + then oneof [nConstant, nStr, nSym, nLiteralPath, nEnvPath ] + else + frequency + [ (1, nConstant) + , (1, nSym) + , (4, resize (n `div` 3) nIf) + , (10, nRecSet ) + , (20, nSet ) + , (5, nList ) + , (2, nUnary ) + , (2, resize (n `div` 3) nBinary ) + , (3, resize (n `div` 3) nSelect ) + , (20, resize (n `div` 2) nAbs ) + , (2, resize (n `div` 2) nHasAttr ) + , (10, resize (n `div` 2) nLet ) + , (10, resize (n `div` 2) nWith ) + , (1, resize (n `div` 2) nAssert) + ] + where + nConstant = NConstant <$> arbitrary + nStr = NStr <$> arbitrary + nSym = NSym <$> asciiText + nList = NList <$> fairList arbitrary + nSet = NSet <$> fairList arbitrary + nRecSet = NRecSet <$> fairList arbitrary + nLiteralPath = NLiteralPath <$> asciiString + nEnvPath = NEnvPath <$> asciiString + nUnary = NUnary <$> arbitrary <*> arbitrary + nBinary = NBinary <$> arbitrary <*> arbitrary <*> arbitrary + nSelect = NSelect <$> arbitrary <*> arbitrary <*> arbitrary + nHasAttr = NHasAttr <$> arbitrary <*> arbitrary + nAbs = NAbs <$> arbitrary <*> arbitrary + nLet = NLet <$> arbitrary <*> arbitrary + nIf = NIf <$> arbitrary <*> arbitrary <*> arbitrary + nWith = NWith <$> arbitrary <*> arbitrary + nAssert = NAssert <$> arbitrary <*> arbitrary + +-- | Useful when there are recursive positions at each element of the list +-- as it divides the size by the length of the generated list. +fairList :: Gen a -> Gen [a] +fairList g = do + s <- getSize + k <- choose (0, s) + -- Use max here to avoid dividing by zero when there is the empty list + resize (s `div` (max 1 k)) $ vectorOf k g + +-- | Test that pretty . parse . pretty == pretty +prop_prettyparse :: NExpr -> P.Result +prop_prettyparse p = + case parse (pretty p) of + Failure s -> P.rejected { P.reason = show s ++ show (pretty p) } + Success v -> + let pp = normalise (unpack (pretty p)) + pv = normalise (unpack (pretty v)) + in (P.liftBool (pp == pv)) { P.reason = "Bad parse:" ++ pp ++ pv ++ ppDiff (diff pp pv) ++ show p ++ show v} + where + pretty = pack . show . prettyNix + parse = parseNixText + + normalise = unlines . map (reverse . dropWhile isSpace . reverse) . lines + +diff :: String -> String -> [Diff [String]] +diff s1 s2 = getDiff (map (:[]) (lines s1)) (map (:[]) (lines s2)) + +tests :: TestTree +tests = testProperty "Pretty Parse Property" prop_prettyparse