{-# LANGUAGE OverloadedStrings #-}
module Main where

import Fragnix.ModuleDeclarations (
    parse,moduleDeclarationsWithEnvironment,moduleSymbols)
import Fragnix.Declaration (writeDeclarations)
import Fragnix.DeclarationLocalSlices (declarationLocalSlices)
import Fragnix.HashLocalSlices (hashLocalSlices,replaceSliceID)
import Fragnix.Slice (Slice(Slice),writeSlice)
import Fragnix.LocalSlice (LocalSliceID(LocalSliceID))
import Fragnix.Environment (loadEnvironment)
import Fragnix.SliceSymbols (updateEnvironment,lookupLocalIDs)
import Fragnix.SliceCompiler (writeSlicesModules,invokeGHC)
import Fragnix.Paths (slicesPath,builtinEnvironmentPath,compilationunitsPath,declarationsPath)

import Test.Tasty (testGroup,TestTree)
import Test.Tasty.Golden (goldenVsFileDiff)
import Test.Tasty.Golden.Manage (defaultMain)

import Language.Haskell.Exts (prettyPrint)
import Language.Haskell.Names (symbolName)
import Data.Text as Text (append)

import Control.Monad (forM_,forM,when)
import qualified Data.Map as Map (toList)
import Data.Foldable (toList)
import System.Exit (ExitCode(ExitSuccess,ExitFailure))

import System.Directory (getDirectoryContents,removeDirectoryRecursive,doesDirectoryExist)
import System.FilePath ((</>),takeExtension)


main :: IO ()
main = do
    packagenames <- getDirectoryContents examplePackageFolder >>=
        return . filter (not . (=='.') . head)
    quicknames <- getDirectoryContents exampleQuickFolder >>=
        return . filter (not . (=='.') . head)
    defaultMain (testGroup "tests" [
        testGroup "packages" (map (testCase examplePackageFolder) packagenames),
        testGroup "quick" (map (testCase exampleQuickFolder) quicknames)])

examplePackageFolder :: FilePath
examplePackageFolder = "tests/packages"

exampleQuickFolder :: FilePath
exampleQuickFolder = "tests/quick"

testCase :: FilePath -> String -> TestTree
testCase folder testname = goldenVsFileDiff
    testname
    (\ref new -> ["diff", "-u", ref, new])
    (folder </> testname </> "golden")
    (folder </> testname </> "out")
    (testModules (folder </> testname))


testModules :: FilePath -> IO ()
testModules folder = do

    modulefilenames <- getDirectoryContents folder >>=
        return . filter (\filename -> takeExtension filename == ".hs")
    let modulepaths = map (\filename -> folder </> filename) modulefilenames

    builtinEnvironment <- loadEnvironment builtinEnvironmentPath
    modules <- forM modulepaths parse

    let declarations = moduleDeclarationsWithEnvironment builtinEnvironment modules
    writeDeclarations declarationsPath declarations

    let (localSlices, symbolLocalIDs) = declarationLocalSlices declarations
    let (localSliceIDMap, slices) = hashLocalSlices localSlices
    let symbolSliceIDs = lookupLocalIDs symbolLocalIDs localSliceIDMap
    forM_ slices (\slice -> writeSlice slicesPath slice)

    let environment = updateEnvironment symbolSliceIDs (moduleSymbols builtinEnvironment modules)
        moduleSymbolResults = do
            (moduleName,symbols) <- Map.toList environment
            return (prettyPrint moduleName ++ " " ++ unwords (map (prettyPrint . symbolName) symbols))

    sliceModuleDirectoryExists <- doesDirectoryExist compilationunitsPath
    when sliceModuleDirectoryExists (removeDirectoryRecursive compilationunitsPath)

    let sliceIDs = [sliceID | Slice sliceID _ _ _ _ <- toList slices]
    writeSlicesModules sliceIDs
    exitCodes <- forM sliceIDs (\sliceID -> do
        invokeGHC [sliceID])
    let successes = length [() | ExitSuccess   <- exitCodes]
        failures  = length [() | ExitFailure _ <- exitCodes]

    let localSlices = map (replaceSliceID (\sliceID ->
            LocalSliceID (Text.append "T" sliceID))) slices

    let (_, rehashedLocalSlices) = hashLocalSlices localSlices

    let rehashedSlicesEqual = rehashedLocalSlices == slices

    let result = unlines ([
            "Successes: " ++ show successes,
            "Failures: " ++ show failures,
            "Rehashing: " ++ show rehashedSlicesEqual] ++
            moduleSymbolResults)
    writeFile (folder </> "out") result


