content: {-# 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 []) . filter Value.shouldShow
  
        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 = 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
  