Test.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}

module Data.EDN.AST.Test
  ( tests
  ) where

import Hedgehog
  ( Group, Property
  , discover, forAll, property, tripping, withTests
  , (===)
  )

import Data.Text (Text)
import qualified Data.Text as Text

import qualified Data.EDN.AST.Types as EDN
import qualified Data.EDN.AST.Gen as EDN
import qualified Data.EDN.AST.Parser as EDN
import qualified Data.EDN.AST.Printer as EDN

tests :: Group
tests = $$(discover)

type ASTParser = Text -> Either String EDN.TaggedValue

prop_rendered_can_parse_back :: Property
prop_rendered_can_parse_back = property $ do
  tv <- forAll EDN.genTaggedValue
  tripping tv EDN.renderText (EDN.parseText "<generated>" :: ASTParser)

prop_pretty_can_parse_back :: Property
prop_pretty_can_parse_back = property $ do
  tv <- forAll EDN.genTaggedValue
  tripping tv EDN.prettyText (EDN.parseText "<generated>" :: ASTParser)

prop_regr_empty_containers :: Property
prop_regr_empty_containers = withTests 1 . property $ do
  emptyList <- either fail pure $ EDN.parseText "<regr_empty_containers>" "( )"
  emptyList === EDN.NoTag (EDN.List mempty)

  emptyVec <- either fail pure $ EDN.parseText "<regr_empty_containers>" "[ ]"
  emptyVec === EDN.NoTag (EDN.Vec mempty)

  emptySet <- either fail pure $ EDN.parseText "<regr_empty_containers>" "#{ }"
  emptySet === EDN.NoTag (EDN.Set mempty)

  emptyMap <- either fail pure $ EDN.parseText "<regr_empty_containers>" "{ }"
  emptyMap === EDN.NoTag (EDN.Map mempty)

propPretty :: Text -> [Text] -> Property
propPretty plain prettyLines =
  withTests 1 . property $ do
    value <- either fail pure $ EDN.parseText "<propPretty>" plain
    EDN.renderText value === plain
    Text.lines (EDN.prettyText value) === prettyLines

prop_pretty_examples :: Property
prop_pretty_examples =
  propPretty
    "{list (volume own would using shown small pound lady fill luck we flat education)\
    \ map {company grabbed dress fully excited enter goose forth require see sport studied}\
    \ set #{below best clearly explanation laid quiet race ring stopped street various}\
    \ vec [right square or seed thumb catch lose sold you talk combine troops steel vessels]}"
    [ "{list (volume"
    , "       own"
    , "       would"
    , "       using"
    , "       shown"
    , "       small"
    , "       pound"
    , "       lady"
    , "       fill"
    , "       luck"
    , "       we"
    , "       flat"
    , "       education)"
    , " map {company grabbed"
    , "      dress fully"
    , "      excited enter"
    , "      goose forth"
    , "      require see"
    , "      sport studied}"
    , " set #{below"
    , "       best"
    , "       clearly"
    , "       explanation"
    , "       laid"
    , "       quiet"
    , "       race"
    , "       ring"
    , "       stopped"
    , "       street"
    , "       various}"
    , " vec [right"
    , "      square"
    , "      or"
    , "      seed"
    , "      thumb"
    , "      catch"
    , "      lose"
    , "      sold"
    , "      you"
    , "      talk"
    , "      combine"
    , "      troops"
    , "      steel"
    , "      vessels]}"
    ]