1{-# LANGUAGE DeriveDataTypeable #-}
2{-# LANGUAGE DeriveGeneric #-}
3module Distribution.CabalSpecVersion where
4
5import Prelude ()
6import Distribution.Compat.Prelude
7
8-- | Different Cabal-the-spec versions.
9--
10-- We branch based on this at least in the parser.
11--
12data CabalSpecVersion
13    = CabalSpecV1_0 -- ^ this is older than 'CabalSpecV1_2'
14    | CabalSpecV1_2 -- ^ new syntax (sections)
15    | CabalSpecV1_4
16    | CabalSpecV1_6
17    | CabalSpecV1_8
18    | CabalSpecV1_10
19    | CabalSpecV1_12
20    -- 1.16 -- 1.14: no changes
21    | CabalSpecV1_18
22    | CabalSpecV1_20
23    | CabalSpecV1_22
24    | CabalSpecV1_24
25    | CabalSpecV2_0
26    | CabalSpecV2_2
27    | CabalSpecV2_4
28    | CabalSpecV3_0
29  deriving (Eq, Ord, Show, Read, Enum, Bounded, Typeable, Data, Generic)
30
31-- | Show cabal spec version, but not the way in the .cabal files
32--
33-- @since 3.0.0.0
34showCabalSpecVersion :: CabalSpecVersion -> String
35showCabalSpecVersion CabalSpecV3_0  = "3.0"
36showCabalSpecVersion CabalSpecV2_4  = "2.4"
37showCabalSpecVersion CabalSpecV2_2  = "2.2"
38showCabalSpecVersion CabalSpecV2_0  = "2.0"
39showCabalSpecVersion CabalSpecV1_24 = "1.24"
40showCabalSpecVersion CabalSpecV1_22 = "1.22"
41showCabalSpecVersion CabalSpecV1_20 = "1.20"
42showCabalSpecVersion CabalSpecV1_18 = "1.18"
43showCabalSpecVersion CabalSpecV1_12 = "1.12"
44showCabalSpecVersion CabalSpecV1_10 = "1.10"
45showCabalSpecVersion CabalSpecV1_8  = "1.8"
46showCabalSpecVersion CabalSpecV1_6  = "1.6"
47showCabalSpecVersion CabalSpecV1_4  = "1.4"
48showCabalSpecVersion CabalSpecV1_2  = "1.2"
49showCabalSpecVersion CabalSpecV1_0  = "1.0"
50
51cabalSpecLatest :: CabalSpecVersion
52cabalSpecLatest = CabalSpecV3_0
53
54cabalSpecFromVersionDigits :: [Int] -> CabalSpecVersion
55cabalSpecFromVersionDigits v
56    = fromMaybe cabalSpecLatest (cabalSpecFromVersionDigitsMaybe v)
57
58cabalSpecFromVersionDigitsMaybe :: [Int] -> Maybe CabalSpecVersion
59cabalSpecFromVersionDigitsMaybe v
60    | v == [3,0]  = Just CabalSpecV3_0
61    | v == [2,4]  = Just CabalSpecV2_4
62    | v == [2,2]  = Just CabalSpecV2_2
63    | v == [2,0]  = Just CabalSpecV2_0
64    | v >= [1,25] = Nothing
65    | v >= [1,23] = Just CabalSpecV1_24
66    | v >= [1,21] = Just CabalSpecV1_22
67    | v >= [1,19] = Just CabalSpecV1_20
68    | v >= [1,17] = Just CabalSpecV1_18
69    | v >= [1,11] = Just CabalSpecV1_12
70    | v >= [1,9]  = Just CabalSpecV1_10
71    | v >= [1,7]  = Just CabalSpecV1_8
72    | v >= [1,5]  = Just CabalSpecV1_6
73    | v >= [1,3]  = Just CabalSpecV1_4
74    | v >= [1,1]  = Just CabalSpecV1_2
75    | otherwise   = Just CabalSpecV1_0
76
77cabalSpecToVersionDigits :: CabalSpecVersion -> [Int]
78cabalSpecToVersionDigits CabalSpecV3_0   = [3,0]
79cabalSpecToVersionDigits CabalSpecV2_4   = [2,4]
80cabalSpecToVersionDigits CabalSpecV2_2   = [2,2]
81cabalSpecToVersionDigits CabalSpecV2_0   = [2,0]
82cabalSpecToVersionDigits CabalSpecV1_24  = [1,24]
83cabalSpecToVersionDigits CabalSpecV1_22  = [1,22]
84cabalSpecToVersionDigits CabalSpecV1_20  = [1,20]
85cabalSpecToVersionDigits CabalSpecV1_18  = [1,18]
86cabalSpecToVersionDigits CabalSpecV1_12  = [1,12]
87cabalSpecToVersionDigits CabalSpecV1_10  = [1,10]
88cabalSpecToVersionDigits CabalSpecV1_8   = [1,8]
89cabalSpecToVersionDigits CabalSpecV1_6   = [1,6]
90cabalSpecToVersionDigits CabalSpecV1_4   = [1,4]
91cabalSpecToVersionDigits CabalSpecV1_2   = [1,2]
92cabalSpecToVersionDigits CabalSpecV1_0   = [1,0]
93
94-- | What is the minimum Cabal library version which knows how handle
95-- this spec version.
96--
97-- /Note:/ this is a point where we could decouple cabal-spec and Cabal
98-- versions, if we ever want that.
99--
100-- >>> cabalSpecMinimumLibraryVersion CabalSpecV3_0
101-- [2,5]
102--
103-- >>> cabalSpecMinimumLibraryVersion CabalSpecV2_4
104-- [2,3]
105--
106cabalSpecMinimumLibraryVersion :: CabalSpecVersion -> [Int]
107cabalSpecMinimumLibraryVersion CabalSpecV1_0 = [1,0]
108cabalSpecMinimumLibraryVersion csv = case cabalSpecToVersionDigits (pred csv) of
109    [x,y] -> [x, y+1]
110    xs    -> xs
111
112specHasCommonStanzas :: CabalSpecVersion -> HasCommonStanzas
113specHasCommonStanzas v =
114    if v >= CabalSpecV2_2
115    then HasCommonStanzas
116    else NoCommonStanzas
117
118specHasElif :: CabalSpecVersion -> HasElif
119specHasElif v =
120    if v >= CabalSpecV2_2
121    then HasElif
122    else NoElif
123
124-------------------------------------------------------------------------------
125-- Booleans
126-------------------------------------------------------------------------------
127
128-- IDEA: make some kind of tagged booleans?
129data HasElif = HasElif | NoElif
130  deriving (Eq, Show)
131
132data HasCommonStanzas = HasCommonStanzas | NoCommonStanzas
133  deriving (Eq, Show)
134
135data HasGlobstar = HasGlobstar | NoGlobstar
136