content: {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE TypeApplications #-}
  {-# LANGUAGE TypeOperators #-}
  {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
  module Main (main) where
  
  import           Analysis.Concrete (Concrete)
  import qualified Analysis.Concrete as Concrete
  import           Analysis.File
  import           Control.Algebra
  import           Control.Carrier.Fail.Either
  import           Control.Carrier.Reader
  import           Control.Monad hiding (fail)
  import           Control.Monad.IO.Class
  -- import           Core.Core
  -- import qualified Core.Eval as Eval
  -- import           Core.Name
  -- import qualified Core.Parser
  -- import           Core.Pretty
  import qualified Data.ByteString.Char8 as ByteString
  import           Data.Foldable
  import           Data.Function
  import qualified Data.IntMap as IntMap
  import           Data.List (sort)
  import qualified Data.Map as Map
  import           Data.Maybe
  import           Data.Text (Text)
  import           GHC.Stack
  -- import qualified Language.Python.Core as Py
  import           Language.Python.Failure
  import           Prelude hiding (fail)
  import           Source.Span
  import           Syntax.Term
  import           Syntax.Var (closed)
  import           System.Directory
  import           System.Exit
  import           System.Path ((</>))
  import qualified System.Path as Path
  import qualified System.Path.Directory as Path
  import qualified Text.Trifecta as Trifecta
  import qualified Language.Python.Grammar as TSP
  import qualified AST.Unmarshal as TS
  
  import qualified Test.Tasty as Tasty
  import qualified Test.Tasty.HUnit as HUnit
  
  -- import qualified Directive
  import           Instances ()
  
  parsePrelude :: IO (Term (Ann Span :+: Core) Name)
  parsePrelude = do
    preludesrc <- ByteString.readFile "semantic-python/src/Prelude.score"
    let ePrelude = Trifecta.parseByteString (Core.Parser.core <* Trifecta.eof) mempty preludesrc
    case Trifecta.foldResult (Left . show) Right ePrelude of
      Right r -> pure r
      Left s  -> HUnit.assertFailure ("Couldn't parse prelude: " <> s)
  
  -- handles CHECK-RESULT directives
  assertEvaluatesTo :: Term (Ann Span :+: Core) Name -> Text -> Concrete (Term (Ann Span :+: Core)) -> HUnit.Assertion
  assertEvaluatesTo core k val = do
    prelude <- parsePrelude
    let withPrelude = (named' "__semantic_prelude" :<- prelude) >>>= core
    allTogether <- maybe (HUnit.assertFailure ("Can’t evaluate open term: " <> showCore (stripAnnotations withPrelude))) pure (closed withPrelude)
    let filius = [File (Path.absRel "<interactive>") (Span (Pos 1 1) (Pos 1 1)) allTogether]
  
    (heap, env) <- case Concrete.concrete Eval.eval filius of
      (heap, [File _ _ (Right (Concrete.Record env))]) ->
        pure (heap, env)
      (_, [File _ _ (Left (_, span, err))]) ->
        HUnit.assertFailure ("Failed evaluation (" <> show span <> "): " <> err)
      (_, files) ->
        HUnit.assertFailure ("Unexpected number of files: " <> show (length files))
  
    let found = Map.lookup (name k) env >>= flip IntMap.lookup heap
    found HUnit.@?= Just val
  {-# HLINT ignore assertEvaluatesTo #-}
  
  -- handles CHECK-TREE directives
  assertTreeEqual :: Term Core Name -> Term Core Name -> HUnit.Assertion
  assertTreeEqual t item = HUnit.assertEqual ("got (pretty)" <> showCore item) t item
  
  
  checkPythonFile :: HasCallStack => Path.RelFile -> Tasty.TestTree
  checkPythonFile fp = HUnit.testCaseSteps (Path.toString fp) $ \step -> withFrozenCallStack $ do
    -- Extract the directives and the core associated with the provided file
    let fullPath  = Path.relDir "semantic-python/test/fixtures" </> fp
    directives <- Directive.readDirectivesFromFile fullPath
    result <- ByteString.readFile (Path.toString fullPath) >>= TS.parseByteString TSP.tree_sitter_python
  
    -- Run the compiler
    let coreResult = Control.Algebra.run
                     . runFail
                     . eliminateFailures
                     . Control.Algebra.run
                     . runReader @Py.Bindings mempty
                     . Py.toplevelCompile @(Failure :+: Ann Span :+: Core) @(Term _)
                     <$> result
  
    -- Dispatch based on the result-directive pair
    for_ directives $ \directive -> do
      step (Directive.describe directive)
      case (coreResult, directive) of
        (Right (Left _), Directive.Fails)          -> pure ()
        (Left err, _)                              -> HUnit.assertFailure ("Parsing failed: " <> err)
        (Right (Left err), _)                      -> HUnit.assertFailure ("Compilation failed: " <> err)
        (Right (Right _), Directive.Fails)         -> HUnit.assertFailure "Expected translation to fail"
        (Right (Right item), Directive.Result k v) -> assertEvaluatesTo item k v
        (Right (Right item), Directive.Tree t)     -> assertTreeEqual (stripAnnotations item) t
  
  milestoneFixtures :: IO Tasty.TestTree
  milestoneFixtures = buildTests <$> readFiles
    where
      readFiles  = liftIO . Path.filesInDir . Path.relDir $ "semantic-python/test/fixtures"
      buildTests = Tasty.testGroup "Python" . fmap checkPythonFile . sort . filter (Path.hasExtension ".py")
  
  main :: IO ()
  main = do
    jq <- findExecutable "jq"
    when (isNothing jq) (die "Error: jq(1) not found in $PATH.")
    milestoneFixtures >>= Tasty.defaultMain
  