1{-# LANGUAGE NoImplicitPrelude #-}
2{-# LANGUAGE OverloadedStrings #-}
3{-# LANGUAGE RecordWildCards #-}
4module Pantry.ArchiveSpec (spec) where
5
6import Test.Hspec
7import Data.Maybe (fromJust)
8import RIO
9import RIO.Text as T
10import Pantry
11import Path.IO (resolveFile')
12
13data TestLocation
14  = TLFilePath String
15  | TLUrl Text
16
17data TestArchive = TestArchive
18  { testLocation :: !TestLocation
19  , testSubdir :: !Text
20  }
21
22getRawPackageLocationIdent' :: TestArchive -> IO PackageIdentifier
23getRawPackageLocationIdent' TestArchive{..} = do
24  testLocation' <- case testLocation of
25    TLFilePath relPath -> do
26      absPath <- resolveFile' relPath
27      return $ ALFilePath $ ResolvedPath
28        { resolvedRelative = RelFilePath $ fromString relPath
29        , resolvedAbsolute = absPath
30        }
31    TLUrl url -> return $ ALUrl url
32  let archive = RawArchive
33        { raLocation = testLocation'
34        , raHash = Nothing
35        , raSize = Nothing
36        , raSubdir = testSubdir
37        }
38  runPantryApp $ getRawPackageLocationIdent $ RPLIArchive archive metadata
39  where
40    metadata = RawPackageMetadata
41      { rpmName = Nothing
42      , rpmVersion = Nothing
43      , rpmTreeKey = Nothing
44      }
45
46parsePackageIdentifier' :: String -> PackageIdentifier
47parsePackageIdentifier' = fromJust . parsePackageIdentifier
48
49urlToStackCommit :: Text -> TestLocation
50urlToStackCommit commit = TLUrl $ T.concat
51  [ "https://github.com/commercialhaskell/stack/archive/"
52  , commit
53  , ".tar.gz"
54  ]
55
56treeWithoutCabalFile :: Selector PantryException
57treeWithoutCabalFile (TreeWithoutCabalFile _) = True
58treeWithoutCabalFile _ = False
59
60spec :: Spec
61spec = do
62  it "finds cabal file from tarball" $ do
63    ident <- getRawPackageLocationIdent' TestArchive
64      { testLocation = TLFilePath "attic/package-0.1.2.3.tar.gz"
65      , testSubdir = ""
66      }
67    ident `shouldBe` parsePackageIdentifier' "package-0.1.2.3"
68  it "finds cabal file from tarball with subdir '.'" $ do
69    ident <- getRawPackageLocationIdent' TestArchive
70      { testLocation = TLFilePath "attic/package-0.1.2.3.tar.gz"
71      , testSubdir = "."
72      }
73    ident `shouldBe` parsePackageIdentifier' "package-0.1.2.3"
74  it "finds cabal file from tarball with a package.yaml" $ do
75    ident <- getRawPackageLocationIdent' TestArchive
76      { testLocation = TLFilePath "attic/hpack-0.1.2.3.tar.gz"
77      , testSubdir = ""
78      }
79    ident `shouldBe` parsePackageIdentifier' "hpack-0.1.2.3"
80  it "finds cabal file from tarball with subdir '.' with a package.yaml" $ do
81    ident <- getRawPackageLocationIdent' TestArchive
82      { testLocation = TLFilePath "attic/hpack-0.1.2.3.tar.gz"
83      , testSubdir = "."
84      }
85    ident `shouldBe` parsePackageIdentifier' "hpack-0.1.2.3"
86  it "finds cabal file from tarball with subdir 'subs/pantry/'" $ do
87    ident <- getRawPackageLocationIdent' TestArchive
88      { testLocation = urlToStackCommit "2b846ff4fda13a8cd095e7421ce76df0a08b10dc"
89      , testSubdir = "subs/pantry/"
90      }
91    ident `shouldBe` parsePackageIdentifier' "pantry-0.1.0.0"
92  it "matches whole directory name" $
93    getRawPackageLocationIdent' TestArchive
94      { testLocation = urlToStackCommit "2b846ff4fda13a8cd095e7421ce76df0a08b10dc"
95      , testSubdir = "subs/pant"
96      }
97    `shouldThrow` treeWithoutCabalFile
98  it "follows symlinks to directories" $ do
99    ident <- getRawPackageLocationIdent' TestArchive
100      { testLocation = TLFilePath "attic/symlink-to-dir.tar.gz"
101      , testSubdir = "symlink"
102      }
103    ident `shouldBe` parsePackageIdentifier' "foo-1.2.3"
104