module TestSuite.Tests.C (testGroupC) where

import Control.Monad
import Data.List (intercalate)
import Data.Monoid
import System.Exit
import Test.Tasty
import Test.HUnit
import qualified Data.ByteString.Lazy       as L
import qualified Data.ByteString.Lazy.Char8 as L (unlines)
import qualified Data.Text                  as T

import IdeSession
import TestSuite.Assertions
import TestSuite.Session
import TestSuite.State

testGroupC :: TestSuiteEnv -> TestTree
testGroupC env = testGroup "Using C files" [
    stdTest env "C files in subdirs"                                              test_subdirs
  , stdTest env "Errors and warnings in the C code"                               test_errors
  , stdTest env "Errors in C file, then update C file (#201)"                     test_errorsThenUpdate
  , stdTest env "C header files in subdirectories (#212)"                         test_headersInSubdirs
  , stdTest env "C code writes to stdout (#210)"                                  test_stdout
  -- , stdTest env "Basic functionality, recompiling Haskell modules when necessary" test_Basic
  -- , stdTest env "Deleting C file should unload object file (#241)"                test241
  -- , testGroup "Two C files (no cyclic dependencies)"     $ test_2        env
  -- , testGroup "Two C files (C files mutually dependent)" $ test_2_cyclic env
  ]

test_Basic :: TestSuiteEnv -> Assertion
test_Basic env = withAvailableSession env $ \session -> do
    -- TODO: Ideally, we'd fix this jump in the reported total number of
    -- progress messages
    updateSessionP session upd [
        (1, 1, "Compiling MC.c")
      , (2, 2, "Compiling M")
      ]
    assertNoErrors session
    do runActions <- runStmt session "M" "hello"
       (output, result) <- runWaitAll runActions
       assertEqual "" RunOk result
       assertEqual "" "12345\n" output

    ifTestingExe env $ do
       let m = "M"
           updExe = buildExe [] [(T.pack m, "M.hs")]
       updateSessionD session updExe 2
       runActionsExe <- runExe session m
       (outExe, statusExe) <- runWaitAll runActionsExe
       assertEqual "Output from runExe"
                   "12345\n"
                   outExe
       assertEqual "after runExe" ExitSuccess statusExe

    -- Update the Haskell module without updating the C module
    updateSessionP session upd2 [
        (1, 1, "Compiling M")
      ]
    assertNoErrors session
    do runActions <- runStmt session "M" "hello"
       (output, result) <- runWaitAll runActions
       assertEqual "" RunOk result
       assertEqual "" "12346\n" output

    ifTestingExe env $ do
       let m = "M"
           updExe = buildExe [] [(T.pack m, "M.hs")]
       updateSessionD session updExe 2
       runActionsExe <- runExe session m
       (outExe, statusExe) <- runWaitAll runActionsExe
       assertEqual "Output from runExe"
                   "12346\n"
                   outExe
       assertEqual "after runExe" ExitSuccess statusExe

    -- Update the C code without updating the Haskell module
    updateSessionP session upd3 [
        (1, 1, "Compiling MC.c")
      , (2, 2, "Compiling M")
      ]
    assertNoErrors session
    do runActions <- runStmt session "M" "hello"
       (output, result) <- runWaitAll runActions
       assertEqual "" RunOk result
       assertEqual "" "54322\n" output

    ifTestingExe env $ do
       let m = "M"
           updExe = buildExe [] [(T.pack m, "M.hs")]
       updateSessionD session updExe 3
       runActionsExe <- runExe session m
       (outExe, statusExe) <- runWaitAll runActionsExe
       assertEqual "Output from runExe"
                   "54322\n"
                   outExe
       assertEqual "after runExe" ExitSuccess statusExe
  where
    upd = (updateCodeGeneration True)
       <> (updateSourceFile "M.hs" . L.unlines $
            [ "module M where"
            , "import Foreign.C"
            , "foreign import ccall \"foo\" c_f :: CInt"
            , "hello :: IO ()"
            , "hello = print c_f"
            , "main :: IO ()"
            , "main = hello"
            ])
       <> (updateSourceFile "MC.c" . L.unlines $
            [ "int foo() {"
            , "  return 12345;"
            , "}"
            ])

    upd2 = (updateSourceFile "M.hs" . L.unlines $
            [ "module M where"
            , "import Foreign.C"
            , "foreign import ccall \"foo\" c_f :: CInt"
            , "hello :: IO ()"
            , "hello = print (c_f + 1)"
            , "main :: IO ()"
            , "main = hello"
            ])

    upd3 = (updateSourceFile "MC.c" . L.unlines $
            [ "int foo() {"
            , "  return 54321;"
            , "}"
            ])

