Skip to content

Commit ea86c0e

Browse files
mergify[bot]mergify[bot]
authored
Merge pull request haskell#10948 from haskell/make-flag-a-synonym-for-last
Make `Flag a` a type synonym for `Last (Maybe a)`
2 parents 5892719 + eb455b8 commit ea86c0e

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

Lines changed: 0 additions & 18 deletions
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

Lines changed: 2 additions & 1 deletion
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

Lines changed: 1 addition & 1 deletion
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

Lines changed: 0 additions & 2 deletions
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

Lines changed: 2 additions & 1 deletion
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

Lines changed: 19 additions & 50 deletions
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

Lines changed: 2 additions & 1 deletion
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

Lines changed: 4 additions & 1 deletion
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

Lines changed: 4 additions & 1 deletion
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

Lines changed: 1 addition & 1 deletion
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

0 commit comments

Comments
 (0)