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.`

Author: Bodigrim

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

@@ -19,7 +19,6 @@ import Distribution.Compiler
 import Distribution.FieldGrammar.Newtypes
 import Distribution.ModuleName
 import Distribution.Simple.Compiler
-import Distribution.Simple.Flag                    (Flag (..))
 import Distribution.Simple.InstallDirs
 import Distribution.Simple.Setup                   (HaddockTarget (..), TestShowDetails (..), DumpBuildInfo)
 import Distribution.SPDX
@@ -242,23 +241,6 @@ instance Arbitrary LibraryName where
     shrink (LSubLibName _) = [LMainLibName]
     shrink _               = []
 
--------------------------------------------------------------------------------
--- option flags
--------------------------------------------------------------------------------
-
-instance Arbitrary a => Arbitrary (Flag a) where
-    arbitrary = arbitrary1
-
-    shrink NoFlag   = []
-    shrink (Flag x) = NoFlag : [ Flag x' | x' <- shrink x ]
-
-instance Arbitrary1 Flag where
-    liftArbitrary genA = sized $ \sz ->
-        if sz <= 0
-        then pure NoFlag
-        else frequency [ (1, pure NoFlag)
-                       , (3, Flag <$> genA) ]
-
 -------------------------------------------------------------------------------
 -- GPD flags
 -------------------------------------------------------------------------------

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

@@ -110,7 +110,7 @@ import Data.Typeable (TypeRep, Typeable, typeRep)
 
 import Distribution.Utils.MD5
 
-import Data.Monoid (mconcat)
+import Data.Monoid (Last, mconcat)
 
 import qualified Data.Foldable
 import qualified Data.Semigroup
@@ -413,6 +413,7 @@ instance Structured Float where structure = nominalStructure
 instance Structured Double where structure = nominalStructure
 
 instance Structured a => Structured (Maybe a)
+instance Structured a => Structured (Last a)
 instance (Structured a, Structured b) => Structured (Either a b)
 instance Structured a => Structured (Ratio a) where structure = containerStructure
 instance Structured a => Structured [a] where structure = containerStructure

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

@@ -33,4 +33,4 @@ md5CheckGenericPackageDescription proxy = md5Check proxy
 
 md5CheckLocalBuildInfo :: Proxy LocalBuildInfo -> Assertion
 md5CheckLocalBuildInfo proxy = md5Check proxy
-    0x906e7b142a02710d412d471a5656769b
+    0x364f8e404df9ada84ea3b4e3b3084a10

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

@@ -17,7 +17,6 @@ import Distribution.InstalledPackageInfo           (AbiDependency, ExposedModule
 import Distribution.ModuleName                     (ModuleName)
 import Distribution.PackageDescription
 import Distribution.Simple.Compiler                (DebugInfoLevel, OptimisationLevel, ProfDetailLevel)
-import Distribution.Simple.Flag                    (Flag)
 import Distribution.Simple.InstallDirs
 import Distribution.Simple.InstallDirs.Internal
 import Distribution.Simple.Setup                   (HaddockTarget, TestShowDetails)
@@ -43,7 +42,6 @@ instance (Eq a, Show a) => ToExpr (Condition a) where toExpr = defaultExprViaSho
 instance (Show a, ToExpr b, ToExpr c, Show b, Show c, Eq a, Eq c, Eq b) => ToExpr (CondTree a b c)
 instance (Show a, ToExpr b, ToExpr c, Show b, Show c, Eq a, Eq c, Eq b) => ToExpr (CondBranch a b c)
 instance (ToExpr a) => ToExpr (NubList a)
-instance (ToExpr a) => ToExpr (Flag a)
 instance ToExpr a => ToExpr (NES.NonEmptySet a) where
     toExpr xs = App "NonEmptySet.fromNonEmpty" [toExpr $ NES.toNonEmpty xs]
 

Cabal/src/Distribution/Backpack/Id.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RankNTypes #-}
 
 -- | See <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>
@@ -13,7 +14,7 @@ import Prelude ()
 
 import Distribution.PackageDescription
 import Distribution.Simple.Compiler
-import Distribution.Simple.Flag (Flag (..))
+import Distribution.Simple.Flag (Flag, pattern Flag, pattern NoFlag)
 import qualified Distribution.Simple.InstallDirs as InstallDirs
 import Distribution.Simple.LocalBuildInfo
 import Distribution.Types.ComponentId

Cabal/src/Distribution/Simple/Flag.hs

@@ -1,6 +1,5 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE PatternSynonyms #-}
 
 -----------------------------------------------------------------------------
 
@@ -19,7 +18,9 @@
 --
 -- Split off from "Distribution.Simple.Setup" to break import cycles.
 module Distribution.Simple.Flag
-  ( Flag (..)
+  ( Flag
+  , pattern Flag
+  , pattern NoFlag
   , allFlags
   , toFlag
   , fromFlag
@@ -32,6 +33,7 @@ module Distribution.Simple.Flag
   , BooleanFlag (..)
   ) where
 
+import Data.Monoid (Last (..))
 import Distribution.Compat.Prelude hiding (get)
 import Distribution.Compat.Stack
 import Prelude ()
@@ -61,43 +63,15 @@ import Prelude ()
 -- 'NoFlag' and later flags override earlier ones.
 --
 -- Isomorphic to 'Maybe' a.
-data Flag a = Flag a | NoFlag deriving (Eq, Generic, Show, Read, Foldable, Traversable)
-
-instance Binary a => Binary (Flag a)
-instance Structured a => Structured (Flag a)
-
-instance Functor Flag where
-  fmap f (Flag x) = Flag (f x)
-  fmap _ NoFlag = NoFlag
-
-instance Applicative Flag where
-  (Flag x) <*> y = x <$> y
-  NoFlag <*> _ = NoFlag
-  pure = Flag
-
-instance Monoid (Flag a) where
-  mempty = NoFlag
-  mappend = (<>)
-
-instance Semigroup (Flag a) where
-  _ <> f@(Flag _) = f
-  f <> NoFlag = f
-
-instance Bounded a => Bounded (Flag a) where
-  minBound = toFlag minBound
-  maxBound = toFlag maxBound
-
-instance Enum a => Enum (Flag a) where
-  fromEnum = fromEnum . fromFlag
-  toEnum = toFlag . toEnum
-  enumFrom (Flag a) = map toFlag . enumFrom $ a
-  enumFrom _ = []
-  enumFromThen (Flag a) (Flag b) = toFlag `map` enumFromThen a b
-  enumFromThen _ _ = []
-  enumFromTo (Flag a) (Flag b) = toFlag `map` enumFromTo a b
-  enumFromTo _ _ = []
-  enumFromThenTo (Flag a) (Flag b) (Flag c) = toFlag `map` enumFromThenTo a b c
-  enumFromThenTo _ _ _ = []
+type Flag = Last
+
+pattern Flag :: a -> Last a
+pattern Flag a = Last (Just a)
+
+pattern NoFlag :: Last a
+pattern NoFlag = Last Nothing
+
+{-# COMPLETE Flag, NoFlag #-}
 
 -- | Wraps a value in 'Flag'.
 toFlag :: a -> Flag a
@@ -110,26 +84,22 @@ fromFlag NoFlag = error "fromFlag NoFlag. Use fromFlagOrDefault"
 
 -- | Extracts a value from a 'Flag', and returns the default value on 'NoFlag'.
 fromFlagOrDefault :: a -> Flag a -> a
-fromFlagOrDefault _ (Flag x) = x
-fromFlagOrDefault def NoFlag = def
+fromFlagOrDefault def = fromMaybe def . getLast
 
 -- | Converts a 'Flag' value to a 'Maybe' value.
 flagToMaybe :: Flag a -> Maybe a
-flagToMaybe (Flag x) = Just x
-flagToMaybe NoFlag = Nothing
+flagToMaybe = getLast
 
 -- | Pushes a function through a 'Flag' value, and returns a default
 -- if the 'Flag' value is 'NoFlag'.
 --
 -- @since 3.4.0.0
 flagElim :: b -> (a -> b) -> Flag a -> b
-flagElim n _ NoFlag = n
-flagElim _ f (Flag x) = f x
+flagElim n f = maybe n f . getLast
 
 -- | Converts a 'Flag' value to a list.
 flagToList :: Flag a -> [a]
-flagToList (Flag x) = [x]
-flagToList NoFlag = []
+flagToList = maybeToList . getLast
 
 -- | Returns 'True' only if every 'Flag' 'Bool' value is Flag True, else 'False'.
 allFlags :: [Flag Bool] -> Flag Bool
@@ -140,8 +110,7 @@ allFlags flags =
 
 -- | Converts a 'Maybe' value to a 'Flag' value.
 maybeToFlag :: Maybe a -> Flag a
-maybeToFlag Nothing = NoFlag
-maybeToFlag (Just x) = Flag x
+maybeToFlag = Last
 
 -- | Merge the elements of a list 'Flag' with another list 'Flag'.
 mergeListFlag :: Flag [a] -> Flag [a] -> Flag [a]

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

@@ -1,5 +1,6 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RankNTypes #-}
 
 -----------------------------------------------------------------------------
@@ -67,7 +68,7 @@ import Distribution.Pretty (prettyShow)
 import Distribution.Simple.BuildPaths
 import Distribution.Simple.Compiler
 import Distribution.Simple.Errors
-import Distribution.Simple.Flag (Flag (NoFlag), maybeToFlag, toFlag)
+import Distribution.Simple.Flag (Flag, maybeToFlag, toFlag, pattern NoFlag)
 import Distribution.Simple.GHC.ImplInfo
 import Distribution.Simple.LocalBuildInfo
 import Distribution.Simple.Program

Cabal/src/Distribution/Simple/Setup.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RankNTypes #-}
 
 -- |
@@ -118,7 +119,9 @@ module Distribution.Simple.Setup
   , splitArgs
   , defaultDistPref
   , optionDistPref
-  , Flag (..)
+  , Flag
+  , pattern Flag
+  , pattern NoFlag
   , toFlag
   , fromFlag
   , fromFlagOrDefault

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

@@ -1,6 +1,7 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RankNTypes #-}
 
 -- |
@@ -32,7 +33,9 @@ module Distribution.Simple.Setup.Common
   , defaultDistPref
   , extraCompilationArtifacts
   , optionDistPref
-  , Flag (..)
+  , Flag
+  , pattern Flag
+  , pattern NoFlag
   , toFlag
   , fromFlag
   , fromFlagOrDefault

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

@@ -50,7 +50,7 @@ import Distribution.Simple.Command
   , option
   , usageAlternatives
   )
-import Distribution.Simple.Flag (Flag (..), fromFlag, fromFlagOrDefault, toFlag)
+import Distribution.Simple.Flag (Flag, fromFlag, fromFlagOrDefault, toFlag)
 import Distribution.Simple.Utils
   ( dieWithException
   , wrapText