{-# LANGUAGE StandaloneDeriving, LambdaCase #-}
module Main where

import Test.Tasty
import Test.Tasty.HUnit
import System.Exit
import System.Directory
import System.FilePath
import Control.Monad
import Control.Exception
import Control.Concurrent
import Control.Concurrent.MVar
import Network.Socket hiding (KeepAlive, send, recv)
import Network.Socket.ByteString.Lazy as Sock
import qualified Data.ByteString.Lazy.Char8 as BS
import qualified Data.List as List
import Data.Aeson
import Data.Maybe
import System.IO
import System.Directory

import Debug.Trace

import Language.Haskell.Tools.Refactor.Daemon

main :: IO ()
main = do -- create one daemon process for the whole testing session
          -- with separate processes it is not a problem
          forkIO $ runDaemon ["4123", "True"]
          tr <- canonicalizePath testRoot
          defaultMain (allTests tr)
          stopDaemon

allTests :: FilePath -> TestTree
allTests testRoot
  = localOption (mkTimeout ({- 10s -} 1000 * 1000 * 10)) 
      $ testGroup "daemon-tests" 
          [ testGroup "simple-tests" 
              $ map (makeDaemonTest . (\(label, input, output) -> (Nothing, label, input, output))) simpleTests
          , testGroup "loading-tests" 
              $ map (makeDaemonTest . (\(label, input, output) -> (Nothing, label, input, output))) loadingTests
          , testGroup "refactor-tests" 
              $ map (makeDaemonTest . (\(label, dir, input, output) -> (Just (testRoot </> dir), label, input, output))) (refactorTests testRoot)
          , testGroup "reload-tests" 
              $ map makeReloadTest reloadingTests
          , selfLoadingTest
          ]

testSuffix = "_test"

simpleTests :: [(String, [ClientMessage], [ResponseMsg])]
simpleTests = 
  [ ( "empty-test", [], [] )
  , ( "keep-alive", [KeepAlive], [KeepAliveResponse] )
  ]

loadingTests :: [(String, [ClientMessage], [ResponseMsg])]
loadingTests =
  [ ( "load-package"
    , [AddPackages [testRoot </> "has-cabal"]]
    , [LoadedModules [testRoot </> "has-cabal" </> "A.hs"]] )
  , ( "no-cabal"
    , [AddPackages [testRoot </> "no-cabal"]]
    , [LoadedModules [testRoot </> "no-cabal" </> "A.hs"]] )
  , ( "source-dir"
    , [AddPackages [testRoot </> "source-dir"]]
    , [LoadedModules [testRoot </> "source-dir" </> "src" </> "A.hs"]] )
  , ( "source-dir-outside"
    , [AddPackages [testRoot </> "source-dir-outside"]]
    , [LoadedModules [testRoot </> "source-dir-outside" </> ".." </> "src" </> "A.hs"]] )
  , ( "multi-packages"
    , [ AddPackages [ testRoot </> "multi-packages" </> "package1"
                    , testRoot </> "multi-packages" </> "package2" ]]
    , [ LoadedModules [ testRoot </> "multi-packages" </> "package2" </> "B.hs"
                      , testRoot </> "multi-packages" </> "package1" </> "A.hs"]] )
  , ( "multi-packages-flags"
    , [ AddPackages [ testRoot </> "multi-packages-flags" </> "package1"
                    , testRoot </> "multi-packages-flags" </> "package2" ]]
    , [ LoadedModules [ testRoot </> "multi-packages-flags" </> "package2" </> "B.hs"
                      , testRoot </> "multi-packages-flags" </> "package1" </> "A.hs"]] )
  , ( "multi-packages-dependent"
    , [ AddPackages [ testRoot </> "multi-packages-dependent" </> "package1"
                    , testRoot </> "multi-packages-dependent" </> "package2" ]]
    , [ LoadedModules [ testRoot </> "multi-packages-dependent" </> "package1" </> "A.hs"
                      , testRoot </> "multi-packages-dependent" </> "package2" </> "B.hs"]] )
  , ( "has-th"
    , [AddPackages [testRoot </> "has-th"]]
    , [LoadedModules [testRoot </> "has-th" </> "TH.hs", testRoot </> "has-th" </> "A.hs"]] )
  , ( "th-added-later"
    , [ AddPackages [testRoot </> "th-added-later" </> "package1"]
      , AddPackages [testRoot </> "th-added-later" </> "package2"] 
      ]
    , [ LoadedModules [testRoot </> "th-added-later" </> "package1" </> "A.hs"] 
      , LoadedModules [testRoot </> "th-added-later" </> "package2" </> "B.hs"]] )
  ]

sourceRoot = ".." </> ".." </> "src"

selfLoadingTest :: TestTree
selfLoadingTest = localOption (mkTimeout ({- 2 min -} 1000 * 1000 * 60 * 2)) $ testCase "self-load" $ do  
    actual <- communicateWithDaemon 
                [ Right $ AddPackages (map (sourceRoot </>) ["ast" {-, "backend-ghc", "prettyprint", "rewrite", "refactor", "cli", "daemon" -} ] ) ]
    assertBool ("The expected result is a nonempty response message list that does not contain errors. Actual result: " ++ show actual) 
               (not (null actual) && all (\case ErrorMessage {} -> False; _ -> True) actual)


refactorTests :: FilePath -> [(String, FilePath, [ClientMessage], [ResponseMsg])]
refactorTests testRoot =
  [ ( "simple-refactor", "simple-refactor"
    , [ AddPackages [ testRoot </> "simple-refactor" ++ testSuffix ]
      , PerformRefactoring "RenameDefinition" (testRoot </> "simple-refactor" ++ testSuffix </> "A.hs") "3:1-3:2" ["y"]
      ]
    , [ LoadedModules [ testRoot </> "simple-refactor" ++ testSuffix </> "A.hs" ]
      , ModulesChanged [ testRoot </> "simple-refactor" ++ testSuffix </> "A.hs" ] 
      , LoadedModules [ testRoot </> "simple-refactor" ++ testSuffix </> "A.hs" ]
      ] )
  , ( "hs-boots", "hs-boots"
    , [ AddPackages [ testRoot </> "hs-boots" ++ testSuffix ]
      , PerformRefactoring "RenameDefinition" (testRoot </> "hs-boots" ++ testSuffix </> "A.hs") "5:1-5:2" ["aa"]
      ]
    , [ LoadedModules [ testRoot </> "hs-boots" ++ testSuffix </> "B.hs-boot", testRoot </> "hs-boots" ++ testSuffix </> "A.hs-boot"
                      , testRoot </> "hs-boots" ++ testSuffix </> "A.hs", testRoot </> "hs-boots" ++ testSuffix </> "B.hs" ]
      , ModulesChanged [ testRoot </> "hs-boots" ++ testSuffix </> "A.hs", testRoot </> "hs-boots" ++ testSuffix </> "B.hs"
                       , testRoot </> "hs-boots" ++ testSuffix </> "A.hs-boot" ] 
      , LoadedModules [ testRoot </> "hs-boots" ++ testSuffix </> "A.hs-boot" ]
      , LoadedModules [ testRoot </> "hs-boots" ++ testSuffix </> "B.hs-boot" ]
      , LoadedModules [ testRoot </> "hs-boots" ++ testSuffix </> "A.hs" ]
      , LoadedModules [ testRoot </> "hs-boots" ++ testSuffix </> "B.hs" ]
      ] )
  , ( "remove-module", "simple-refactor"
    , [ AddPackages [ testRoot </> "simple-refactor" ++ testSuffix ]
      , PerformRefactoring "RenameDefinition" (testRoot </> "simple-refactor" ++ testSuffix </> "A.hs") "1:8-1:9" ["AA"]
      ]
    , [ LoadedModules [ testRoot </> "simple-refactor" ++ testSuffix </> "A.hs" ]
      , ModulesChanged [ testRoot </> "simple-refactor" ++ testSuffix </> "AA.hs" ] 
      , LoadedModules [ testRoot </> "simple-refactor" ++ testSuffix </> "AA.hs" ]
      ] )
  ]

reloadingTests :: [(String, FilePath, [ClientMessage], IO (), [ClientMessage], [ResponseMsg])]
reloadingTests =
  [ ( "reloading-module", testRoot </> "reloading", [ AddPackages [ testRoot </> "reloading" ++ testSuffix ] ]
    , writeFile (testRoot </> "reloading" ++ testSuffix </> "C.hs") "module C where\nc = ()" 
    , [ ReLoad [testRoot </> "reloading" ++ testSuffix </> "C.hs"] []
      , PerformRefactoring "RenameDefinition" (testRoot </> "reloading" ++ testSuffix </> "C.hs") "2:1-2:2" ["d"] 
      ]
    , [ LoadedModules [ testRoot </> "reloading" ++ testSuffix </> "C.hs"
                      , testRoot </> "reloading" ++ testSuffix </> "B.hs"
                      , testRoot </> "reloading" ++ testSuffix </> "A.hs" ]
      , LoadedModules [ testRoot </> "reloading" ++ testSuffix </> "C.hs" ]
      , LoadedModules [ testRoot </> "reloading" ++ testSuffix </> "B.hs" ]
      , LoadedModules [ testRoot </> "reloading" ++ testSuffix </> "A.hs" ]
      , ModulesChanged [ testRoot </> "reloading" ++ testSuffix </> "C.hs"
                       , testRoot </> "reloading" ++ testSuffix </> "B.hs" ]
      , LoadedModules [ testRoot </> "reloading" ++ testSuffix </> "C.hs" ]
      , LoadedModules [ testRoot </> "reloading" ++ testSuffix </> "B.hs" ]
      , LoadedModules [ testRoot </> "reloading" ++ testSuffix </> "A.hs" ]
      ]
    )
  , ( "reloading-package", testRoot </> "changing-cabal"
    , [ AddPackages [ testRoot </> "changing-cabal" ++ testSuffix ] ]
    , appendFile (testRoot </> "changing-cabal" ++ testSuffix </> "some-test-package.cabal") ", B" 
    , [ AddPackages [testRoot </> "changing-cabal" ++ testSuffix]
      , PerformRefactoring "RenameDefinition" (testRoot </> "changing-cabal" ++ testSuffix </> "A.hs") "3:1-3:2" ["z"] 
      ]
    , [ LoadedModules [ testRoot </> "changing-cabal" ++ testSuffix </> "A.hs" ]
      , LoadedModules [ testRoot </> "changing-cabal" ++ testSuffix </> "A.hs"
                      , testRoot </> "changing-cabal" ++ testSuffix </> "B.hs" ]
      , ModulesChanged [ testRoot </> "changing-cabal" ++ testSuffix </> "A.hs"
                       , testRoot </> "changing-cabal" ++ testSuffix </> "B.hs" ]
      , LoadedModules [ testRoot </> "changing-cabal" ++ testSuffix </> "A.hs" ]
      , LoadedModules [ testRoot </> "changing-cabal" ++ testSuffix </> "B.hs" ]
      ]
    )
  , ( "reloading-remove", testRoot </> "reloading", [ AddPackages [ testRoot </> "reloading" ++ testSuffix ] ]
    , do removeFile (testRoot </> "reloading" ++ testSuffix </> "A.hs")
         removeFile (testRoot </> "reloading" ++ testSuffix </> "B.hs")
    , [ ReLoad [testRoot </> "reloading" ++ testSuffix </> "C.hs"] 
               [testRoot </> "reloading" ++ testSuffix </> "A.hs", testRoot </> "reloading" ++ testSuffix </> "B.hs"]
      , PerformRefactoring "RenameDefinition" (testRoot </> "reloading" ++ testSuffix </> "C.hs") "3:1-3:2" ["d"] 
      ]
    , [ LoadedModules [ testRoot </> "reloading" ++ testSuffix </> "C.hs"
                      , testRoot </> "reloading" ++ testSuffix </> "B.hs"
                      , testRoot </> "reloading" ++ testSuffix </> "A.hs" ]
      , LoadedModules [ testRoot </> "reloading" ++ testSuffix </> "C.hs" ]
      , ModulesChanged [ testRoot </> "reloading" ++ testSuffix </> "C.hs" ]
      , LoadedModules [ testRoot </> "reloading" ++ testSuffix </> "C.hs" ]
      ]
    )
  , ( "remove-package", testRoot </> "multi-packages-dependent"
    , [ AddPackages [ testRoot </> "multi-packages-dependent" ++ testSuffix </> "package1"
                    , testRoot </> "multi-packages-dependent" ++ testSuffix </> "package2" ]]
    , removeDirectoryRecursive (testRoot </> "multi-packages-dependent" ++ testSuffix </> "package2")
    , [ RemovePackages [testRoot </> "multi-packages-dependent" ++ testSuffix </> "package2"] 
      , PerformRefactoring "RenameDefinition" (testRoot </> "multi-packages-dependent" ++ testSuffix </> "package1" </> "A.hs") 
                                              "3:1-3:2" ["d"] 
      ]
    , [ LoadedModules [ testRoot </> "multi-packages-dependent" ++ testSuffix </> "package1" </> "A.hs"
                      , testRoot </> "multi-packages-dependent" ++ testSuffix </> "package2" </> "B.hs" ]
      , ModulesChanged [ testRoot </> "multi-packages-dependent" ++ testSuffix </> "package1" </> "A.hs" ]
      , LoadedModules [ testRoot </> "multi-packages-dependent" ++ testSuffix </> "package1" </> "A.hs" ]
      ]
    )
  ]

makeDaemonTest :: (Maybe FilePath, String, [ClientMessage], [ResponseMsg]) -> TestTree
makeDaemonTest (Nothing, label, input, expected) = testCase label $ do  
    actual <- communicateWithDaemon (map Right input)
    assertEqual "" expected actual
makeDaemonTest (Just dir, label, input, expected) = testCase label $ do 
    exists <- doesDirectoryExist (dir ++ testSuffix)
    -- clear the target directory from possible earlier test runs
    when exists $ removeDirectoryRecursive (dir ++ testSuffix)
    copyDir dir (dir ++ testSuffix)
    actual <- communicateWithDaemon (map Right input)
    assertEqual "" expected actual
  `finally` removeDirectoryRecursive (dir ++ testSuffix)

makeReloadTest :: (String, FilePath, [ClientMessage], IO (), [ClientMessage], [ResponseMsg]) -> TestTree
makeReloadTest (label, dir, input1, io, input2, expected) = testCase label $ do  
    exists <- doesDirectoryExist (dir ++ testSuffix)
    -- clear the target directory from possible earlier test runs
    when exists $ removeDirectoryRecursive (dir ++ testSuffix)
    copyDir dir (dir ++ testSuffix)
    actual <- communicateWithDaemon (map Right input1 ++ [Left io] ++ map Right input2)
    assertEqual "" expected actual
  `finally` removeDirectoryRecursive (dir ++ testSuffix)

communicateWithDaemon :: [Either (IO ()) ClientMessage] -> IO [ResponseMsg]
communicateWithDaemon msgs = withSocketsDo $ do
  addrInfo <- getAddrInfo Nothing (Just "127.0.0.1") (Just "4123")
  let serverAddr = head addrInfo
  sock <- socket (addrFamily serverAddr) Stream defaultProtocol
  connect sock (addrAddress serverAddr)
  intermedRes <- sequence (map (either (\io -> do sendAll sock (encode KeepAlive)
                                                  r <- readSockResponsesUntil sock KeepAliveResponse BS.empty
                                                  io
                                                  return r)
                               ((>> return []) . sendAll sock . (`BS.snoc` '\n') . encode)) msgs)
  sendAll sock $ encode Disconnect
  resps <- readSockResponsesUntil sock Disconnected BS.empty
  close sock
  return (concat intermedRes ++ resps)

readSockResponsesUntil :: Socket -> ResponseMsg -> BS.ByteString -> IO [ResponseMsg]
readSockResponsesUntil sock rsp bs
  = do resp <- recv sock 2048
       let fullBS = bs `BS.append` resp
       if BS.null resp 
         then return []
         else
           let splitted = BS.split '\n' fullBS
               recognized = catMaybes $ map decode splitted
            in if rsp `elem` recognized 
                 then return $ List.delete rsp recognized 
                 else readSockResponsesUntil sock rsp fullBS

stopDaemon :: IO ()
stopDaemon = withSocketsDo $ do
  addrInfo <- getAddrInfo Nothing (Just "127.0.0.1") (Just "4123")
  let serverAddr = head addrInfo
  sock <- socket (addrFamily serverAddr) Stream defaultProtocol
  connect sock (addrAddress serverAddr)

  sendAll sock $ encode Stop
  close sock

testRoot = ".." </> ".." </> "examples" </> "Project"

deriving instance Eq ResponseMsg
instance FromJSON ResponseMsg
instance ToJSON ClientMessage

copyDir ::  FilePath -> FilePath -> IO ()
copyDir src dst = do
  createDirectory dst
  content <- getDirectoryContents src
  let xs = filter (`notElem` [".", ".."]) content
  forM_ xs $ \name -> do
    let srcPath = src </> name
    let dstPath = dst </> name
    isDirectory <- doesDirectoryExist srcPath
    if isDirectory
      then copyDir srcPath dstPath
      else copyFile srcPath dstPath

commonPrefix :: (Eq e) => [e] -> [e] -> [e]
commonPrefix _ [] = []
commonPrefix [] _ = []
commonPrefix (x:xs) (y:ys)
  | x == y    = x : commonPrefix xs ys
  | otherwise = []

longestCommonPrefix :: (Eq a) => [[a]] -> [a]
longestCommonPrefix = foldl1 commonPrefix