feat: machinery for unit + golden file tests

Also wrote some initial unit and golden file tests.

Author: japiirainen

fp.cabal

@@ -110,6 +110,15 @@ test-suite tasty
   ghc-options:        -Wall
   build-depends:
       base
+    , directory
+    , filepath
     , fp
+    , mtl
+    , prettyprinter
+    , safe-exceptions
+    , tasty
+    , tasty-hunit
+    , tasty-silver
+    , text
 
   default-language:   Haskell2010

hie.yaml

@@ -2,7 +2,7 @@ cradle:
   cabal:
     - path: "app"
       component: "exe:fp"
-    - path: "tests"
+    - path: "tasty"
       component: "test:tasty"
     - path: "doctest"
       component: "test:doctest"

package.yaml

@@ -64,6 +64,15 @@ tests:
     dependencies:
       - base
       - fp
+      - directory
+      - filepath
+      - mtl
+      - prettyprinter
+      - safe-exceptions
+      - tasty
+      - tasty-hunit
+      - tasty-silver
+      - text
   doctest:
     main: Main.hs
     source-dirs: doctest

tasty/Main.hs

@@ -1,4 +1,149 @@
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE LambdaCase #-}
+
 module Main where
 
+import Control.Exception.Safe (Exception)
+import Data.Text (Text)
+import Fp.Interpret (Input (..), InterpretError)
+import Fp.Pretty (Pretty (..))
+import System.FilePath ((</>))
+import Test.Tasty (TestTree)
+
+import qualified Control.Exception.Safe as Exception
+import qualified Control.Monad.Except as Except
+import qualified Data.Text as Text
+import qualified Fp.Interpret as Interpret
+import qualified Fp.Normalize as Normalize
+import qualified Fp.Pretty
+import qualified Fp.Syntax as Syntax
+import qualified Fp.Value as Value
+import qualified Fp.Width as Width
+import qualified Prettyprinter as Pretty
+import qualified System.Directory as Directory
+import qualified System.FilePath as FilePath
+import qualified Test.Tasty as Tasty
+import qualified Test.Tasty.HUnit as Tasty.HUnit
+import qualified Test.Tasty.Silver as Silver
+
+pretty_ :: Pretty a => a -> Text
+pretty_ x =
+  Fp.Pretty.renderStrict
+    False
+    Width.defaultWidth
+    (pretty x <> Pretty.hardline)
+
+interpret :: Input -> IO (Either InterpretError [Value.Value])
+interpret = Except.runExceptT . fmap fst . Interpret.interpret
+
+throws :: Exception e => IO (Either e a) -> IO a
+throws io =
+  io >>= \case
+    Left e -> Exception.throw e
+    Right a -> pure a
+
+fileToTestTree :: FilePath -> IO TestTree
+fileToTestTree prefix = do
+  let input = prefix <> "-input.fp"
+  let expectedOutputFile = prefix <> "-output.fp"
+  let expectedStderrFile = prefix <> "-stderr.txt"
+
+  let name = FilePath.takeBaseName input
+
+  eitherResult <- interpret (Path input)
+
+  case eitherResult of
+    Left e -> do
+      return
+        ( Tasty.testGroup
+            name
+            [ Silver.goldenVsAction
+                (name <> " - error")
+                expectedStderrFile
+                (return (Text.pack (Exception.displayException e)))
+                id
+            ]
+        )
+    Right values -> do
+      let generateOutputFile =
+            pure @IO . Text.unlines . map (pretty_ . Normalize.quote [])
+
+      return
+        ( Tasty.testGroup
+            name
+            [ Silver.goldenVsAction
+                (name <> " - output")
+                expectedOutputFile
+                (generateOutputFile values)
+                id
+            ]
+        )
+
+inputFilePrefix :: FilePath -> Maybe FilePath
+inputFilePrefix = fmap Text.unpack . Text.stripSuffix "-input.fp" . Text.pack
+
+directoryToTestTree :: FilePath -> IO TestTree
+directoryToTestTree directory = do
+  let name = FilePath.takeBaseName directory
+  children <- Directory.listDirectory directory
+
+  let process child = do
+        let childPath = directory </> child
+        isDirectory <- Directory.doesDirectoryExist childPath
+        if isDirectory
+          then do
+            testTree <- directoryToTestTree childPath
+            pure [testTree]
+          else case inputFilePrefix childPath of
+            Nothing -> pure []
+            Just prefix -> do
+              testTree <- fileToTestTree prefix
+              pure [testTree]
+
+  testTrees <- traverse process children
+  pure (Tasty.testGroup name (concat testTrees))
+
 main :: IO ()
-main = print "hello from tasty tests!"
+main = do
+  autoGenerated <- directoryToTestTree "tasty/data"
+  let manualTestTree =
+        Tasty.testGroup
+          "Manual tests"
+          [ innerProduct
+          , matrixMul
+          ]
+  let tests = Tasty.testGroup "Tests" [autoGenerated, manualTestTree]
+  Tasty.defaultMain tests
+
+innerProduct :: TestTree
+innerProduct = Tasty.HUnit.testCase "inner product" do
+  actualValue <- throws (interpret (Code "" "/+∘α*∘⍉:<<1,2,3>,<6,5,4>>"))
+
+  let expectedValue =
+        [Value.Atom (Syntax.Int 28)]
+
+  Tasty.HUnit.assertEqual "" expectedValue actualValue
+
+matrixMul :: TestTree
+matrixMul = Tasty.HUnit.testCase "inner product" do
+  let input =
+        Text.unlines
+          [ "Def ip ≡ /+∘α*∘⍉\n"
+          , "Def mm ≡ α(α ip) ∘ α distl ∘ distr ∘ [~0, ⍉∘~1]\n"
+          , "mm:< < <1,2>, <4,5> >, < <6,8>, <7,9>> >"
+          ]
+  actualValue <- last <$> throws (interpret (Code "" input))
+
+  let expectedValue =
+        Value.List
+          [ Value.List
+              [ Value.Atom (Syntax.Int 20)
+              , Value.Atom (Syntax.Int 26)
+              ]
+          , Value.List
+              [ Value.Atom (Syntax.Int 59)
+              , Value.Atom (Syntax.Int 77)
+              ]
+          ]
+
+  Tasty.HUnit.assertEqual "" expectedValue actualValue

tasty/data/primitives/and-input.fp

@@ -0,0 +1,2 @@
+∧:<T,T>
+∧:<F,T>

tasty/data/primitives/and-output.fp

@@ -0,0 +1,4 @@
+T
+
+F
+

tasty/data/primitives/apndl-input.fp

@@ -0,0 +1,2 @@
+apndl:<6, ⌽>
+apndl:<6, <1,2,3>>

tasty/data/primitives/apndl-output.fp

@@ -0,0 +1,4 @@
+< 6 >
+
+< 6, 1, 2, 3 >
+

tasty/data/primitives/apndr-input.fp

@@ -0,0 +1,2 @@
+apndr:<⌽, 6>
+apndr:<<1,2,3>, 6>

tasty/data/primitives/apndr-output.fp

@@ -0,0 +1,4 @@
+< 6 >
+
+< 1, 2, 3, 6 >
+