content: module TestSuite.Tests.Packages (testGroupPackages) where
  
  import Prelude hiding (span, mod)
  import Data.Maybe
  import Data.Monoid
  import System.Exit
  import System.Process
  import System.FilePath
  import Test.Tasty
  import Test.HUnit
  import qualified Data.ByteString.Lazy.UTF8  as L
  import qualified Data.ByteString.Lazy.Char8 as L (unlines)
  import qualified Data.Text                  as T
  
  import IdeSession
  import TestSuite.State
  import TestSuite.Session
  import TestSuite.Assertions
  
  testGroupPackages :: TestSuiteEnv -> TestTree
  testGroupPackages env = testGroup "Packages" $ [
      stdTest env "Package dependencies"                                                            test_PackageDependencies
    , stdTest env "Register a package, don't restart session, don't see the package"                test_Register_NoRestart
    , stdTest env "Register a package, restart session, see the package and check for cabal macros" test_Register_Restart
    , stdTest env "Make sure package DB is passed to ghc (configGenerateModInfo False)"             test_PackageDB_ModInfoFalse
    , stdTest env "Make sure package DB is passed to ghc (configGenerateModInfo True)"              test_PackageDB_ModInfoTrue
    , stdTest env "Make sure package DB is passed to ghc after restartSession"                      test_PackageDB_AfterRestart
    , stdTest env "Module name visible from 2 packages --- picked from mtl (expected failure)"      test_ModuleIn2Pkgs_2
    , stdTest env "Hiding and unhiding a package (#185-2)"                                          test_HideUnhide
    , stdTest env "Unhiding and hiding a package (#185-3; converse of #185-2)"                      test_UnhideHide
    , stdTest env "Trusting and distrusting packages (#185-4)"                                      test_TrustDistrust
    , stdTest env "Using something from a different package (no \"Loading package\" msg)"           test_UseFromDifferentPackage
    ] ++ docTests env [
      stdTest env "Consistency of multiple modules of the same name"                                test_Consistency
    , withOK  env "Consistency of multiple modules of the same name: PackageImports"                test_Consistency_PackageImports
    , stdTest env "Module name visible from 2 packages --- picked from monads-tf"                   test_ModuleIn2Pkgs_1
    ]
  
  test_PackageDependencies :: TestSuiteEnv -> Assertion
  test_PackageDependencies env = withAvailableSession' env (withGhcOpts ["-hide-package monads-tf"]) $ \session -> do
      updateSessionD session upd 3
      assertNoErrors session
  
      deps <- getPkgDeps session
      assertEqual "" (ignoreVersions "Just [base-4.5.1.0,ghc-prim-0.2.0.0,integer-gmp-0.4.0.0]") (ignoreVersions $ show (deps "A"))
      assertEqual "" (ignoreVersions "Just [parallel-3.2.0.4,base-4.5.1.0,ghc-prim-0.2.0.0,integer-gmp-0.4.0.0]") (ignoreVersions $ show (deps "B"))
      assertEqual "" (ignoreVersions "Just [mtl-2.1.2,base-4.5.1.0,ghc-prim-0.2.0.0,integer-gmp-0.4.0.0,transformers-0.3.0.0]") (ignoreVersions $ show (deps "C"))
    where
      upd = (updateSourceFile "A.hs" . L.unlines $
              [ "module A where"
              ])
         <> (updateSourceFile "B.hs" . L.unlines $
              [ "module B where"
              , "import Control.Parallel"
              ])
         <> (updateSourceFile "C.hs" . L.unlines $
              [ "module C where"
              , "import Control.Monad.Cont" -- from mtl
              ])
  
  test_Register_NoRestart :: TestSuiteEnv -> Assertion
  test_Register_NoRestart env = withAvailableSession env $ \session -> do
      -- Session is started successfully, because we haven't referenced the
      -- package yet.
  
      withInstalledPackage env "TestSuite/inputs/simple-lib17" $ do
        -- Package is now installed, but the session not restarted, so we cannot
        -- reference the new package
        updateSessionD session upd 1
        assertSomeErrors session
    where
      upd = updateGhcOpts ["-package simple-lib17"]
         <> (updateSourceFile "Main.hs" . L.unlines $
              [ "module Main where"
              , "import SimpleLib (simpleLib)"
              , "main = print simpleLib"
              ])
  
  test_Register_Restart :: TestSuiteEnv -> Assertion
  test_Register_Restart env = withAvailableSession env $ \session -> do
      -- Session is started successfully, because we haven't referenced the
      -- package yet.
  
      withInstalledPackage env "TestSuite/inputs/simple-lib17" $ do
        -- After restarting the session the new package should be visible
        restartSession session
        updateSessionD session upd 1
        assertNoErrors session
  
        ifTestingExe env $ do
           let m = "Main"
               upd2 = buildExe [] [(T.pack m, "Main.hs")]
           updateSessionD session upd2 2
           distDir <- getDistDir session
           out <- readProcess (distDir </> "build" </> m </> m) [] []
           assertEqual "DB exe output"
                       "42\n"
                       out
           runActionsExe <- runExe session m
           (outExe, statusExe) <- runWaitAll runActionsExe
           assertEqual "Output from runExe"
                       "42\n"
                       outExe
           assertEqual "after runExe" ExitSuccess statusExe
  
    where
      upd = updateGhcOpts ["-package simple-lib17", "-XCPP"]
         <> (updateSourceFile "Main.hs" . L.unlines $
              [ "module Main where"
              , "import SimpleLib (simpleLib)"
              , "#if MIN_VERSION_simple_lib17(0,1,0)"
              , "main = print simpleLib"
              , "#else"
              , "terrible error"
              , "#endif"
              ])
  
  test_PackageDB_ModInfoFalse :: TestSuiteEnv -> Assertion
  test_PackageDB_ModInfoFalse env = withAvailableSession' env setup $ \session -> do
      -- We expect an error because 'ide-backend-rts' and/or 'parallel'
      -- are not (usually?) installed in the global package DB.
      updateSessionD session upd 1
      assertSourceErrors session [[
          (Nothing, expected1)
        , (Nothing, expected2)
        ]]
    where
      packageOpts = ["-package parallel"]
      setup       = withModInfo True
                  . withDBStack [GlobalPackageDB]
                  . withGhcOpts packageOpts
  
      upd = (updateSourceFile "A.hs" . L.unlines $
              [ "module A where"
              , "import Control.Parallel"
              ])
  
      expected1 = "cannot satisfy -package ide-backend-rts"
      expected2 = "cannot satisfy -package parallel"
  
  test_PackageDB_ModInfoTrue :: TestSuiteEnv -> Assertion
  test_PackageDB_ModInfoTrue env = withAvailableSession' env setup $ \session -> do
       -- We expect an error because 'ide-backend-rts' and/or 'parallel'
       -- are not (usually?) installed in the global package DB.
       updateSessionD session upd 1
       assertSourceErrors session [[
           (Nothing, expected1)
         , (Nothing, expected2)
         ]]
    where
      packageOpts = ["-package parallel"]
      setup       = withModInfo True
                  . withDBStack [GlobalPackageDB]
                  . withGhcOpts packageOpts
  
      upd = (updateSourceFile "A.hs" . L.unlines $
              [ "module A where"
              , "import Control.Parallel"
              ])
  
      expected1 = "cannot satisfy -package ide-backend-rts"
      expected2 = "<command line>: cannot satisfy -package parallel"
  
  test_PackageDB_AfterRestart :: TestSuiteEnv -> Assertion
  test_PackageDB_AfterRestart env = withAvailableSession' env setup $ \session -> do
      restartSession session
      -- We expect an error because 'ide-backend-rts' and/or 'parallel'
      -- are not (usually?) installed in the global package DB.
      updateSessionD session upd 1
      assertSourceErrors session [[
          (Nothing, expected1)
        , (Nothing, expected2)
        ]]
    where
      packageOpts = ["-package parallel"]
      setup       = withModInfo True
                  . withDBStack [GlobalPackageDB]
                  . withGhcOpts packageOpts
  
      upd = (updateSourceFile "A.hs" . L.unlines $
              [ "module A where"
              , "import Control.Parallel"
              ])
  
      expected1 = "cannot satisfy -package ide-backend-rts"
      expected2 = "<command line>: cannot satisfy -package parallel"
  
  {-
  18:45 < mikolaj> from http://www.haskell.org/ghc/docs/7.4.2/html/users_guide/packages.html#package-overlaps
  18:45 < mikolaj> It is possible that by using packages you might end up with a program that contains two modules with the same name: perhaps you used a package P that has a hidden module M, and there is also a module M in your program.
                   Or perhaps the dependencies of packages that you used contain some overlapping modules. Perhaps the program even contains multiple versions of a certain package, due to dependencies from other packages.
  18:45 < mikolaj> None of these scenarios gives rise to an error on its own[8], but they may have some interesting consequences. For instance, if you have a type M.T from version 1 of package P, then this is not the same as the type M.T
                   from version 2 of package P, and GHC will report an error if you try to use one where the other is expected.
  18:46 < mikolaj> so it seems it's unspecified which module will be used --- it just happens that our idInfo code picks a different package than GHC API in this case
  -}
  test_Consistency :: TestSuiteEnv -> Assertion
  test_Consistency env = withAvailableSession env $ \sess -> do
      let cb     = \_ -> return ()
          update = flip (updateSession sess) cb
          updMod = \mod code -> updateSourceFile mod (L.fromString code)
  
      update $ updMod "Control/Parallel.hs" $ unlines [
          "module Control.Parallel where"
        , ""
        , "import Bar"
        , ""
        , "foo = bar >> bar"
        , ""
        , "foobar = putStrLn \"Baz\""
        ]
  
      update $ updMod "Bar.hs" $ unlines [
          "module Bar where"
        , ""
        , "bar = putStrLn \"Hello, world!\""
        ]
  
      update $ updMod "Baz.hs" $ unlines [
          "module Baz where"
        , ""
        , "import Control.Parallel"
        , "import Bar"
        , ""
        , "baz = foobar"
        ]
  
      assertNoErrors sess
      assertIdInfo sess "Bar" (3, 7, 3, 15) "putStrLn" VarName "String -> IO ()" "base-4.5.1.0:System.IO" "<no location info>" "base-4.5.1.0:System.IO" "imported from base-4.5.1.0:Prelude at Bar.hs@1:8-1:11"
  -- w fail:            assertIdInfo gif "Baz" (6, 8, 6, 9) "foobar" VarName "IO ()" "main:Control.Parallel" "Control/Parallel.hs@7:1-7:7" "" "imported from main:Control.Parallel at Baz.hs@3:1-3:24"
  
      update $ updMod "Baz.hs" $ unlines [
          "module Baz where"
        , ""
        , "import Control.Parallel"
        , "import Bar"
        , ""
        , "baz = foobar >>>> foo >> bar"
        ]
      assertOneError sess
      _ <- getSpanInfo sess -- TODO: Is this call useful?
      assertIdInfo sess "Bar" (3, 7, 3, 15) "putStrLn" VarName "String -> IO ()" "base-4.5.1.0:System.IO" "<no location info>" "base-4.5.1.0:System.IO" "imported from base-4.5.1.0:Prelude at Bar.hs@1:8-1:11"
      -- Baz is broken at this point
  
      update $ updMod "Baz.hs" $ unlines [
          "module Baz where"
        , ""
        , "import Control.Parallel"
        , "import Bar"
        , ""
        , "baz = foobar >> foo >> bar"
        ]
  
      assertNoErrors sess
      assertIdInfo sess "Bar" (3, 7, 3, 15) "putStrLn" VarName "String -> IO ()" "base-4.5.1.0:System.IO" "<no location info>" "base-4.5.1.0:System.IO" "imported from base-4.5.1.0:Prelude at Bar.hs@1:8-1:11"
  -- would fail:           assertIdInfo gif "Baz" (6, 8, 6, 9) "foobar" VarName "IO ()" "main:Control.Parallel" "Control/Parallel.hs@7:1-7:7" "" "imported from main:Control/Parallel at Baz.hs@3:1-3:24"
  
  test_Consistency_PackageImports :: TestSuiteEnv -> IO String
  test_Consistency_PackageImports env = withAvailableSession env $ \sess -> do
      let cb     = \_ -> return ()
          update = flip (updateSession sess) cb
          updMod = \mod code -> updateSourceFile mod (L.fromString code)
  
      update $ updMod "Control/Parallel.hs" $ unlines [
          "module Control.Parallel where"
        , ""
        , "import Bar"
        , ""
        , "foo = bar >> bar"
        , ""
        , "par = putStrLn \"Baz\""
        ]
  
      update $ updMod "Bar.hs" $ unlines [
          "module Bar where"
        , ""
        , "bar = putStrLn \"Hello, world!\""
        ]
  
      update $ updMod "Baz.hs" $ unlines [
          "{-# LANGUAGE PackageImports #-}"
        , "module Baz where"
        , ""
        , "import \"parallel\" Control.Parallel"
        , "import Bar"
        , ""
        , "baz = par"
        ]
  
      assertNoErrors sess
      assertIdInfo sess "Bar" (3, 7, 3, 15) "putStrLn" VarName "String -> IO ()" "base-4.5.1.0:System.IO" "<no location info>" "base-4.5.1.0:System.IO" "imported from base-4.5.1.0:Prelude at Bar.hs@1:8-1:11"
      fixme sess "#254" $ assertIdInfo sess "Baz" (7, 7, 7, 10) "par" VarName "a1 -> b1 -> b1" "parallel-X.Y.Z:Control.Parallel" "<no location info>" "parallel-X.Y.Z:Control.Parallel" "imported from parallel-X.Y.Z:Control.Parallel at Baz.hs@4:1-4:35"
  
  test_ModuleIn2Pkgs_1 :: TestSuiteEnv -> Assertion
  test_ModuleIn2Pkgs_1 env = withAvailableSession' env (withGhcOpts packageOpts) $ \session -> do
      updateSessionD session upd 1
      assertNoErrors session
  
      imports <- getImports session
      let base mod = ModuleId {
              moduleName    = T.pack mod
            , modulePackage = PackageId {
                  packageName    = "base"
                , packageVersion = Just "X.Y.Z"
                , packageKey     = "base" -- ignoreVersions sets key == name
                }
            }
          monads_tf mod = ModuleId {
              moduleName    = T.pack mod
            , modulePackage = PackageId {
                  packageName    = "monads-tf"
                , packageVersion = Just "X.Y.Z"
                , packageKey     = "monads-tf"
                }
            }
      assertSameSet "imports: " (ignoreVersions . fromJust . imports $ "A") $ [
          Import {
              importModule    = base "Prelude"
            , importPackage   = Nothing
            , importQualified = False
            , importImplicit  = True
            , importAs        = Nothing
            , importEntities  = ImportAll
            }
        , Import {
              importModule    = monads_tf "Control.Monad.Cont"
            , importPackage   = Just "monads-tf"
            , importQualified = False
            , importImplicit  = False
            , importAs        = Nothing
            , importEntities  = ImportAll
            }
        ]
  
      -- FIXME: We expect the scope "imported from monads-tf-X.Y.Z:Control.Monad.Cont at A.hs@3:1-3:38"
      -- but we cannot guarantee it (#95)
      -- assertIdInfo' session "A" (4,5,4,12) (4,5,4,12) "runCont" VarName (allVersions "Cont r1 a1 -> (a1 -> r1) -> r1") (allVersions "transformers-X.Y.Z:Control.Monad.Trans.Cont") (allVersions "<no location info>") (allVersions "monads-tf-X.Y.Z:Control.Monad.Cont") []
    where
      packageOpts = [ "-hide-all-packages"
                    , "-package base"
                    , "-package monads-tf"
                    , "-package mtl"
                    ]
  
      upd = (updateSourceFile "A.hs" . L.unlines $
              [ "{-# LANGUAGE PackageImports #-}"
              , "module A where"
              , "import \"monads-tf\" Control.Monad.Cont"
              , "f = runCont"
              ])
  
  test_ModuleIn2Pkgs_2 :: TestSuiteEnv -> Assertion
  test_ModuleIn2Pkgs_2 env = withAvailableSession' env (withGhcOpts packageOpts) $ \session -> do
      updateSessionD session upd 1
      assertNoErrors session
  
      imports <- getImports session
      let base mod = ModuleId {
              moduleName    = T.pack mod
            , modulePackage = PackageId {
                  packageName    = "base"
                , packageVersion = Just "X.Y.Z"
                , packageKey     = "base" -- ignoreVersions sets key == name
                }
            }
          mtl mod = ModuleId {
              moduleName    = T.pack mod
            , modulePackage = PackageId {
                  packageName    = "mtl"
                , packageVersion = Just "X.Y.Z"
                , packageKey     = "mtl"
                }
            }
      assertSameSet "imports: " (ignoreVersions . fromJust . imports $ "A") $ [
          Import {
              importModule    = base "Prelude"
            , importPackage   = Nothing
            , importQualified = False
            , importImplicit  = True
            , importAs        = Nothing
            , importEntities  = ImportAll
            }
        , Import {
              importModule    = mtl "Control.Monad.Cont"
            , importPackage   = Just "mtl"
            , importQualified = False
            , importImplicit  = False
            , importAs        = Nothing
            , importEntities  = ImportAll
            }
        ]
  
      -- FIXME: We expect the scope "imported from mtl-X.Y.Z:Control.Monad.Cont at A.hs@3:1-3:38"
      -- but we cannot guarantee it (#95)
      -- assertIdInfo' session "A" (4,5,4,12) (4,5,4,12) "runCont" VarName (allVersions "Cont r1 a1 -> (a1 -> r1) -> r1") (allVersions "transformers-X.Y.Z:Control.Monad.Trans.Cont") (allVersions "<no location info>") (allVersions "mtl-X.Y.Z:Control.Monad.Cont") []
    where
      packageOpts = [ "-hide-all-packages"
                    , "-package base"
                    , "-package monads-tf"
                    , "-package mtl"
                    ]
  
      upd = (updateSourceFile "A.hs" . L.unlines $
              [ "{-# LANGUAGE PackageImports #-}"
              , "module A where"
              , "import \"mtl\" Control.Monad.Cont"
              , "f = runCont"
              ])
  
  -- We want to test that:
  --
  -- 1. The package flags work at all
  -- 2. Transitions
  -- 3. Statelessness of updateGhcOpts
  test_HideUnhide :: TestSuiteEnv -> Assertion
  test_HideUnhide env = withAvailableSession env $ \session -> do
      let runCode = do
            runActions <- runStmt session "A" "test"
            (output, result) <- runWaitAll runActions
            assertEqual "" RunOk result
            assertEqual "" "9\n" output
  
      -- First, check that we can import stuff from the unix package
      do let upd = (updateSourceFile "A.hs" $ L.unlines [
                       "module A (test) where"
                     , "import System.Posix"
                     , "test :: IO ()"
                     , "test = print sigKILL"
                     ])
                <> (updateCodeGeneration True)
         updateSessionD session upd 1
         assertNoErrors session
         runCode
  
      -- Hide the package
      do let upd = updateGhcOpts ["-hide-package unix"]
         updateSessionD session upd 1
         assertOneError session
  
      -- Reveal the package again with an explicit flag
      do let upd = updateGhcOpts ["-package unix"]
         updateSessionD session upd 1
         assertNoErrors session
         runCode
  
      -- Hide once more
      do let upd = updateGhcOpts ["-hide-package unix"]
         updateSessionD session upd 1
         assertOneError session
  
      -- Reveal it again by using the default package flags
      -- (statelessness of updateGhcOpts)
      do let upd = updateGhcOpts []
         updateSessionD session upd 1
         assertNoErrors session
         runCode
  
  test_UnhideHide :: TestSuiteEnv -> Assertion
  test_UnhideHide env = withAvailableSession env $ \session -> do
      let runCode = do
            runActions <- runStmt session "A" "test"
            (output, result) <- runWaitAll runActions
            assertEqual "" RunOk result
            case testSuiteEnvGhcVersion env of
              GHC_7_4  -> assertEqual "" "7.4.\n" output
              GHC_7_8  -> assertEqual "" "7.8.\n" output
              GHC_7_10 -> assertEqual "" "7.10\n" output
  
      -- First, check that we cannot import from the ghc package
      do let upd = (updateSourceFile "A.hs" $ L.unlines [
                       "module A (test) where"
                     , "import Config"
                     , "test :: IO ()"
                     , "test = putStrLn (take 4 cProjectVersion)"
                     ])
                <> (updateCodeGeneration True)
         updateSessionD session upd 1
         assertOneError session
  
      -- Reveal the package with an explicit flag
      do let upd = updateGhcOpts ["-package ghc"]
         updateSessionD session upd 1
         assertNoErrors session
         runCode
  
      -- Hide the package
      do let upd = updateGhcOpts ["-hide-package ghc"]
         updateSessionD session upd 1
         assertOneError session
  
      -- Reveal once more
      do let upd = updateGhcOpts ["-package ghc"]
         updateSessionD session upd 1
         assertNoErrors session
         runCode
  
      -- Hide it again by using the default package flags
      -- (statelessness of updateGhcOpts)
      do let upd = updateGhcOpts []
         updateSessionD session upd 1
         assertOneError session
  
  test_TrustDistrust :: TestSuiteEnv -> Assertion
  test_TrustDistrust env = withAvailableSession env $ \session -> do
      let runCode = do
            runActions <- runStmt session "A" "test"
            (output, result) <- runWaitAll runActions
            assertEqual "" RunOk result
            assertEqual "" "Hello\n" output
  
      -- First, check that base is untrusted
      do let upd = (updateGhcOpts ["-XSafe", "-fpackage-trust"])
                <> (updateSourceFile "A.hs" $ L.unlines [
                       "module A (test) where"
                     , "test :: IO ()"
                     , "test = putStrLn \"Hello\""
                     ])
                <> (updateCodeGeneration True)
         updateSessionD session upd 1
         assertOneError session
  
      -- Trust base
      do let upd = updateGhcOpts ["-XSafe", "-fpackage-trust", "-trust base"]
         updateSessionD session upd 1
         assertNoErrors session
         runCode
  
      -- Untrust it
      do let upd = updateGhcOpts ["-XSafe", "-fpackage-trust", "-distrust base"]
         updateSessionD session upd 1
         assertOneError session
  
      -- Trust it once more
      do let upd = updateGhcOpts ["-XSafe", "-fpackage-trust", "-trust base"]
         updateSessionD session upd 1
         assertNoErrors session
         runCode
  
      -- Untrust it again by using the default package flags
      -- (statelessness of updateGhcOpts)
      do let upd = updateGhcOpts ["-XSafe", "-fpackage-trust"]
         updateSessionD session upd 1
         assertOneError session
  
  -- We pick something from the haskell platform but that doesn't come with ghc itself
  -- https://github.com/haskell/haskell-platform/blob/2012.4.0.0/haskell-platform.cabal
  test_UseFromDifferentPackage :: TestSuiteEnv -> Assertion
  test_UseFromDifferentPackage env = withAvailableSession env $ \session -> do
      updateSessionD session upd 1
      assertNoErrors session
      runActions <- runStmt session "M" "hello"
      (output, result) <- runWaitAll runActions
      assertEqual "" RunOk result
      assertEqual "" "5\n" output
    where
      upd = (updateCodeGeneration True)
         <> (updateSourceFile "M.hs" . L.unlines $
              [ "module M where"
              , "import Control.Monad.IO.Class" -- From transformers
              , "hello :: IO ()"
              , "hello = liftIO $ print 5"
              ])
  