test_subdirs :: TestSuiteEnv -> Assertion
test_subdirs env = withAvailableSession env $ \session -> do
    updateSessionP session upd [
        (1, 2, "Compiling a/MC.c")
      , (2, 2, "Compiling b/MC.c")
      , (3, 3, "Compiling M")
      ]
    assertNoErrors session
    do runActions <- runStmt session "M" "hello"
       (output, result) <- runWaitAll runActions
       assertEqual "" RunOk result
       assertEqual "" "79\n" output

    ifTestingExe env $ do
       let m = "M"
           updExe = buildExe [] [(T.pack m, "M.hs")]
       updateSessionD session updExe 2
       runActionsExe <- runExe session m
       (outExe, statusExe) <- runWaitAll runActionsExe
       assertEqual "Output from runExe"
                   "79\n"
                   outExe
       assertEqual "after runExe" ExitSuccess statusExe
  where
    upd = (updateCodeGeneration True)
       <> (updateSourceFile "M.hs" . L.unlines $
            [ "module M where"
            , "import Foreign.C"
            , "foreign import ccall \"foo\" c_f :: CInt"
            , "foreign import ccall \"bar\" c_g :: CInt"
            , "hello :: IO ()"
            , "hello = print (c_f + c_g)"
            , "main :: IO ()"
            , "main = hello"
            ])
       <> (updateSourceFile "a/MC.c" . L.unlines $
            [ "int foo() {"
            , "  return 56;"
            , "}"
            ])
            -- intentionally same name for the file
       <> (updateSourceFile "b/MC.c" . L.unlines $
            [ "int bar() {"
            , "  return 23;"
            , "}"
            ])

test_errors :: TestSuiteEnv -> Assertion
test_errors env = withAvailableSession env $ \session -> do
    updateSessionP session upd [
        (1, 1, "Compiling MC.c")
      , (2, 2, "Compiling M")
      ]
    errors <- getSourceErrors session
    case errors of
      [e1, e2] -> do
        -- Currently we generate precisely one gcc error
        assertEqual "" (TextSpan (T.pack "<gcc error>")) (errorSpan e1)
        -- The ByteCodeLink exception because of the missing symbol
        assertEqual "" (TextSpan (T.pack "<from GhcException>")) (errorSpan e2)
      _ -> assertFailure $ "Unexpected errors: " ++ show errors
  where
    upd = (updateCodeGeneration True)
       <> (updateSourceFile "M.hs" . L.unlines $
            [ "module M where"
            , "import Foreign.C"
            , "foreign import ccall \"foo\" c_f :: CInt"
            , "hello :: IO ()"
            , "hello = print c_f"
            ])
       <> (updateSourceFile "MC.c" . L.unlines $ [
              "int f() {"
            , "  return thisSymbolDoesNotExist;"
            , "}"
            , ""
            , "void g() {"
            , "  return 1;"
            , "}"
            ])

test_errorsThenUpdate :: TestSuiteEnv -> Assertion
test_errorsThenUpdate env = withAvailableSession env $ \session -> do
    updateSessionD session upd 3
    assertNoErrors session

    runActions <- runStmt session "Main" "main"
    (output, result) <- runWaitAll runActions
    assertEqual "" result RunOk
    assertEqual "" output "42\n"

    updateSessionD session (updateSourceFile "test.c" "invalid") 3
    assertSomeErrors session

    updateSessionD session (updateSourceFile "test.c" cLBS) 3
    assertNoErrors session
  where
    mainLBS = L.unlines $ [
        "import Foreign"
      , "import Foreign.C"
      , "import Foreign.C.Types"
      , "foreign import ccall safe \"test_c_func\" test_c_func :: CInt"
      , "main = print test_c_func"
      ]
    cLBS = L.unlines $ [
        "int test_c_func() { return 42; }"
      ]

    upd = updateCodeGeneration True
       <> updateSourceFile "Main.hs" mainLBS
       <> updateSourceFile "test.c" cLBS

