File: Utils.hs

package info (click to toggle)
haskell-cabal-install 3.10.3.0-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, trixie
  • size: 3,400 kB
  • sloc: haskell: 52,202; sh: 80; makefile: 9
file content (107 lines) | stat: -rw-r--r-- 3,173 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
module UnitTests.Distribution.Client.Init.Utils
( dummyFlags
, emptyFlags
, mkLicense
, baseVersion
, mangleBaseDep
, (@?!)
, (@!?)
) where


import Distribution.Client.Init.Types

import qualified Distribution.SPDX as SPDX

import Distribution.CabalSpecVersion
import Distribution.Simple.Setup
import Distribution.Types.PackageName
import Distribution.Types.Version
import Language.Haskell.Extension
import Test.Tasty.HUnit
import Distribution.Types.Dependency
import Distribution.Types.VersionRange
import Distribution.Simple.Compiler
import Distribution.Pretty
import Distribution.FieldGrammar.Newtypes


-- -------------------------------------------------------------------- --
-- Test flags

dummyFlags :: InitFlags
dummyFlags = emptyFlags
  { noComments          = Flag True
  , packageName         = Flag (mkPackageName "QuxPackage")
  , version             = Flag (mkVersion [4,2,6])
  , cabalVersion        = Flag CabalSpecV2_2
  , license             = Flag $ SpecLicense $ Left $ SPDX.License $ SPDX.ELicense (SPDX.ELicenseId SPDX.MIT) Nothing
  , author              = Flag "Foobar"
  , email               = Flag "foobar@qux.com"
  , homepage            = Flag "qux.com"
  , synopsis            = Flag "We are Qux, and this is our package"
  , category            = Flag "Control"
  , language            = Flag Haskell98
  , initializeTestSuite = Flag True
  , sourceDirs          = Flag ["quxSrc"]
  , testDirs            = Flag ["quxTest"]
  , applicationDirs     = Flag ["quxApp"]
  }

emptyFlags :: InitFlags
emptyFlags = mempty

-- | Retrieves the proper base version based on the GHC version
baseVersion :: Compiler -> VersionRange
baseVersion Compiler {compilerId = CompilerId GHC ver} =
  let ghcToBase = baseVersion' . prettyShow $ ver in
        if null ghcToBase
          then anyVersion
          else majorBoundVersion $ mkVersion ghcToBase
baseVersion _ = anyVersion

baseVersion' :: String -> [Int]
baseVersion' "9.0.1"  = [4,15,0,0]
baseVersion' "8.10.4" = [4,14,1,0]
baseVersion' "8.8.4"  = [4,13,0,0]
baseVersion' "8.6.5"  = [4,12,0,0]
baseVersion' "8.4.4"  = [4,11,1,0]
baseVersion' "8.2.2"  = [4,10,1,0]
baseVersion' "7.10.3" = [4,9,0,0]
baseVersion' "7.8.4"  = [4,8,0,0]
baseVersion' "7.6.3"  = [4,7,0,0]
baseVersion' _ = []

-- -------------------------------------------------------------------- --
-- Test utils

mkLicense :: SPDX.LicenseId -> SPDX.License
mkLicense lid = SPDX.License (SPDX.ELicense (SPDX.ELicenseId lid) Nothing)

mangleBaseDep :: a -> (a -> [Dependency]) -> [Dependency]
mangleBaseDep target f =
    [ if unPackageName x == "base"
        then Dependency x anyVersion z
        else dep
    | dep@(Dependency x _ z) <- f target
    ]

infix 1 @?!, @!?

-- | Just like @'@?='@, except it checks for difference rather than equality.
(@?!)
  :: (Eq a, Show a, HasCallStack)
  => a
  -> a
  -> Assertion
actual @?! unexpected = assertBool
                          ("unexpected: " ++ show unexpected)
                          (actual /= unexpected)

-- | Just like @'@=?'@, except it checks for difference rather than equality.
(@!?)
  :: (Eq a, Show a, HasCallStack)
  => a
  -> a
  -> Assertion
(@!?) = flip (@?!)