Skip to content

Commit eb455b8

Browse files
BodigrimMikolaj
Bodigrim
authored and
Mikolaj
committed
Make Flag a a type synonym for Last (Maybe a)
As http://www.haskell.org/pipermail/cabal-devel/2007-December/001509.html explains, `Data.Monoid.Last` was introduced only in base-3.0 and was too new in 2007 to rely on. Thus a compatibility shim `data Flag a` was vendored in. We are long past 2007 and `Data.Monoid.Last` can now be used instead. The commit keeps providing `Flag` and `NoFlag` as pattern synonyms for backward compatibility, but makes `type Flag = Last.`
1 parent 5892719 commit eb455b8

File tree

48 files changed

+173
-118
lines changed

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

48 files changed

+173
-118
lines changed

‎Cabal-QuickCheck/src/Test/QuickCheck/Instances/Cabal.hs

-18
Original file line numberDiff line numberDiff line change
@@ -19,7 +19,6 @@ import Distribution.Compiler
1919
import Distribution.FieldGrammar.Newtypes
2020
import Distribution.ModuleName
2121
import Distribution.Simple.Compiler
22-
import Distribution.Simple.Flag (Flag (..))
2322
import Distribution.Simple.InstallDirs
2423
import Distribution.Simple.Setup (HaddockTarget (..), TestShowDetails (..), DumpBuildInfo)
2524
import Distribution.SPDX
@@ -242,23 +241,6 @@ instance Arbitrary LibraryName where
242241
shrink (LSubLibName _) = [LMainLibName]
243242
shrink _ = []
244243

245-
-------------------------------------------------------------------------------
246-
-- option flags
247-
-------------------------------------------------------------------------------
248-
249-
instance Arbitrary a => Arbitrary (Flag a) where
250-
arbitrary = arbitrary1
251-
252-
shrink NoFlag = []
253-
shrink (Flag x) = NoFlag : [ Flag x' | x' <- shrink x ]
254-
255-
instance Arbitrary1 Flag where
256-
liftArbitrary genA = sized $ \sz ->
257-
if sz <= 0
258-
then pure NoFlag
259-
else frequency [ (1, pure NoFlag)
260-
, (3, Flag <$> genA) ]
261-
262244
-------------------------------------------------------------------------------
263245
-- GPD flags
264246
-------------------------------------------------------------------------------

‎Cabal-syntax/src/Distribution/Utils/Structured.hs

+2-1
Original file line numberDiff line numberDiff line change
@@ -110,7 +110,7 @@ import Data.Typeable (TypeRep, Typeable, typeRep)
110110

111111
import Distribution.Utils.MD5
112112

113-
import Data.Monoid (mconcat)
113+
import Data.Monoid (Last, mconcat)
114114

115115
import qualified Data.Foldable
116116
import qualified Data.Semigroup
@@ -413,6 +413,7 @@ instance Structured Float where structure = nominalStructure
413413
instance Structured Double where structure = nominalStructure
414414

415415
instance Structured a => Structured (Maybe a)
416+
instance Structured a => Structured (Last a)
416417
instance (Structured a, Structured b) => Structured (Either a b)
417418
instance Structured a => Structured (Ratio a) where structure = containerStructure
418419
instance Structured a => Structured [a] where structure = containerStructure

‎Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -33,4 +33,4 @@ md5CheckGenericPackageDescription proxy = md5Check proxy
3333

3434
md5CheckLocalBuildInfo :: Proxy LocalBuildInfo -> Assertion
3535
md5CheckLocalBuildInfo proxy = md5Check proxy
36-
0x906e7b142a02710d412d471a5656769b
36+
0x364f8e404df9ada84ea3b4e3b3084a10

‎Cabal-tree-diff/src/Data/TreeDiff/Instances/Cabal.hs

