module Language.Futhark.PrettyTests (tests) where

import Data.Text qualified as T
import Language.Futhark
import Language.Futhark.SyntaxTests ()
import Test.Tasty
import Test.Tasty.HUnit
import Prelude

var :: QualName Name -> UncheckedExp
var :: QualName Name -> UncheckedExp
var QualName Name
x = QualName Name -> NoInfo StructType -> SrcLoc -> UncheckedExp
forall (f :: * -> *) vn.
QualName vn -> f StructType -> SrcLoc -> ExpBase f vn
Var QualName Name
x NoInfo StructType
forall {k} (a :: k). NoInfo a
NoInfo SrcLoc
forall a. Monoid a => a
mempty

binOp :: QualName Name -> UncheckedExp -> UncheckedExp -> UncheckedExp
binOp :: QualName Name -> UncheckedExp -> UncheckedExp -> UncheckedExp
binOp QualName Name
op UncheckedExp
x UncheckedExp
y = AppExpBase NoInfo Name -> NoInfo AppRes -> UncheckedExp
forall (f :: * -> *) vn.
AppExpBase f vn -> f AppRes -> ExpBase f vn
AppExp ((QualName Name, SrcLoc)
-> NoInfo StructType
-> (UncheckedExp, NoInfo (Maybe VName))
-> (UncheckedExp, NoInfo (Maybe VName))
-> SrcLoc
-> AppExpBase NoInfo Name
forall (f :: * -> *) vn.
(QualName vn, SrcLoc)
-> f StructType
-> (ExpBase f vn, f (Maybe VName))
-> (ExpBase f vn, f (Maybe VName))
-> SrcLoc
-> AppExpBase f vn
BinOp (QualName Name
op, SrcLoc
forall a. Monoid a => a
mempty) NoInfo StructType
forall {k} (a :: k). NoInfo a
NoInfo (UncheckedExp
x, NoInfo (Maybe VName)
forall {k} (a :: k). NoInfo a
NoInfo) (UncheckedExp
y, NoInfo (Maybe VName)
forall {k} (a :: k). NoInfo a
NoInfo) SrcLoc
forall a. Monoid a => a
mempty) NoInfo AppRes
forall {k} (a :: k). NoInfo a
NoInfo

tests :: TestTree
tests :: TestTree
tests =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"Language.Futhark.Pretty"
    [ TestName -> Assertion -> TestTree
testCase TestName
"No outer parens" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        UncheckedExp -> Text
p (QualName Name -> UncheckedExp -> UncheckedExp -> UncheckedExp
binOp QualName Name
"+" (QualName Name -> UncheckedExp
var QualName Name
"x") (QualName Name -> UncheckedExp
var QualName Name
"y"))
          Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text
"x + y",
      TestName -> Assertion -> TestTree
testCase TestName
"No redundant parens" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        UncheckedExp -> Text
p (QualName Name -> UncheckedExp -> UncheckedExp -> UncheckedExp
binOp QualName Name
"+" UncheckedExp
"x+y" (QualName Name -> UncheckedExp
var QualName Name
"z"))
          Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text
"x + y + z",
      TestName -> Assertion -> TestTree
testCase TestName
"Necessary parens" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        UncheckedExp -> Text
p (QualName Name -> UncheckedExp -> UncheckedExp -> UncheckedExp
binOp QualName Name
"+" (QualName Name -> UncheckedExp
var QualName Name
"x") UncheckedExp
"y+z")
          Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text
"x + (y + z)",
      TestName -> Assertion -> TestTree
testCase TestName
"Explicit but redundant parens" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        UncheckedExp -> Text
p UncheckedExp
"(x+y)+z"
          Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text
"(x + y) + z"
    ]
  where
    p :: UncheckedExp -> T.Text
    p :: UncheckedExp -> Text
p = UncheckedExp -> Text
forall a. Pretty a => a -> Text
prettyText