{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}

module Stack.PackageDumpSpec
  ( main
  , spec
  , bestPrune
  , checkDepsPresent
  , runEnvNoLogging
  ) where

import           Conduit ( withSourceFile, yield )
import qualified Data.Conduit.List as CL
import           Data.Conduit.Text ( decodeUtf8 )
import qualified Data.Map as Map
import qualified Data.Set as Set
import           Distribution.License ( License (..) )
import           Distribution.Types.PackageName ( mkPackageName )
import           Distribution.Version ( mkVersion )
import           Path ( parseAbsFile )
import           RIO.PrettyPrint.Simple ( SimplePrettyApp, mkSimplePrettyApp )
import           RIO.Process
                   ( envVarsL, findExecutable, mkDefaultProcessContext
                   , mkProcessContext
                   )
import           Stack.PackageDump
                   ( DumpPackage (..), conduitDumpPackage, eachPair
                   , eachSection, ghcPkgDump, pruneDeps, sinkMatching
                   )
import           Stack.Prelude
import           Stack.Types.CompilerPaths ( GhcPkgExe (..) )
import           Stack.Types.GhcPkgId ( parseGhcPkgId )
import           Test.Hspec
                   ( Spec, describe, hspec, it, shouldBe )
import           Test.Hspec.QuickCheck ( prop )

main :: IO ()
main = hspec spec