-2
Original file line numberDiff line numberDiff line change
@@ -17,7 +17,6 @@ import Distribution.InstalledPackageInfo (AbiDependency, ExposedModule
1717
import Distribution.ModuleName (ModuleName)
1818
import Distribution.PackageDescription
1919
import Distribution.Simple.Compiler (DebugInfoLevel, OptimisationLevel, ProfDetailLevel)
20-
import Distribution.Simple.Flag (Flag)
2120
import Distribution.Simple.InstallDirs
2221
import Distribution.Simple.InstallDirs.Internal
2322
import Distribution.Simple.Setup (HaddockTarget, TestShowDetails)
@@ -43,7 +42,6 @@ instance (Eq a, Show a) => ToExpr (Condition a) where toExpr = defaultExprViaSho
4342
instance (Show a, ToExpr b, ToExpr c, Show b, Show c, Eq a, Eq c, Eq b) => ToExpr (CondTree a b c)
4443
instance (Show a, ToExpr b, ToExpr c, Show b, Show c, Eq a, Eq c, Eq b) => ToExpr (CondBranch a b c)
4544
instance (ToExpr a) => ToExpr (NubList a)
46-
instance (ToExpr a) => ToExpr (Flag a)
4745
instance ToExpr a => ToExpr (NES.NonEmptySet a) where
4846
toExpr xs = App "NonEmptySet.fromNonEmpty" [toExpr $ NES.toNonEmpty xs]
4947

‎Cabal/src/Distribution/Backpack/Id.hs

+2-1
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,6 @@
11
{-# LANGUAGE FlexibleInstances #-}
22
{-# LANGUAGE PatternGuards #-}
3+
{-# LANGUAGE PatternSynonyms #-}
34
{-# LANGUAGE RankNTypes #-}
45

56
-- | See <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>
@@ -13,7 +14,7 @@ import Prelude ()
1314

1415
import Distribution.PackageDescription
1516
import Distribution.Simple.Compiler
16-
import Distribution.Simple.Flag (Flag (..))
17+
import Distribution.Simple.Flag (Flag, pattern Flag, pattern NoFlag)
1718
import qualified Distribution.Simple.InstallDirs as InstallDirs
1819
import Distribution.Simple.LocalBuildInfo
1920
import Distribution.Types.ComponentId

‎Cabal/src/Distribution/Simple/Flag.hs

+19-50
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,5 @@
1-
{-# LANGUAGE DeriveGeneric #-}
2-
{-# LANGUAGE DeriveTraversable #-}
31
{-# LANGUAGE FlexibleContexts #-}
2+
{-# LANGUAGE PatternSynonyms #-}
43

54
-----------------------------------------------------------------------------
65

@@ -19,7 +18,9 @@
1918
--
2019
-- Split off from "Distribution.Simple.Setup" to break import cycles.
2120
module Distribution.Simple.Flag
22-
( Flag (..)
21+
( Flag
22+
, pattern Flag
23+
, pattern NoFlag
2324
, allFlags
2425
, toFlag
2526
, fromFlag
@@ -32,6 +33,7 @@ module Distribution.Simple.Flag
3233
, BooleanFlag (..)
3334
) where
3435

36+
import Data.Monoid (Last (..))
3537
import Distribution.Compat.Prelude hiding (get)
3638
import Distribution.Compat.Stack
3739
import Prelude ()
@@ -61,43 +63,15 @@ import Prelude ()
6163
-- 'NoFlag' and later flags override earlier ones.
6264
--
6365
-- Isomorphic to 'Maybe' a.
64-
data Flag a = Flag a | NoFlag deriving (Eq, Generic, Show, Read, Foldable, Traversable)
65-
66-
instance Binary a => Binary (Flag a)
67-
instance Structured a => Structured (Flag a)
68-
69-
instance Functor Flag where
70-
fmap f (Flag x) = Flag (f x)
71-
fmap _ NoFlag = NoFlag
72-
73-
instance Applicative Flag where
74-
(Flag x) <*> y = x <$> y
75-
NoFlag <*> _ = NoFlag
76-
pure = Flag
77-
78-
instance Monoid (Flag a) where
79-
mempty = NoFlag
80-
mappend = (<>)
81-
82-
instance Semigroup (Flag a) where
83-
_ <> f@(Flag _) = f
84-
f <> NoFlag = f
85-
86-
instance Bounded a => Bounded (Flag a) where
87-
minBound = toFlag minBound
88-
maxBound = toFlag maxBound
89-
90-
instance Enum a => Enum (Flag a) where
91-
fromEnum = fromEnum . fromFlag
92-
toEnum = toFlag . toEnum
93-
enumFrom (Flag a) = map toFlag . enumFrom $ a
94-
enumFrom _ = []
95-
enumFromThen (Flag a) (Flag b) = toFlag `map` enumFromThen a b
96-
enumFromThen _ _ = []
97-
enumFromTo (Flag a) (Flag b) = toFlag `map` enumFromTo a b
98-
enumFromTo _ _ = []
99-
enumFromThenTo (Flag a) (Flag b) (Flag c) = toFlag `map` enumFromThenTo a b c
100-
enumFromThenTo _ _ _ = []
66+
type Flag = Last
67+
68+
pattern Flag :: a -> Last a
69+
pattern Flag a = Last (Just a)
70+
71+
pattern NoFlag :: Last a
72+
pattern NoFlag = Last Nothing
73+
74+
{-# COMPLETE Flag, NoFlag #-}
10175

10276
-- | Wraps a value in 'Flag'.
10377
toFlag :: a -> Flag a
@@ -110,26 +84,22 @@ fromFlag NoFlag = error "fromFlag NoFlag. Use fromFlagOrDefault"
11084

11185
-- | Extracts a value from a 'Flag', and returns the default value on 'NoFlag'.
11286
fromFlagOrDefault :: a -> Flag a -> a
113-
fromFlagOrDefault _ (Flag x) = x
114-
fromFlagOrDefault def NoFlag = def
87+
fromFlagOrDefault def = fromMaybe def . getLast
11588

11689
-- | Converts a 'Flag' value to a 'Maybe' value.
11790
flagToMaybe :: Flag a -> Maybe a
118-
flagToMaybe (Flag x) = Just x
119-
flagToMaybe NoFlag = Nothing
91+
flagToMaybe = getLast
12092

12193
-- | Pushes a function through a 'Flag' value, and returns a default
12294
-- if the 'Flag' value is 'NoFlag'.
12395
--
12496
-- @since 3.4.0.0
12597
flagElim :: b -> (a -> b) -> Flag a -> b
126-
flagElim n _ NoFlag = n
127-
flagElim _ f (Flag x) = f x
98+
flagElim n f = maybe n f . getLast
12899

129100
-- | Converts a 'Flag' value to a list.
130101
flagToList :: Flag a -> [a]
131-
flagToList (Flag x) = [x]
132-
flagToList NoFlag = []
102+
flagToList = maybeToList . getLast
133103

134104
-- | Returns 'True' only if every 'Flag' 'Bool' value is Flag True, else 'False'.
135105
allFlags :: [Flag Bool] -> Flag Bool
@@ -140,8 +110,7 @@ allFlags flags =
140110

141111
-- | Converts a 'Maybe' value to a 'Flag' value.
142112
maybeToFlag :: Maybe a -> Flag a
143-
maybeToFlag Nothing = NoFlag
144-
maybeToFlag (Just x) = Flag x
113+
maybeToFlag = Last
145114

146115
-- | Merge the elements of a list 'Flag' with another list 'Flag'.
147116
mergeListFlag :: Flag [a] -> Flag [a] -> Flag [a]

‎Cabal/src/Distribution/Simple/GHC/Internal.hs

+2-1
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,6 @@
11
{-# LANGUAGE DataKinds #-}
22
{-# LANGUAGE FlexibleContexts #-}
3+
{-# LANGUAGE PatternSynonyms #-}
34
{-# LANGUAGE RankNTypes #-}
45

56
-----------------------------------------------------------------------------
@@ -67,7 +68,7 @@ import Distribution.Pretty (prettyShow)
6768
import Distribution.Simple.BuildPaths
6869
import Distribution.Simple.Compiler
6970
import Distribution.Simple.Errors
70-
import Distribution.Simple.Flag (Flag (NoFlag), maybeToFlag, toFlag)
71+
import Distribution.Simple.Flag (Flag, maybeToFlag, toFlag, pattern NoFlag)
7172
import Distribution.Simple.GHC.ImplInfo
7273
import Distribution.Simple.LocalBuildInfo
7374
import Distribution.Simple.Program

‎Cabal/src/Distribution/Simple/Setup.hs

+4-1
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@
22
{-# LANGUAGE DeriveGeneric #-}
33
{-# LANGUAGE FlexibleContexts #-}
44
{-# LANGUAGE LambdaCase #-}
5+
{-# LANGUAGE PatternSynonyms #-}
56
{-# LANGUAGE RankNTypes #-}
67

78
-- |
@@ -118,7 +119,9 @@ module Distribution.Simple.Setup
118119
, splitArgs
119120
, defaultDistPref
120121
, optionDistPref
121-
, Flag (..)
122+
, Flag
123+
, pattern Flag
124+
, pattern NoFlag
122125
, toFlag
123126
, fromFlag
124127
, fromFlagOrDefault

‎Cabal/src/Distribution/Simple/Setup/Common.hs

+4-1
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
{-# LANGUAGE DataKinds #-}
22
{-# LANGUAGE DeriveGeneric #-}
33
{-# LANGUAGE FlexibleContexts #-}
4+
{-# LANGUAGE PatternSynonyms #-}
45
{-# LANGUAGE RankNTypes #-}
56

67
-- |
@@ -32,7 +33,9 @@ module Distribution.Simple.Setup.Common
3233
, defaultDistPref
3334
, extraCompilationArtifacts
3435
, optionDistPref
35-
, Flag (..)
36+
, Flag
37+
, pattern Flag
38+
, pattern NoFlag
3639
, toFlag
3740
, fromFlag
3841
, fromFlagOrDefault

‎cabal-install/src/Distribution/Client/CmdBuild.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -50,7 +50,7 @@ import Distribution.Simple.Command
5050
, option
5151
, usageAlternatives
5252
)
53-
import Distribution.Simple.Flag (Flag (..), fromFlag, fromFlagOrDefault, toFlag)
53+
import Distribution.Simple.Flag (Flag, fromFlag, fromFlagOrDefault, toFlag)
5454
import Distribution.Simple.Utils
5555
( dieWithException
5656
, wrapText

‎cabal-install/src/Distribution/Client/CmdClean.hs

+3-1
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE PatternSynonyms #-}
23
{-# LANGUAGE RecordWildCards #-}
34

45
module Distribution.Client.CmdClean (cleanCommand, cleanAction) where
@@ -38,13 +39,14 @@ import Distribution.Simple.Command
3839
, option
3940
)
4041
import Distribution.Simple.Setup
41-
( Flag (..)
42+
( Flag
4243
, falseArg
4344
, flagToMaybe
4445
, fromFlagOrDefault
4546
, optionDistPref
4647
, optionVerbosity
4748
, toFlag
49+
, pattern NoFlag
4850
)
4951
import Distribution.Simple.Utils
5052
( dieWithException

‎cabal-install/src/Distribution/Client/CmdFreeze.hs

+2-1
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
{-# LANGUAGE NamedFieldPuns #-}
2+
{-# LANGUAGE PatternSynonyms #-}
23
{-# LANGUAGE RecordWildCards #-}
34

45
-- | cabal-install CLI command: freeze
@@ -53,7 +54,7 @@ import Distribution.PackageDescription
5354
( FlagAssignment
5455
, nullFlagAssignment
5556
)
56-
import Distribution.Simple.Flag (Flag (..), fromFlagOrDefault)
57+
import Distribution.Simple.Flag (fromFlagOrDefault, pattern Flag)
5758
import Distribution.Simple.Utils
5859
( dieWithException
5960
, notice

‎cabal-install/src/Distribution/Client/CmdHaddock.hs

+2-1
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
{-# LANGUAGE PatternSynonyms #-}
12
{-# LANGUAGE RecordWildCards #-}
23

34
-- | cabal-install CLI command: haddock
@@ -47,7 +48,7 @@ import Distribution.Simple.Command
4748
, option
4849
, usageAlternatives
4950
)
50-
import Distribution.Simple.Flag (Flag (..))
51+
import Distribution.Simple.Flag (Flag, pattern Flag)
5152
import Distribution.Simple.Program.Builtin
5253
( haddockProgram
5354
)

‎cabal-install/src/Distribution/Client/CmdHaddockProject.hs

+5-2
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,5 @@
1+
{-# LANGUAGE PatternSynonyms #-}
2+
13
module Distribution.Client.CmdHaddockProject
24
( haddockProjectCommand
35
, haddockProjectAction
@@ -64,9 +66,10 @@ import Distribution.Simple.Command
6466
( CommandUI (..)
6567
)
6668
import Distribution.Simple.Flag
67-
( Flag (..)
68-
, fromFlag
69+
( fromFlag
6970
, fromFlagOrDefault
71+
, pattern Flag
72+
, pattern NoFlag
7073
)
7174
import Distribution.Simple.Haddock (createHaddockIndex)
7275
import Distribution.Simple.InstallDirs

‎cabal-install/src/Distribution/Client/CmdInstall.hs

+4-1
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,6 @@
11
{-# LANGUAGE LambdaCase #-}
22
{-# LANGUAGE NamedFieldPuns #-}
3+
{-# LANGUAGE PatternSynonyms #-}
34
{-# LANGUAGE RecordWildCards #-}
45
{-# LANGUAGE ScopedTypeVariables #-}
56
{-# LANGUAGE TupleSections #-}
@@ -162,8 +163,10 @@ import Distribution.Simple.Program.Db
162163
, userSpecifyPaths
163164
)
164165
import Distribution.Simple.Setup
165-
( Flag (..)
166+
( Flag
166167
, installDirsOptions
168+
, pattern Flag
169+
, pattern NoFlag
167170
)
168171
import Distribution.Simple.Utils
169172
( createDirectoryIfMissingVerbose

‎cabal-install/src/Distribution/Client/CmdInstall/ClientInstallFlags.hs

+3-1
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
{-# LANGUAGE DeriveGeneric #-}
2+
{-# LANGUAGE PatternSynonyms #-}
23

34
module Distribution.Client.CmdInstall.ClientInstallFlags
45
( InstallMethod (..)
@@ -21,10 +22,11 @@ import Distribution.Simple.Command
2122
, reqArg
2223
)
2324
import Distribution.Simple.Setup
24-
( Flag (..)
25+
( Flag
2526
, flagToList
2627
, toFlag
2728
, trueArg
29+
, pattern Flag
2830
)
2931

3032
import Distribution.Client.Types.InstallMethod

‎cabal-install/src/Distribution/Client/CmdOutdated.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -97,7 +97,7 @@ import Distribution.Simple.Compiler
9797
, compilerInfo
9898
)
9999
import Distribution.Simple.Flag
100-
( Flag (..)
100+
( Flag
101101
, flagToMaybe
102102
, fromFlagOrDefault
103103
, toFlag

0 commit comments

Comments
 (0)