test_headersInSubdirs :: TestSuiteEnv -> Assertion
test_headersInSubdirs env = withAvailableSession' env (withIncludes ["include"]) $ \session -> do
    let go upd = do
            updateSessionD session upd 3
            assertNoErrors session

    go $ updateGhcOpts ["-Iinclude"]
      <> updateSourceFile "include/blankheader.h" hfile
      <> updateSourceFile "hello.c" cfile
      <> updateSourceFile "Main.hs" hsfile
  where
    hfile = "#define foo \"hello\\n\""
    cfile = L.unlines $
        [ "#include <stdio.h>"
        , "#include <blankheader.h>"
        , "void hello(void) { printf(foo); }"
        ]
    hsfile = L.unlines $
        [ "{-# LANGUAGE ForeignFunctionInterface #-}"
        , "module Main where"
        , "foreign import ccall \"hello\" hello :: IO ()"
        , "main = hello"
        ]

test_stdout :: TestSuiteEnv -> Assertion
test_stdout env = withAvailableSession env $ \session -> do
    updateSessionD session upd 3
    assertNoErrors session

    ra <- runStmt session "Main" "main"
    (output, result) <- runWaitAll ra
    assertEqual "" result RunOk
    assertEqual "" output "hello\n"
  where
    cfile = L.unlines $
        [ "#include <stdio.h>"
        , "void hello(void) { printf(\"hello\\n\"); }"
        ]
    hsfile = L.unlines $
        [ "{-# LANGUAGE ForeignFunctionInterface #-}"
        , "module Main where"
        , "import System.IO"
        , "foreign import ccall \"hello\" hello :: IO ()"
        , "main = hello"
        ]

    upd = updateCodeGeneration True
       <> updateSourceFile "hello.c" cfile
       <> updateSourceFile "Main.hs" hsfile

test241 :: TestSuiteEnv -> Assertion
test241 env = withAvailableSession env $ \session -> do
    updateSessionP session (updateCodeGeneration True <> updHs <> updC "a.c") [
        (1, 1, "Compiling a.c")
      , (2, 2, "Compiling M")
      ]
    assertNoErrors session
    do runActions <- runStmt session "M" "hello"
       (output, result) <- runWaitAll runActions
       assertEqual "" RunOk result
       assertEqual "" "12345\n" output

    updateSessionD session (updateSourceFileDelete "a.c") 0

    updateSessionP session (updC "b.c") [
        (1, 1, "Compiling b.c")
      , (2, 2, "Compiling M")
      ]
    assertNoErrors session
    do runActions <- runStmt session "M" "hello"
       (output, result) <- runWaitAll runActions
       assertEqual "" RunOk result
       assertEqual "" "12345\n" output
  where
    updHs = updateSourceFile "M.hs" . L.unlines $ [
               "module M where"
             , "import Foreign.C"
             , "foreign import ccall \"foo\" c_f :: CInt"
             , "hello :: IO ()"
             , "hello = print c_f"
             , "main :: IO ()"
             , "main = hello"
             ]
    updC f = updateSourceFile f . L.unlines $ [
               "int foo() {"
             , "  return 12345;"
             , "}"
             ]

{-------------------------------------------------------------------------------
  Stress tests about the order of object loading
-------------------------------------------------------------------------------}

test_2 :: TestSuiteEnv -> [TestTree]
test_2 = \env ->
    [ stdTest env (describeSchedule s) (testSchedule s)
    | s <- schedule updates
    ]
  where
    updates :: [(String, IdeSessionUpdate)]
    updates = [
        ( "Load a.c", updateSourceFile "a.c"     cfileA)
      , ( "Load b.c", updateSourceFile "b.c"     cfileB)
      , ( "Load .hs", updateSourceFile "Main.hs" hsfile)
      ]

    cfileA, cfileB, hsfile :: L.ByteString
    cfileA = L.unlines $
        [ "#include <stdio.h>"
        , "void defined_in_A() {"
        , "  printf(\"In A\\n\");"
        , "}"
        ]
    cfileB = L.unlines $
        [ "#include <stdio.h>"
        , ""
        , "void defined_in_A();"
        , ""
        , "void defined_in_B() {"
        , "  printf(\"In B\\n\");"
        , "  defined_in_A();"
        , "  printf(\"In B\\n\");"
        , "}"
        ]
    hsfile = L.unlines $
        [ "{-# LANGUAGE ForeignFunctionInterface #-}"
        , "module Main where"
        , "import System.IO"
        , "foreign import ccall \"defined_in_B\" defined_in_B :: IO ()"
        , "main = defined_in_B"
        ]

