1{-# LANGUAGE OverloadedLists #-}
2module BumpVersionSpec (spec) where
3
4import           Data.Versions         (SemVer (..), VUnit (..))
5import           Prelude               hiding (FilePath)
6import qualified System.IO.Temp        as Temp
7import           Test.Hspec            (Spec, around_, before_, describe, it, shouldBe,
8                                        shouldReturn)
9import           Test.Hspec.QuickCheck (prop)
10import           Test.QuickCheck       (Gen, arbitrary, forAll)
11import           Turtle                (Text, cp, decodeString, mkdir, mv, writeTextFile)
12import           Utils                 (checkFileHasInfix, checkFixture, getHighestTag, git,
13                                        shouldBeFailure, shouldBeFailureInfix, shouldBeSuccess,
14                                        spago, withCwd)
15
16import           Spago.Version         (VersionBump (..), getNextVersion, parseVersion,
17                                        parseVersionBump, unparseVersion)
18
19-- fix the package set so bower.json is generated with predictable versions
20packageSet :: Text
21packageSet =
22  "let upstream = https://github.com/purescript/package-sets/releases/download/psc-0.13.4-20191025/packages.dhall \
23  \ sha256:f9eb600e5c2a439c3ac9543b1f36590696342baedab2d54ae0aa03c9447ce7d4 \
24  \ in upstream"
25
26setup :: IO () -> IO ()
27setup cmd = do
28  Temp.withTempDirectory "test/" "bump-version-test" $ \temp -> do
29    withCwd (decodeString temp) (setupSpago *> cmd)
30  where
31    setupSpago = do
32      spago ["init"] >>= shouldBeSuccess
33      appendFile "spago.dhall" " // { license = \"MIT\", repository = \"git://github.com/spago/not-a-real-repo.git\" }"
34      writeTextFile "packages.dhall" packageSet
35      spago ["install", "tortellini"]
36
37initGit :: IO ()
38initGit = do
39  git ["init"] >>= shouldBeSuccess
40  git ["config", "user.email", "spago@example.com"] >>= shouldBeSuccess
41  git ["config", "user.name", "Giovanni Spago"] >>= shouldBeSuccess
42  commitAll
43
44commitAll :: IO ()
45commitAll = do
46  git ["add", "--all"] >>= shouldBeSuccess
47  git ["commit", "--allow-empty-message", "--message", ""] >>= shouldBeSuccess
48
49initGitTag :: Text -> IO ()
50initGitTag tag = do
51  initGit
52  git ["tag", "--annotate", tag, "--message", ""] >>= shouldBeSuccess
53  -- commit the bower.json, so spago doesn't fail when it
54  -- generates it but then can't commit it automatically
55  cp "../fixtures/bump-version-bower.json" "bower.json"
56  commitAll
57
58setOverrides :: Text -> IO ()
59setOverrides overrides = do
60  writeTextFile "packages.dhall" $ packageSet <> " // " <> overrides
61  commitAll
62
63randomSemVer :: Gen SemVer
64randomSemVer = SemVer <$> arbitrary <*> arbitrary <*> arbitrary <*> pure [] <*> pure []
65
66spec :: Spec
67spec = describe "spago bump-version" $ do
68  describe "property tests" $ do
69
70    describe "getNextVersion" $ do
71
72      prop "Major version bump should +1 major version and set minor and patch to 0" $
73        forAll randomSemVer $ \initialVersion ->
74            let Right newVersion = getNextVersion Major initialVersion
75            in   _svMajor newVersion == _svMajor initialVersion + 1
76              && _svMinor newVersion == 0
77              && _svPatch newVersion == 0
78
79      prop "Minor version bump should keep major, +1 minor and set patch to 0" $
80        forAll randomSemVer $ \initialVersion ->
81            let Right newVersion = getNextVersion Minor initialVersion
82            in   _svMajor newVersion == _svMajor initialVersion
83              && _svMinor newVersion == _svMinor initialVersion + 1
84              && _svPatch newVersion == 0
85
86      prop "Patch version bump should keep major and minor and +1 patch" $
87        forAll randomSemVer $ \initialVersion ->
88            let Right newVersion = getNextVersion Patch initialVersion
89            in   _svMajor newVersion == _svMajor initialVersion
90              && _svMinor newVersion == _svMinor initialVersion
91              && _svPatch newVersion == _svPatch initialVersion + 1
92
93      prop "parseVersion . unparseVersion == id" $
94        forAll randomSemVer $ \v -> parseVersion (unparseVersion v) == Right v
95
96  describe "unit tests" $ do
97
98    describe "parseVersionBump" $ do
99
100      it "should parse 'major'" $
101        parseVersionBump "major" `shouldBe` Just Major
102
103      it "should parse 'minor'" $
104        parseVersionBump "minor" `shouldBe` Just Minor
105
106      it "should parse 'patch'" $
107        parseVersionBump "patch" `shouldBe` Just Patch
108
109      it "should parse version starting with 'v'" $
110        parseVersionBump "v1.2.3" `shouldBe` Just (Exact (SemVer 1 2 3 [] []))
111
112      it "should parse version not starting with 'v'" $
113        parseVersionBump "1.2.3" `shouldBe` Just (Exact (SemVer 1 2 3 [] []))
114
115      -- TODO is this desired behavior, or should we just drop ONE 'v'? I'd agree it's edge case, but still :-)
116      it "should drop multiple 'v's from the beginning" $
117        parseVersionBump "vvvvvvvv1.2.3" `shouldBe` Just (Exact (SemVer 1 2 3 [] []))
118
119      -- TODO should this work or should we strip these in parser implementation?
120      it "should parse versions with PREREL and META tags" $
121        parseVersionBump "1.2.3-r1+git123" `shouldBe` Just (Exact (SemVer 1 2 3 [[Str "r",Digits 1]] [[Str "git", Digits 123]]))
122
123      it "should not parse version which is not semantic" $ do
124        parseVersionBump "" `shouldBe` Nothing
125        parseVersionBump "1" `shouldBe` Nothing
126        parseVersionBump "1.2" `shouldBe` Nothing
127        parseVersionBump "1.2.3.4" `shouldBe` Nothing
128
129  around_ setup $ do
130    describe "end to end tests" $ do
131
132      it "Spago should complain when no git repo exists" $ do
133
134        spago ["bump-version", "minor"] >>= shouldBeFailureInfix
135          "Your git working tree is dirty. Please commit or stash your changes first"
136
137      before_ (initGitTag "v1.2.3") $ it "Spago should only make a tag with `--no-dry-run`" $ do
138
139        spago ["-v", "bump-version", "minor"] >>= shouldBeSuccess
140        getHighestTag `shouldReturn` Just "v1.2.3"
141
142        spago ["-v", "bump-version", "--no-dry-run", "minor"] >>= shouldBeSuccess
143        getHighestTag `shouldReturn` Just "v1.3.0"
144
145      before_ (initGitTag "not-a-version") $ it "Spago should use v0.0.0 as initial version" $ do
146
147        spago ["-v", "bump-version", "--no-dry-run", "patch"] >>= shouldBeSuccess
148        getHighestTag `shouldReturn` Just "v0.0.1"
149
150
151      before_ initGit $ it "Spago should create bower.json, but not commit it" $ do
152
153        spago ["bump-version", "--no-dry-run", "minor"] >>= shouldBeFailureInfix
154           "A new bower.json has been generated. Please commit this and run `bump-version` again."
155        mv "bower.json" "bump-version-bower.json"
156        checkFixture "bump-version-bower.json"
157
158      before_ initGit $ it "Spago should fail when bower.json is not tracked" $ do
159
160        appendFile ".gitignore" "bower.json\n"
161        commitAll
162        spago ["bump-version", "minor"] >>= shouldBeFailureInfix
163          "bower.json is being ignored by git - change this before continuing"
164
165      before_ initGit $ it "Spago should generate URL#version for non-tagged dependency" $ do
166
167        setOverrides "{ tortellini = upstream.tortellini // { version = \"master\" } }"
168        spago ["bump-version", "--no-dry-run", "minor"] >>= shouldBeFailure
169        checkFileHasInfix "bower.json" "\"purescript-tortellini\": \"https://github.com/justinwoo/purescript-tortellini.git#master\""
170
171      before_ initGit $ it "Spago should fail when spago.dhall references local dependency" $ do
172
173        mkdir "purescript-tortellini"
174        withCwd "purescript-tortellini" $ spago ["init"] >>= shouldBeSuccess
175        setOverrides "{ tortellini = ./purescript-tortellini/spago.dhall as Location }"
176        spago ["bump-version", "minor"] >>= shouldBeFailureInfix
177          "Unable to create Bower version for local repo: ./purescript-tortellini"
178