aihc-parser-1.0.0.2: test/Test/Properties/TypeRoundTrip.hs

{-# LANGUAGE OverloadedStrings #-}

module Test.Properties.TypeRoundTrip
  ( prop_typePrettyRoundTrip,
  )
where

import Aihc.Parser
import Aihc.Parser.Parens (addTypeParens)
import Aihc.Parser.Syntax
import Data.Text qualified as T
import Prettyprinter (Pretty (..), defaultLayoutOptions, layoutPretty)
import Prettyprinter.Render.Text (renderStrict)
import Test.Properties.Arb.Utils (requiredExtensions)
import Test.Properties.Coverage (assertCtorCoverage)
import Test.QuickCheck

typeConfig :: ParserConfig
typeConfig =
  defaultConfig
    { parserExtensions = requiredExtensions
    }

prop_typePrettyRoundTrip :: Type -> Property
prop_typePrettyRoundTrip ty =
  let source = renderStrict (layoutPretty defaultLayoutOptions (pretty ty))
      expected = stripAnnotations (addTypeParens ty)
   in checkCoverage $
        withMaxShrinks 100 $
          assertCtorCoverage ["TAnn"] ty $
            counterexample (T.unpack source) $
              case parseType typeConfig source of
                ParseErr err ->
                  counterexample (formatParseErrors (parserSourceName typeConfig) (Just source) err) False
                ParseOk parsed ->
                  let actual = stripAnnotations parsed
                   in counterexample ("expected: " <> show expected <> "\nactual: " <> show actual) (expected == actual)