test_2_cyclic :: TestSuiteEnv -> [TestTree]
test_2_cyclic = \env ->
    [ stdTest env (describeSchedule s) (testSchedule s)
    | s <- schedule updates
    ]
  where
    updates :: [(String, IdeSessionUpdate)]
    updates = [
        ( "Load a.c", updateSourceFile "a.c"     cfileA)
      , ( "Load b.c", updateSourceFile "b.c"     cfileB)
      , ( "Load .hs", updateSourceFile "Main.hs" hsfile)
      ]

    cfileA, cfileB, hsfile :: L.ByteString
    cfileA = L.unlines $
        [ "#include <stdio.h>"
        , ""
        , "void also_defined_in_B();"
        , ""
        , "void defined_in_A() {"
        , "  printf(\"In A\\n\");"
        , "  also_defined_in_B();"
        , "}"
        ]
    cfileB = L.unlines $
        [ "#include <stdio.h>"
        , ""
        , "void defined_in_A();"
        , ""
        , "void defined_in_B() {"
        , "  printf(\"In B\\n\");"
        , "  defined_in_A();"
        , "}"
        , ""
        , "void also_defined_in_B() {"
        , "  printf(\"In B\\n\");"
        , "}"
        ]
    hsfile = L.unlines $
        [ "{-# LANGUAGE ForeignFunctionInterface #-}"
        , "module Main where"
        , "import System.IO"
        , "foreign import ccall \"defined_in_B\" defined_in_B :: IO ()"
        , "main = defined_in_B"
        ]

describeSchedule :: Schedule (String, IdeSessionUpdate) -> String
describeSchedule = intercalate "; "
                 . map (bracket . intercalate ", ")
                 . map (map fst)

testSchedule :: Schedule (String, IdeSessionUpdate) -> TestSuiteEnv -> Assertion
testSchedule s env = withAvailableSession env $ \session -> do
  -- Enable code generation
  updateSessionD session (updateCodeGeneration True) 0

  -- Execute each task in the schedule
  -- (this may have errors until the very last one)
  forM_ s $ \ts -> updateSessionD session (mconcat (map snd ts)) 3

  -- But after the last one there should be no more errors
  assertNoErrors session

  -- Run the code
  ra <- runStmt session "Main" "main"
  (output, result) <- runWaitAll ra
  assertEqual "" result RunOk
  assertEqual "" output "In B\nIn A\nIn B\n"

{-------------------------------------------------------------------------------
  Auxiliary
-------------------------------------------------------------------------------}

bracket :: String -> String
bracket s = "[" ++ s ++ "]"

-- | Execute a bunch of tasks sequentially
type Schedule a = [Task a]

-- | Execute a bunch of operations concurrently (must be non-empty)
type Task a = [a]

schedule :: [a] -> [Schedule a]
schedule []     = [[]]
schedule (a:as) = let ss = schedule as
                  in concat $ map (insertSomewhere [a]) ss
                           ++ map (applySomewhere (a:)) ss

-- | Apply a function to precisely one element in the list
applySomewhere :: (a -> a) -> [a] -> [[a]]
applySomewhere f = expandOne (return . f)

-- | Insert an element somewhere in the list
insertSomewhere :: a -> [a] -> [[a]]
insertSomewhere x xs = (x:xs) : expandOne (: [x]) xs

-- | Apply 'f' to precisely one element
expandOne :: (a -> [a]) -> [a] -> [[a]]
expandOne _ []     = []
expandOne f (x:xs) = (f x ++ xs) : map (x :) (expandOne f xs)