Some test cleanup, easier to thread a Node instance into the tests now

shared/tests/Suite.hs

@@ -5,10 +5,8 @@ import qualified Unison.Test.Doc as Doc
 import qualified Unison.Test.Typechecker as Typechecker
 import qualified Unison.Test.Term as Term
 
-tests :: IO TestTree
-tests = testGroup "unison" <$> sequence [Doc.tests, Typechecker.tests, Term.tests]
+tests :: TestTree
+tests = testGroup "unison" [Doc.tests, Typechecker.tests, Term.tests]
 
 main :: IO ()
-main = do
-  tests <- tests
-  defaultMain tests
+main = defaultMain tests

shared/tests/Unison/Test/Common.hs

@@ -0,0 +1,27 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Unison.Test.Common where
+
+import Control.Monad.IO.Class
+import Unison.Symbol (Symbol)
+import Unison.Node (Node)
+import Unison.Reference (Reference)
+import Unison.Term (Term)
+import Unison.Type (defaultSymbol,Type)
+import qualified Data.Map as Map
+import qualified Unison.Metadata as Metadata
+import qualified Unison.Node as Node
+import qualified Unison.Node.MemNode as MemNode
+import qualified Unison.Note as Note
+import qualified Unison.Term as Term
+import qualified Unison.View as View
+
+type V = Symbol View.DFO
+
+node :: IO (Node IO V Reference (Type V) (Term V), Reference -> V)
+node = do
+  node <- MemNode.make
+  symbols <- liftIO . Note.run $
+    Map.fromList . Node.references <$> Node.search node Term.blank [] 1000 (Metadata.Query "") Nothing
+  let firstName (Metadata.Names (n:_)) = n
+  let lookupSymbol ref = maybe (defaultSymbol ref) (firstName . Metadata.names) (Map.lookup ref symbols)
+  pure (node, lookupSymbol)

shared/tests/Unison/Test/Doc.hs

@@ -6,12 +6,13 @@ import Unison.Dimensions
 -- import Test.Tasty.SmallCheck as SC
 -- import Test.Tasty.QuickCheck as QC
 import Test.Tasty.HUnit
+import qualified Unison.Test.Common as Common
 
 fmt :: Word -> Doc String [Int] -> String
 fmt w d = formatString (Width $ fromIntegral w) d
 
-tests :: IO TestTree
-tests = pure $ testGroup "Doc"
+tests :: TestTree
+tests = testGroup "Doc"
   [ testCase "fits (1)" $ assertEqual "should fit on one line"
       "a b c"
       (fmt 10 (sep' " " ["a", "b", "c"]))
@@ -32,4 +33,4 @@ tests = pure $ testGroup "Doc"
       (fmt 9 (sep " " [embed "a", nest "  " $ sep' " " ["b", "c", "d"], embed "e"]))
   ]
 
-main = defaultMain =<< tests
+main = defaultMain tests

shared/tests/Unison/Test/Term.hs

@@ -23,6 +23,7 @@ import qualified Unison.Metadata as Metadata
 import qualified Unison.Node as Node
 import qualified Unison.Node.MemNode as MemNode
 import qualified Unison.Note as Note
+import qualified Unison.Test.Common as Common
 
 -- term for testing
 type TTerm = Term (Symbol ())
@@ -34,26 +35,19 @@ hash e = ABT.hash e
 dhash :: DTerm -> Hash
 dhash e = ABT.hash e
 
-tests :: IO TestTree
-tests = do
-  node <- MemNode.make
-  symbols <- liftIO . Note.run $
-    Map.fromList . Node.references <$> Node.search node blank [] 1000 (Metadata.Query "") Nothing
-  let firstName (Metadata.Names (n:_)) = n
-  let lookupSymbol ref = maybe (defaultSymbol ref) (firstName . Metadata.names) (Map.lookup ref symbols)
-  let termDoc = view lookupSymbol
-  pure $ testGroup "Term"
+tests :: TestTree
+tests = withResource Common.node (\_ -> pure ()) $ \node -> testGroup "Term"
     [ testCase "alpha equivalence (term)" $ assertEqual "identity"
        ((lam' ["a"] $ var' "a") :: TTerm)
         (lam' ["x"] $ var' "x")
     , testCase "hash cycles" $ assertEqual "pingpong"
        (hash pingpong1)
        (hash pingpong2)
-    , testCase "infix-rendering" $
-      let t = builtin "Number.plus" `app` num 1 `app` num 1 :: DTerm
-      in assertEqual "+"
-           "1 + 1"
-           (Doc.formatText (Width 80) (termDoc t))
+    , testCase "infix-rendering" $ node >>= \(_,symbol) ->
+        let t = builtin "Number.plus" `app` num 1 `app` num 1 :: DTerm
+        in assertEqual "+"
+          "1 + 1"
+          (Doc.formatText (Width 80) (view symbol t))
     ]
 
 -- various unison terms, useful for testing

shared/tests/Unison/Test/Typechecker.hs

@@ -11,6 +11,7 @@ import Unison.Typechecker as Typechecker
 import Unison.Reference as R
 import Unison.Symbol (Symbol)
 import qualified Unison.Test.Term as Term
+import qualified Unison.Test.Common as Common
 
 import Test.Tasty
 -- import Test.Tasty.SmallCheck as SC
@@ -57,8 +58,8 @@ synthesizesAndChecks :: TTerm -> TType -> Assertion
 synthesizesAndChecks e t =
   synthesizes e t >> checks e t
 
-tests :: IO TestTree
-tests = pure $ testGroup "Typechecker"
+tests :: TestTree
+tests = withResource Common.node (\_ -> pure ()) $ \node -> testGroup "Typechecker"
   [ testCase "alpha equivalence (type)" $ assertEqual "const"
       (forall' ["a", "b"] $ T.v' "a" --> T.v' "b" --> T.v' "a")
       (forall' ["x", "y"] $ T.v' "x" --> T.v' "y" --> T.v' "x")
@@ -95,6 +96,9 @@ tests = pure $ testGroup "Typechecker"
   , testCase "synthesize/check Term.pingpong1" $ synthesizesAndChecks
       Term.pingpong1
       (forall' ["a"] $ T.v' "a")
+  -- , testCase "synthesize/check [1,2,1+1]" $ synthesizesAndChecks
+  --     (vector [E.num 1, E.num 2, E.builtin "Number.plus" `E.app` E.num 1 `E.app` E.num 1])
+  --    (T.Vector `app` T.lit T.Number)
   ]
 
 env :: Applicative f => TEnv f
@@ -110,4 +114,4 @@ env r =
     _ -> error $ "no type for reference " ++ show r
 
 main :: IO ()
-main = defaultMain =<< tests
+main = defaultMain tests