spec :: Spec
spec = do
    describe "eachSection" $ do
        let test name content expected = it name $ do
                actual <- runConduit $ yield content .| eachSection CL.consume .| CL.consume
                actual `shouldBe` expected
        test
            "unix line endings"
            "foo\nbar\n---\nbaz---\nbin\n---\n"
            [ ["foo", "bar"]
            , ["baz---", "bin"]
            ]
        test
            "windows line endings"
            "foo\r\nbar\r\n---\r\nbaz---\r\nbin\r\n---\r\n"
            [ ["foo", "bar"]
            , ["baz---", "bin"]
            ]

    it "eachPair" $ do
        let bss =
                [ "key1: val1"
                , "key2: val2a"
                , "      val2b"
                , "key3:"
                , "key4:"
                , "   val4a"
                , "   val4b"
                ]
            sink k = fmap (k, ) CL.consume
        actual <- runConduit $ mapM_ yield bss .| eachPair sink .| CL.consume
        actual `shouldBe`
            [ ("key1", ["val1"])
            , ("key2", ["val2a", "val2b"])
            , ("key3", [])
            , ("key4", ["val4a", "val4b"])
            ]

    describe "conduitDumpPackage" $ do
        it "ghc 7.8" $ do
            haskell2010:_ <-
                  withSourceFile "tests/unit/package-dump/ghc-7.8.txt" $ \src ->
                  runConduit
                $ src
               .| decodeUtf8
               .| conduitDumpPackage
               .| CL.consume
            ghcPkgId <- parseGhcPkgId "haskell2010-1.1.2.0-05c8dd51009e08c6371c82972d40f55a"
            packageIdent <- maybe (fail "Not parsable package id") pure $
              parsePackageIdentifier "haskell2010-1.1.2.0"
            depends <- mapM parseGhcPkgId
                [ "array-0.5.0.0-470385a50d2b78598af85cfe9d988e1b"
                , "base-4.7.0.2-bfd89587617e381ae01b8dd7b6c7f1c1"
                , "ghc-prim-0.3.1.0-a24f9c14c632d75b683d0f93283aea37"
                ]
            haskell2010 { exposedModules = mempty } `shouldBe` DumpPackage
                { ghcPkgId = ghcPkgId
                , packageIdent = packageIdent
                , sublib = Nothing
                , license = Just BSD3
                , libDirs = ["/opt/ghc/7.8.4/lib/ghc-7.8.4/haskell2010-1.1.2.0"]
                , depends = depends
                , libraries = ["HShaskell2010-1.1.2.0"]
                , hasExposedModules = True
                , haddockInterfaces = ["/opt/ghc/7.8.4/share/doc/ghc/html/libraries/haskell2010-1.1.2.0/haskell2010.haddock"]
                , haddockHtml = Just "/opt/ghc/7.8.4/share/doc/ghc/html/libraries/haskell2010-1.1.2.0"
                , isExposed = False
                , exposedModules = mempty
                }

        it "ghc 7.10" $ do
            haskell2010:_ <-
                  withSourceFile "tests/unit/package-dump/ghc-7.10.txt" $ \src ->
                  runConduit
                $ src
               .| decodeUtf8
               .| conduitDumpPackage
               .| CL.consume
            ghcPkgId <- parseGhcPkgId "ghc-7.10.1-325809317787a897b7a97d646ceaa3a3"
            pkgIdent <- maybe (fail "Not parsable package id") pure $
              parsePackageIdentifier "ghc-7.10.1"
            depends <- mapM parseGhcPkgId
                [ "array-0.5.1.0-e29cdbe82692341ebb7ce6e2798294f9"
                , "base-4.8.0.0-1b689eb8d72c4d4cc88f445839c1f01a"
                , "bin-package-db-0.0.0.0-708fc7d634a370b311371a5bcde40b62"
                , "bytestring-0.10.6.0-0909f8f31271f3d75749190bf2ee35db"
                , "containers-0.5.6.2-2114032c163425cc264e6e1169dc2f6d"
                , "directory-1.2.2.0-b4959b472d9eee380c6b32291ade29e0"
                , "filepath-1.4.0.0-40d643aa87258c186441a1f8f3e13ca6"
                , "hoopl-3.10.0.2-8c8dfc4c3140e5f7c982da224c3cb1f0"
                , "hpc-0.6.0.2-ac9064885aa8cb08a93314222939ead4"
                , "process-1.2.3.0-3b1e9bca6ac38225806ff7bbf3f845b1"
                , "template-haskell-2.10.0.0-e895139a0ffff267d412e3d0191ce93b"
                , "time-1.5.0.1-e17a9220d438435579d2914e90774246"
                , "transformers-0.4.2.0-c1a7bb855a176fe475d7b665301cd48f"
                , "unix-2.7.1.0-e5915eb989e568b732bc7286b0d0817f"
                ]
            haskell2010 { exposedModules = mempty } `shouldBe` DumpPackage
                { ghcPkgId = ghcPkgId
                , packageIdent = pkgIdent
                , sublib = Nothing
                , license = Just BSD3
                , libDirs = ["/opt/ghc/7.10.1/lib/ghc-7.10.1/ghc_EMlWrQ42XY0BNVbSrKixqY"]
                , haddockInterfaces = ["/opt/ghc/7.10.1/share/doc/ghc/html/libraries/ghc-7.10.1/ghc.haddock"]
                , haddockHtml = Just "/opt/ghc/7.10.1/share/doc/ghc/html/libraries/ghc-7.10.1"
                , depends = depends
                , libraries = ["HSghc-7.10.1-EMlWrQ42XY0BNVbSrKixqY"]
                , hasExposedModules = True
                , isExposed = False
                , exposedModules = mempty
                }
        it "ghc 7.8.4 (osx)" $ do
            hmatrix:_ <-
                  withSourceFile "tests/unit/package-dump/ghc-7.8.4-osx.txt" $ \src ->
                  runConduit
                $ src
               .| decodeUtf8
               .| conduitDumpPackage
               .| CL.consume
            ghcPkgId <- parseGhcPkgId "hmatrix-0.16.1.5-12d5d21f26aa98774cdd8edbc343fbfe"
            pkgId <- maybe (fail "Not parsable package id") pure $
              parsePackageIdentifier "hmatrix-0.16.1.5"
            depends <- mapM parseGhcPkgId
                [ "array-0.5.0.0-470385a50d2b78598af85cfe9d988e1b"
                , "base-4.7.0.2-918c7ac27f65a87103264a9f51652d63"
                , "binary-0.7.1.0-108d06eea2ef05e517f9c1facf10f63c"
                , "bytestring-0.10.4.0-78bc8f2c724c765c78c004a84acf6cc3"
                , "deepseq-1.3.0.2-0ddc77716bd2515426e1ba39f6788a4f"
                , "random-1.1-822c19b7507b6ac1aaa4c66731e775ae"
                , "split-0.2.2-34cfb851cc3784e22bfae7a7bddda9c5"
                , "storable-complex-0.2.2-e962c368d58acc1f5b41d41edc93da72"
                , "vector-0.10.12.3-f4222db607fd5fdd7545d3e82419b307"]
            hmatrix `shouldBe` DumpPackage
                { ghcPkgId = ghcPkgId
                , packageIdent = pkgId
                , sublib = Nothing
                , license = Just BSD3
                , libDirs =
                      [ "/Users/alexbiehl/.stack/snapshots/x86_64-osx/lts-2.13/7.8.4/lib/x86_64-osx-ghc-7.8.4/hmatrix-0.16.1.5"
                      , "/opt/local/lib/"
                      , "/usr/local/lib/"
                      ,  "C:/Program Files/Example/"]
                , haddockInterfaces = ["/Users/alexbiehl/.stack/snapshots/x86_64-osx/lts-2.13/7.8.4/doc/html/hmatrix.haddock"]
                , haddockHtml = Just "/Users/alexbiehl/.stack/snapshots/x86_64-osx/lts-2.13/7.8.4/doc/html"
                , depends = depends
                , libraries = ["HShmatrix-0.16.1.5"]
                , hasExposedModules = True
                , isExposed = True
                , exposedModules = Set.fromList ["Data.Packed","Data.Packed.Vector","Data.Packed.Matrix","Data.Packed.Foreign","Data.Packed.ST","Data.Packed.Development","Numeric.LinearAlgebra","Numeric.LinearAlgebra.LAPACK","Numeric.LinearAlgebra.Algorithms","Numeric.Container","Numeric.LinearAlgebra.Util","Numeric.LinearAlgebra.Devel","Numeric.LinearAlgebra.Data","Numeric.LinearAlgebra.HMatrix","Numeric.LinearAlgebra.Static"]
                }
        it "ghc HEAD" $ do
          ghcBoot:_ <-
                withSourceFile "tests/unit/package-dump/ghc-head.txt" $ \src ->
                runConduit
              $ src
             .| decodeUtf8
             .| conduitDumpPackage
             .| CL.consume
          ghcPkgId <- parseGhcPkgId "ghc-boot-0.0.0.0"
          pkgId <- maybe (fail "Not parsable package id") pure $
            parsePackageIdentifier "ghc-boot-0.0.0.0"
          depends <- mapM parseGhcPkgId
            [ "base-4.9.0.0"
            , "binary-0.7.5.0"
            , "bytestring-0.10.7.0"
            , "directory-1.2.5.0"
            , "filepath-1.4.1.0"
            ]
          ghcBoot `shouldBe` DumpPackage
            { ghcPkgId = ghcPkgId
            , packageIdent = pkgId
            , sublib = Nothing
            , license = Just BSD3
            , libDirs =
                  ["/opt/ghc/head/lib/ghc-7.11.20151213/ghc-boot-0.0.0.0"]
            , haddockInterfaces = ["/opt/ghc/head/share/doc/ghc/html/libraries/ghc-boot-0.0.0.0/ghc-boot.haddock"]
            , haddockHtml = Just "/opt/ghc/head/share/doc/ghc/html/libraries/ghc-boot-0.0.0.0"
            , depends = depends
            , libraries = ["HSghc-boot-0.0.0.0"]
            , hasExposedModules = True
            , isExposed = True
            , exposedModules = Set.fromList ["GHC.Lexeme", "GHC.PackageDb"]
            }


    it "sinkMatching" $ runEnvNoLogging $ \pkgexe -> do
        m <- ghcPkgDump pkgexe []
            $  conduitDumpPackage
            .| sinkMatching (Map.singleton (mkPackageName "transformers") (mkVersion [0, 0, 0, 0, 0, 0, 1]))
        case Map.lookup (mkPackageName "base") m of
            Nothing -> error "base not present"
            Just _ -> pure ()
        liftIO $ do
          Map.lookup (mkPackageName "transformers") m `shouldBe` Nothing
          Map.lookup (mkPackageName "ghc") m `shouldBe` Nothing

    describe "pruneDeps" $ do
        it "sanity check" $ do
            let prunes =
                    [ ((1, 'a'), [])
                    , ((1, 'b'), [])
                    , ((2, 'a'), [(1, 'b')])
                    , ((2, 'b'), [(1, 'a')])
                    , ((3, 'a'), [(1, 'c')])
                    , ((4, 'a'), [(2, 'a')])
                    ]
                actual = fst <$> pruneDeps fst fst snd bestPrune prunes
            actual `shouldBe` Map.fromList
                [ (1, (1, 'b'))
                , (2, (2, 'a'))
                , (4, (4, 'a'))
                ]

        prop "invariant holds" $ \prunes' ->
            -- Force uniqueness
            let prunes = Map.toList $ Map.fromList prunes'
            in  checkDepsPresent prunes $ fst <$> pruneDeps fst fst snd bestPrune prunes

type PruneCheck = ((Int, Char), [(Int, Char)])

bestPrune :: PruneCheck -> PruneCheck -> PruneCheck
bestPrune x y
    | fst x > fst y = x
    | otherwise = y

checkDepsPresent :: [PruneCheck] -> Map Int (Int, Char) -> Bool
checkDepsPresent prunes selected =
    all hasDeps $ Set.toList allIds
  where
    depMap = Map.fromList prunes
    allIds = Set.fromList $ Map.elems selected

    hasDeps ident =
        case Map.lookup ident depMap of
            Nothing -> error "checkDepsPresent: missing in depMap"
            Just deps -> Set.null $ Set.difference (Set.fromList deps) allIds

runEnvNoLogging :: (GhcPkgExe -> RIO SimplePrettyApp a) -> IO a
runEnvNoLogging inner = do
  envVars <- view envVarsL <$> mkDefaultProcessContext
  menv <- mkProcessContext $ Map.delete "GHC_PACKAGE_PATH" envVars
  let find name = runRIO menv (findExecutable name) >>= either throwIO parseAbsFile
  pkg <- GhcPkgExe <$> find "ghc-pkg"
  app <- mkSimplePrettyApp mempty (Just menv) True 80 mempty
  runRIO app (inner pkg)
