TarballSpec.hs

module Unit.Tricorder.SourceLookup.TarballSpec (test_Tarball) where

import System.FilePath (isAbsolute, (</>))
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (testCase, (@?=))

import Codec.Archive.Tar qualified as Tar
import Codec.Archive.Tar.Entry qualified as Tar
import Codec.Compression.GZip qualified as GZip
import Data.ByteString.Lazy qualified as BSL

import Tricorder.SourceLookup.PackageId (splitPackageId)
import Tricorder.SourceLookup.Tarball
    ( cabalPackagesDirs
    , extractModule
    , matchesModule
    , tarballPath
    )


test_Tarball :: TestTree
test_Tarball =
    testGroup
        "Tarball"
        [ testGroup
            "splitPackageId"
            [ testCase "splits a simple package id" do
                splitPackageId "aeson-2.2.5.0" @?= ("aeson", "2.2.5.0")
            , testCase "keeps hyphens inside the package name" do
                splitPackageId "list-t-1.0.5.7" @?= ("list-t", "1.0.5.7")
            ]
        , testGroup
            "tarballPath"
            [ testCase "derives the cache path for a package id" do
                tarballPath "/c" "hackage.haskell.org" "aeson-2.2.5.0"
                    @?= "/c" </> "hackage.haskell.org/aeson/2.2.5.0/aeson-2.2.5.0.tar.gz"
            ]
        , testGroup
            "cabalPackagesDirs"
            [ testCase "honors CABAL_DIR" do
                cabalPackagesDirs [("CABAL_DIR", "/cd")] @?= ["/cd/packages"]
            , testCase "includes the legacy ~/.cabal location alongside the XDG one" do
                cabalPackagesDirs [("HOME", "/h")]
                    @?= ["/h/.cache/cabal/packages", "/h/.cabal/packages"]
            , testCase "yields no candidates (never a relative path) when HOME is unset" do
                cabalPackagesDirs [] @?= []
            , testCase "only ever produces absolute candidates" do
                all isAbsolute (cabalPackagesDirs [("HOME", "/h"), ("XDG_CACHE_HOME", "/x")])
                    @?= True
            ]
        , testGroup
            "matchesModule"
            [ testCase "matches a src/ layout entry" do
                matchesModule "Data.Aeson" "aeson-2.2.5.0/src/Data/Aeson.hs" @?= True
            , testCase "matches a lib/ layout entry" do
                matchesModule "Data.Aeson" "aeson-2.2.5.0/lib/Data/Aeson.hs" @?= True
            , testCase "matches a flat layout entry" do
                matchesModule "Data.Aeson" "aeson-2.2.5.0/Data/Aeson.hs" @?= True
            , testCase "does not match a different module under the same prefix" do
                matchesModule "Data.Aeson" "aeson-2.2.5.0/src/Data/Aeson/Types.hs" @?= False
            , testCase "does not match a deeper module whose final component coincides" do
                -- Module `Lens` must not resolve to the file for `Control.Lens`.
                matchesModule "Lens" "pkg-1.0/Control/Lens.hs" @?= False
            , testCase "matches a preprocessed .hsc entry" do
                matchesModule "System.Posix.Files" "unix-2.8.5.0/System/Posix/Files.hsc" @?= True
            , testCase "matches a literate .lhs entry" do
                matchesModule "Data.Ratio" "base-4.19.0.0/src/Data/Ratio.lhs" @?= True
            ]
        , testGroup
            "extractModule"
            [ testCase "extracts a member by module name" do
                extractModule "Data.Aeson" fixtureTarball @?= Just "module Data.Aeson where\n"
            , testCase "returns Nothing when the module is absent" do
                extractModule "Data.Missing" fixtureTarball @?= Nothing
            , testCase "prefers a library source path over a same-named test path" do
                extractModule "Data.Aeson" dupModuleTarball
                    @?= Just "module Data.Aeson (lib) where\n"
            ]
        ]


-- | A gzipped tar with a single source member.
fixtureTarball :: LByteString
fixtureTarball = mkTarball [("aeson-2.2.5.0/src/Data/Aeson.hs", "module Data.Aeson where\n")]


-- | A gzipped tar in which the same module appears under both a test tree and
-- the library tree, with the test copy listed first.
dupModuleTarball :: LByteString
dupModuleTarball =
    mkTarball
        [ ("aeson-2.2.5.0/tests/Data/Aeson.hs", "module Data.Aeson (test) where\n")
        , ("aeson-2.2.5.0/src/Data/Aeson.hs", "module Data.Aeson (lib) where\n")
        ]


-- | Build a gzipped tar from @(path, contents)@ pairs, in the given order.
mkTarball :: [(FilePath, Text)] -> LByteString
mkTarball entries =
    GZip.compress (Tar.write [fileEntry path content | (path, content) <- entries])
  where
    fileEntry path content =
        Tar.fileEntry
            (either (error . toText) id (Tar.toTarPath False path))
            (BSL.fromStrict (encodeUtf8 content))