Cabal-syntax 3.10.3.0 → 3.12.0.0

raw patch · 142 files changed

+12191/−10502 lines, 142 filesdep −Win32dep −unixdep ~basedep ~bytestringdep ~timesetup-changednew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies removed: Win32, unix

Dependency ranges changed: base, bytestring, time

API changes (from Hackage documentation)

Files

• Cabal-syntax.cabal +8/−8
• ChangeLog.md +1/−1
• LICENSE +1/−1
• Setup.hs +1/−0
• src/Distribution/Backpack.hs +94/−88
• src/Distribution/CabalSpecVersion.hs +84/−79
• src/Distribution/Compat/Binary.hs +5/−5
• src/Distribution/Compat/CharParsing.hs +50/−47
• src/Distribution/Compat/DList.hs +13/−12
• src/Distribution/Compat/Exception.hs +8/−7
• src/Distribution/Compat/Graph.hs +157/−139
• src/Distribution/Compat/Lens.hs +67/−49
• src/Distribution/Compat/MonadFail.hs +2/−1
• src/Distribution/Compat/Newtype.hs +24/−22
• src/Distribution/Compat/NonEmptySet.hs +52/−40
• src/Distribution/Compat/Parsing.hs +49/−41
• src/Distribution/Compat/Prelude.hs +182/−113
• src/Distribution/Compat/Semigroup.hs +33/−36
• src/Distribution/Compat/Typeable.hs +6/−5
• src/Distribution/Compiler.hs +89/−63
• src/Distribution/FieldGrammar.hs +38/−33
• src/Distribution/FieldGrammar/Class.hs +186/−143
• src/Distribution/FieldGrammar/FieldDescrs.hs +71/−61
• src/Distribution/FieldGrammar/Newtypes.hs +195/−172
• src/Distribution/FieldGrammar/Parsec.hs +260/−250
• src/Distribution/FieldGrammar/Pretty.hs +82/−74
• src/Distribution/Fields.hs +36/−29
• src/Distribution/Fields/ConfVar.hs +91/−69
• src/Distribution/Fields/Field.hs +95/−49
• src/Distribution/Fields/Lexer.hs +0/−589
• src/Distribution/Fields/Lexer.x +292/−0
• src/Distribution/Fields/LexerMonad.hs +96/−74
• src/Distribution/Fields/ParseResult.hs +72/−69
• src/Distribution/Fields/Parser.hs +193/−109
• src/Distribution/Fields/Pretty.hs +84/−75
• src/Distribution/InstalledPackageInfo.hs +49/−46
• src/Distribution/License.hs +113/−110
• src/Distribution/ModuleName.hs +36/−37
• src/Distribution/Package.hs +23/−19
• src/Distribution/PackageDescription.hs +60/−45
• src/Distribution/PackageDescription/Configuration.hs +351/−282
• src/Distribution/PackageDescription/FieldGrammar.hs +910/−823
• src/Distribution/PackageDescription/Parsec.hs +510/−472
• src/Distribution/PackageDescription/PrettyPrint.hs +135/−104
• src/Distribution/PackageDescription/Quirks.hs +358/−294
• src/Distribution/PackageDescription/Utils.hs +10/−6
• src/Distribution/Parsec.hs +287/−235
• src/Distribution/Parsec/Error.hs +8/−7
• src/Distribution/Parsec/FieldLineStream.hs +55/−53
• src/Distribution/Parsec/Position.hs +14/−12
• src/Distribution/Parsec/Warning.hs +56/−39
• src/Distribution/Pretty.hs +54/−44
• src/Distribution/SPDX.hs +33/−28
• src/Distribution/SPDX/License.hs +15/−16
• src/Distribution/SPDX/LicenseExceptionId.hs +142/−15
• src/Distribution/SPDX/LicenseExpression.hs +85/−83
• src/Distribution/SPDX/LicenseId.hs +857/−116
• src/Distribution/SPDX/LicenseListVersion.hs +13/−11
• src/Distribution/SPDX/LicenseReference.hs +39/−37
• src/Distribution/System.hs +182/−119
• src/Distribution/Text.hs +2/−1
• src/Distribution/Types/AbiDependency.hs +15/−14
• src/Distribution/Types/AbiHash.hs +9/−7
• src/Distribution/Types/Benchmark.hs +33/−37
• src/Distribution/Types/Benchmark/Lens.hs +10/−10
• src/Distribution/Types/BenchmarkInterface.hs +19/−24
• src/Distribution/Types/BenchmarkType.hs +20/−20
• src/Distribution/Types/BuildInfo.hs +247/−212
• src/Distribution/Types/BuildInfo/Lens.hs +245/−246
• src/Distribution/Types/BuildType.hs +26/−22
• src/Distribution/Types/Component.hs +60/−55
• src/Distribution/Types/ComponentId.hs +10/−7
• src/Distribution/Types/ComponentName.hs +51/−49
• src/Distribution/Types/ComponentRequestedSpec.hs +38/−31
• src/Distribution/Types/CondTree.hs +83/−69
• src/Distribution/Types/Condition.hs +73/−69
• src/Distribution/Types/ConfVar.hs +13/−11
• src/Distribution/Types/Dependency.hs +57/−56
• src/Distribution/Types/DependencyMap.hs +25/−23
• src/Distribution/Types/ExeDependency.hs +20/−19
• src/Distribution/Types/Executable.hs +26/−30
• src/Distribution/Types/Executable/Lens.hs +11/−11
• src/Distribution/Types/ExecutableScope.hs +19/−17
• src/Distribution/Types/ExposedModule.hs +21/−20
• src/Distribution/Types/Flag.hs +106/−101
• src/Distribution/Types/ForeignLib.hs +97/−99
• src/Distribution/Types/ForeignLib/Lens.hs +16/−16
• src/Distribution/Types/ForeignLibOption.hs +14/−14
• src/Distribution/Types/ForeignLibType.hs +26/−26
• src/Distribution/Types/GenericPackageDescription.hs +66/−49
• src/Distribution/Types/GenericPackageDescription/Lens.hs +50/−47
• src/Distribution/Types/HookedBuildInfo.hs +3/−3
• src/Distribution/Types/IncludeRenaming.hs +36/−36
• src/Distribution/Types/InstalledPackageInfo.hs +130/−129
• src/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs +155/−140
• src/Distribution/Types/InstalledPackageInfo/Lens.hs +57/−59
• src/Distribution/Types/LegacyExeDependency.hs +21/−19
• src/Distribution/Types/Lens.hs +13/−13
• src/Distribution/Types/Library.hs +48/−42
• src/Distribution/Types/Library/Lens.hs +16/−16
• src/Distribution/Types/LibraryName.hs +25/−24
• src/Distribution/Types/LibraryVisibility.hs +19/−20
• src/Distribution/Types/Mixin.hs +34/−33
• src/Distribution/Types/Module.hs +16/−16
• src/Distribution/Types/ModuleReexport.hs +25/−25
• src/Distribution/Types/ModuleRenaming.hs +73/−72
• src/Distribution/Types/MungedPackageId.hs +20/−22
• src/Distribution/Types/MungedPackageName.hs +32/−31
• src/Distribution/Types/PackageDescription.hs +244/−198
• src/Distribution/Types/PackageDescription/Lens.hs +102/−100
• src/Distribution/Types/PackageId.hs +23/−22
• src/Distribution/Types/PackageId/Lens.hs +8/−8
• src/Distribution/Types/PackageName.hs +11/−8
• src/Distribution/Types/PackageVersionConstraint.hs +19/−20
• src/Distribution/Types/PkgconfigDependency.hs +15/−13
• src/Distribution/Types/PkgconfigName.hs +18/−14
• src/Distribution/Types/PkgconfigVersion.hs +30/−30
• src/Distribution/Types/PkgconfigVersionRange.hs +84/−79
• src/Distribution/Types/SetupBuildInfo.hs +18/−17
• src/Distribution/Types/SetupBuildInfo/Lens.hs +7/−7
• src/Distribution/Types/SourceRepo.hs +64/−64
• src/Distribution/Types/SourceRepo/Lens.hs +14/−14
• src/Distribution/Types/TestSuite.hs +42/−45
• src/Distribution/Types/TestSuite/Lens.hs +10/−10
• src/Distribution/Types/TestSuiteInterface.hs +22/−29
• src/Distribution/Types/TestType.hs +28/−24
• src/Distribution/Types/UnitId.hs +17/−18
• src/Distribution/Types/UnqualComponentName.hs +52/−7
• src/Distribution/Types/Version.hs +133/−114
• src/Distribution/Types/VersionInterval.hs +93/−100
• src/Distribution/Types/VersionInterval/Legacy.hs +161/−174
• src/Distribution/Types/VersionRange.hs +106/−87
• src/Distribution/Types/VersionRange/Internal.hs +286/−257
• src/Distribution/Utils/Base62.hs +7/−9
• src/Distribution/Utils/Generic.hs +216/−204
• src/Distribution/Utils/MD5.hs +30/−26
• src/Distribution/Utils/Path.hs +33/−21
• src/Distribution/Utils/ShortText.hs +24/−23
• src/Distribution/Utils/String.hs +66/−56
• src/Distribution/Utils/Structured.hs +167/−153
• src/Distribution/Version.hs +86/−85
• src/Language/Haskell/Extension.hs +612/−748

@@ -1,7 +1,7 @@ cabal-version: 2.2 name:          Cabal-syntax-version:       3.10.3.0-copyright:     2003-2023, Cabal Development Team (see AUTHORS file)+version:       3.12.0.0+copyright:     2003-2024, Cabal Development Team (see AUTHORS file) license:       BSD-3-Clause license-file:  LICENSE author:        Cabal Development Team <cabal-devel@haskell.org>@@ -40,16 +40,11 @@     parsec     >= 3.1.13.0 && < 3.2,     pretty     >= 1.1.1    && < 1.2,     text       (>= 1.2.3.0 && < 1.3) || (>= 2.0 && < 2.2),-    time       >= 1.4.0.1  && < 1.13,+    time       >= 1.4.0.1  && < 1.15,     -- transformers-0.4.0.0 doesn't have record syntax e.g. for Identity     -- See also https://github.com/ekmett/transformers-compat/issues/35     transformers (>= 0.3      && < 0.4) || (>=0.4.1.0 && <0.7) -  if os(windows)-    build-depends: Win32 >= 2.3.0.0 && < 2.14-  else-    build-depends: unix  >= 2.6.0.0 && < 2.9-   ghc-options: -Wall -fno-ignore-asserts -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates    if impl(ghc >= 8.0)@@ -57,6 +52,11 @@    if impl(ghc >= 8.0) && impl(ghc < 8.8)     ghc-options: -Wnoncanonical-monadfail-instances++  if impl(ghc >= 8.10)+    ghc-options: -Wunused-packages++  build-tool-depends: alex:alex    exposed-modules:     Distribution.Backpack

@@ -1,1 +1,1 @@-Please see See https://github.com/haskell/cabal/blob/master/release-notes/Cabal-3.10.3.0.md+Please see https://github.com/haskell/cabal/blob/master/release-notes/Cabal-3.12.0.0.md

@@ -1,4 +1,4 @@-Copyright (c) 2003-2023, Cabal Development Team.+Copyright (c) 2003-2024, Cabal Development Team. See the AUTHORS file for the full list of copyright holders.  See */LICENSE for the copyright holders of the subcomponents.

@@ -1,3 +1,4 @@ import Distribution.Simple+ main :: IO () main = defaultMain

@@ -1,51 +1,50 @@-{-# LANGUAGE DeriveDataTypeable         #-}-{-# LANGUAGE DeriveGeneric              #-}-{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE PatternGuards              #-}-{-# LANGUAGE RankNTypes                 #-}+{-# LANGUAGE PatternGuards #-}+{-# LANGUAGE RankNTypes #-}  -- | This module defines the core data types for Backpack.  For more -- details, see: -- --  <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>--module Distribution.Backpack (-    -- * OpenUnitId-    OpenUnitId(..),-    openUnitIdFreeHoles,-    mkOpenUnitId,+module Distribution.Backpack+  ( -- * OpenUnitId+    OpenUnitId (..)+  , openUnitIdFreeHoles+  , mkOpenUnitId      -- * DefUnitId-    DefUnitId,-    unDefUnitId,-    mkDefUnitId,+  , DefUnitId+  , unDefUnitId+  , mkDefUnitId      -- * OpenModule-    OpenModule(..),-    openModuleFreeHoles,+  , OpenModule (..)+  , openModuleFreeHoles      -- * OpenModuleSubst-    OpenModuleSubst,-    dispOpenModuleSubst,-    dispOpenModuleSubstEntry,-    parsecOpenModuleSubst,-    parsecOpenModuleSubstEntry,-    openModuleSubstFreeHoles,+  , OpenModuleSubst+  , dispOpenModuleSubst+  , dispOpenModuleSubstEntry+  , parsecOpenModuleSubst+  , parsecOpenModuleSubstEntry+  , openModuleSubstFreeHoles      -- * Conversions to 'UnitId'-    abstractUnitId,-    hashModuleSubst,-) where+  , abstractUnitId+  , hashModuleSubst+  ) where  import Distribution.Compat.Prelude hiding (mod) import Distribution.Parsec import Distribution.Pretty+import Text.PrettyPrint (hcat) import Prelude ()-import Text.PrettyPrint            (hcat)  import qualified Distribution.Compat.CharParsing as P-import qualified Text.PrettyPrint                as Disp+import qualified Text.PrettyPrint as Disp  import Distribution.ModuleName import Distribution.Types.ComponentId@@ -81,52 +80,53 @@ -- -- For more details see the Backpack spec -- <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>---- data OpenUnitId-    -- | Identifies a component which may have some unfilled holes;+  = -- | Identifies a component which may have some unfilled holes;     -- specifying its 'ComponentId' and its 'OpenModuleSubst'.     -- TODO: Invariant that 'OpenModuleSubst' is non-empty?     -- See also the Text instance.-    = IndefFullUnitId ComponentId OpenModuleSubst-    -- | Identifies a fully instantiated component, which has+    IndefFullUnitId ComponentId OpenModuleSubst+  | -- | Identifies a fully instantiated component, which has     -- been compiled and abbreviated as a hash.  The embedded 'UnitId'     -- MUST NOT be for an indefinite component; an 'OpenUnitId'     -- is guaranteed not to have any holes.-    | DefiniteUnitId DefUnitId+    DefiniteUnitId DefUnitId   deriving (Generic, Read, Show, Eq, Ord, Typeable, Data)+ -- TODO: cache holes?  instance Binary OpenUnitId instance Structured OpenUnitId instance NFData OpenUnitId where-    rnf (IndefFullUnitId cid subst) = rnf cid `seq` rnf subst-    rnf (DefiniteUnitId uid) = rnf uid+  rnf (IndefFullUnitId cid subst) = rnf cid `seq` rnf subst+  rnf (DefiniteUnitId uid) = rnf uid  instance Pretty OpenUnitId where-    pretty (IndefFullUnitId cid insts)-        -- TODO: arguably a smart constructor to enforce invariant would be-        -- better-        | Map.null insts = pretty cid-        | otherwise      = pretty cid <<>> Disp.brackets (dispOpenModuleSubst insts)-    pretty (DefiniteUnitId uid) = pretty uid+  pretty (IndefFullUnitId cid insts)+    -- TODO: arguably a smart constructor to enforce invariant would be+    -- better+    | Map.null insts = pretty cid+    | otherwise = pretty cid <<>> Disp.brackets (dispOpenModuleSubst insts)+  pretty (DefiniteUnitId uid) = pretty uid  -- | -- -- >>> eitherParsec "foobar" :: Either String OpenUnitId---Right (DefiniteUnitId (DefUnitId {unDefUnitId = UnitId "foobar"}))+-- Right (DefiniteUnitId (DefUnitId {unDefUnitId = UnitId "foobar"})) -- -- >>> eitherParsec "foo[Str=text-1.2.3:Data.Text.Text]" :: Either String OpenUnitId -- Right (IndefFullUnitId (ComponentId "foo") (fromList [(ModuleName "Str",OpenModule (DefiniteUnitId (DefUnitId {unDefUnitId = UnitId "text-1.2.3"})) (ModuleName "Data.Text.Text"))]))--- instance Parsec OpenUnitId where-    parsec = P.try parseOpenUnitId <|> fmap DefiniteUnitId parsec-      where-        parseOpenUnitId = do-            cid <- parsec-            insts <- P.between (P.char '[') (P.char ']')-                       parsecOpenModuleSubst-            return (IndefFullUnitId cid insts)+  parsec = P.try parseOpenUnitId <|> fmap DefiniteUnitId parsec+    where+      parseOpenUnitId = do+        cid <- parsec+        insts <-+          P.between+            (P.char '[')+            (P.char ']')+            parsecOpenModuleSubst+        return (IndefFullUnitId cid insts)  -- | Get the set of holes ('ModuleVar') embedded in a 'UnitId'. openUnitIdFreeHoles :: OpenUnitId -> Set ModuleName@@ -137,9 +137,9 @@ -- is if the instantiation is provided. mkOpenUnitId :: UnitId -> ComponentId -> OpenModuleSubst -> OpenUnitId mkOpenUnitId uid cid insts =-    if Set.null (openModuleSubstFreeHoles insts)-        then DefiniteUnitId (unsafeMkDefUnitId uid) -- invariant holds!-        else IndefFullUnitId cid insts+  if Set.null (openModuleSubstFreeHoles insts)+    then DefiniteUnitId (unsafeMkDefUnitId uid) -- invariant holds!+    else IndefFullUnitId cid insts  ----------------------------------------------------------------------- -- DefUnitId@@ -148,10 +148,13 @@ -- with no holes. mkDefUnitId :: ComponentId -> Map ModuleName Module -> DefUnitId mkDefUnitId cid insts =-    unsafeMkDefUnitId (mkUnitId-        (unComponentId cid ++ maybe "" ("+"++) (hashModuleSubst insts)))-        -- impose invariant!+  unsafeMkDefUnitId+    ( mkUnitId+        (unComponentId cid ++ maybe "" ("+" ++) (hashModuleSubst insts))+    ) +-- impose invariant!+ ----------------------------------------------------------------------- -- OpenModule @@ -160,42 +163,41 @@ -- hole that needs to be filled in.  Substitutions are over -- module variables. data OpenModule-    = OpenModule OpenUnitId ModuleName-    | OpenModuleVar ModuleName+  = OpenModule OpenUnitId ModuleName+  | OpenModuleVar ModuleName   deriving (Generic, Read, Show, Eq, Ord, Typeable, Data)  instance Binary OpenModule instance Structured OpenModule  instance NFData OpenModule where-    rnf (OpenModule uid mod_name) = rnf uid `seq` rnf mod_name-    rnf (OpenModuleVar mod_name) = rnf mod_name+  rnf (OpenModule uid mod_name) = rnf uid `seq` rnf mod_name+  rnf (OpenModuleVar mod_name) = rnf mod_name  instance Pretty OpenModule where-    pretty (OpenModule uid mod_name) =-        hcat [pretty uid, Disp.text ":", pretty mod_name]-    pretty (OpenModuleVar mod_name) =-        hcat [Disp.char '<', pretty mod_name, Disp.char '>']+  pretty (OpenModule uid mod_name) =+    hcat [pretty uid, Disp.text ":", pretty mod_name]+  pretty (OpenModuleVar mod_name) =+    hcat [Disp.char '<', pretty mod_name, Disp.char '>']  -- | -- -- >>> eitherParsec "Includes2-0.1.0.0-inplace-mysql:Database.MySQL" :: Either String OpenModule -- Right (OpenModule (DefiniteUnitId (DefUnitId {unDefUnitId = UnitId "Includes2-0.1.0.0-inplace-mysql"})) (ModuleName "Database.MySQL"))--- instance Parsec OpenModule where-    parsec = parsecModuleVar <|> parsecOpenModule-      where-        parsecOpenModule = do-            uid <- parsec-            _ <- P.char ':'-            mod_name <- parsec-            return (OpenModule uid mod_name)+  parsec = parsecModuleVar <|> parsecOpenModule+    where+      parsecOpenModule = do+        uid <- parsec+        _ <- P.char ':'+        mod_name <- parsec+        return (OpenModule uid mod_name) -        parsecModuleVar = do-            _ <- P.char '<'-            mod_name <- parsec-            _ <- P.char '>'-            return (OpenModuleVar mod_name)+      parsecModuleVar = do+        _ <- P.char '<'+        mod_name <- parsec+        _ <- P.char '>'+        return (OpenModuleVar mod_name)  -- | Get the set of holes ('ModuleVar') embedded in a 'Module'. openModuleFreeHoles :: OpenModule -> Set ModuleName@@ -214,8 +216,8 @@ -- | Pretty-print the entries of a module substitution, suitable -- for embedding into a 'OpenUnitId' or passing to GHC via @--instantiate-with@. dispOpenModuleSubst :: OpenModuleSubst -> Disp.Doc-dispOpenModuleSubst subst-    = Disp.hcat+dispOpenModuleSubst subst =+  Disp.hcat     . Disp.punctuate Disp.comma     $ map dispOpenModuleSubstEntry (Map.toAscList subst) @@ -227,19 +229,21 @@ -- -- @since 2.2 parsecOpenModuleSubst :: CabalParsing m => m OpenModuleSubst-parsecOpenModuleSubst = fmap Map.fromList-      . flip P.sepBy (P.char ',')-      $ parsecOpenModuleSubstEntry+parsecOpenModuleSubst =+  fmap Map.fromList+    . flip P.sepBy (P.char ',')+    $ parsecOpenModuleSubstEntry  -- | Inverse to 'dispModSubstEntry'. -- -- @since 2.2 parsecOpenModuleSubstEntry :: CabalParsing m => m (ModuleName, OpenModule) parsecOpenModuleSubstEntry =-    do k <- parsec-       _ <- P.char '='-       v <- parsec-       return (k, v)+  do+    k <- parsec+    _ <- P.char '='+    v <- parsec+    return (k, v)  -- | Get the set of holes ('ModuleVar') embedded in a 'OpenModuleSubst'. -- This is NOT the domain of the substitution.@@ -265,5 +269,7 @@   | Map.null subst = Nothing   | otherwise =       Just . hashToBase62 $-        concat [ prettyShow mod_name ++ "=" ++ prettyShow m ++ "\n"-               | (mod_name, m) <- Map.toList subst]+        concat+          [ prettyShow mod_name ++ "=" ++ prettyShow m ++ "\n"+          | (mod_name, m) <- Map.toList subst+          ]

@@ -1,36 +1,39 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-}+ module Distribution.CabalSpecVersion where -import Prelude () import Distribution.Compat.Prelude+import Prelude ()  -- | Different Cabal-the-spec versions. -- -- We branch based on this at least in the parser.--- data CabalSpecVersion-    = CabalSpecV1_0 -- ^ this is older than 'CabalSpecV1_2'-    | CabalSpecV1_2 -- ^ new syntax (sections)-    | CabalSpecV1_4-    | CabalSpecV1_6-    | CabalSpecV1_8-    | CabalSpecV1_10-    | CabalSpecV1_12-    -- 1.16 -- 1.14: no changes-    | CabalSpecV1_18-    | CabalSpecV1_20-    | CabalSpecV1_22-    | CabalSpecV1_24-    | CabalSpecV2_0-    | CabalSpecV2_2-    | CabalSpecV2_4-    | CabalSpecV3_0-    -- 3.2: no changes-    | CabalSpecV3_4-    | CabalSpecV3_6-    | CabalSpecV3_8-    -- 3.10: no changes+  = -- | this is older than 'CabalSpecV1_2'+    CabalSpecV1_0+  | -- | new syntax (sections)+    CabalSpecV1_2+  | CabalSpecV1_4+  | CabalSpecV1_6+  | CabalSpecV1_8+  | CabalSpecV1_10+  | CabalSpecV1_12+  | -- 1.16 -- 1.14: no changes+    CabalSpecV1_18+  | CabalSpecV1_20+  | CabalSpecV1_22+  | CabalSpecV1_24+  | CabalSpecV2_0+  | CabalSpecV2_2+  | CabalSpecV2_4+  | CabalSpecV3_0+  | -- 3.2: no changes+    CabalSpecV3_4+  | CabalSpecV3_6+  | CabalSpecV3_8+  | -- 3.10: no changes+    CabalSpecV3_12   deriving (Eq, Ord, Show, Read, Enum, Bounded, Typeable, Data, Generic)  instance Binary CabalSpecVersion@@ -41,74 +44,76 @@ -- -- @since 3.0.0.0 showCabalSpecVersion :: CabalSpecVersion -> String-showCabalSpecVersion CabalSpecV3_8  = "3.8"-showCabalSpecVersion CabalSpecV3_6  = "3.6"-showCabalSpecVersion CabalSpecV3_4  = "3.4"-showCabalSpecVersion CabalSpecV3_0  = "3.0"-showCabalSpecVersion CabalSpecV2_4  = "2.4"-showCabalSpecVersion CabalSpecV2_2  = "2.2"-showCabalSpecVersion CabalSpecV2_0  = "2.0"+showCabalSpecVersion CabalSpecV3_12 = "3.12"+showCabalSpecVersion CabalSpecV3_8 = "3.8"+showCabalSpecVersion CabalSpecV3_6 = "3.6"+showCabalSpecVersion CabalSpecV3_4 = "3.4"+showCabalSpecVersion CabalSpecV3_0 = "3.0"+showCabalSpecVersion CabalSpecV2_4 = "2.4"+showCabalSpecVersion CabalSpecV2_2 = "2.2"+showCabalSpecVersion CabalSpecV2_0 = "2.0" showCabalSpecVersion CabalSpecV1_24 = "1.24" showCabalSpecVersion CabalSpecV1_22 = "1.22" showCabalSpecVersion CabalSpecV1_20 = "1.20" showCabalSpecVersion CabalSpecV1_18 = "1.18" showCabalSpecVersion CabalSpecV1_12 = "1.12" showCabalSpecVersion CabalSpecV1_10 = "1.10"-showCabalSpecVersion CabalSpecV1_8  = "1.8"-showCabalSpecVersion CabalSpecV1_6  = "1.6"-showCabalSpecVersion CabalSpecV1_4  = "1.4"-showCabalSpecVersion CabalSpecV1_2  = "1.2"-showCabalSpecVersion CabalSpecV1_0  = "1.0"+showCabalSpecVersion CabalSpecV1_8 = "1.8"+showCabalSpecVersion CabalSpecV1_6 = "1.6"+showCabalSpecVersion CabalSpecV1_4 = "1.4"+showCabalSpecVersion CabalSpecV1_2 = "1.2"+showCabalSpecVersion CabalSpecV1_0 = "1.0"  cabalSpecLatest :: CabalSpecVersion-cabalSpecLatest = CabalSpecV3_8+cabalSpecLatest = CabalSpecV3_12  -- | Parse 'CabalSpecVersion' from version digits. -- -- It may fail if for recent versions the version is not exact.--- cabalSpecFromVersionDigits :: [Int] -> Maybe CabalSpecVersion cabalSpecFromVersionDigits v-    | v == [3,8]  = Just CabalSpecV3_8-    | v == [3,6]  = Just CabalSpecV3_6-    | v == [3,4]  = Just CabalSpecV3_4-    | v == [3,0]  = Just CabalSpecV3_0-    | v == [2,4]  = Just CabalSpecV2_4-    | v == [2,2]  = Just CabalSpecV2_2-    | v == [2,0]  = Just CabalSpecV2_0-    | v >= [1,25] = Nothing-    | v >= [1,23] = Just CabalSpecV1_24-    | v >= [1,21] = Just CabalSpecV1_22-    | v >= [1,19] = Just CabalSpecV1_20-    | v >= [1,17] = Just CabalSpecV1_18-    | v >= [1,11] = Just CabalSpecV1_12-    | v >= [1,9]  = Just CabalSpecV1_10-    | v >= [1,7]  = Just CabalSpecV1_8-    | v >= [1,5]  = Just CabalSpecV1_6-    | v >= [1,3]  = Just CabalSpecV1_4-    | v >= [1,1]  = Just CabalSpecV1_2-    | otherwise   = Just CabalSpecV1_0+  | v == [3, 12] = Just CabalSpecV3_12+  | v == [3, 8] = Just CabalSpecV3_8+  | v == [3, 6] = Just CabalSpecV3_6+  | v == [3, 4] = Just CabalSpecV3_4+  | v == [3, 0] = Just CabalSpecV3_0+  | v == [2, 4] = Just CabalSpecV2_4+  | v == [2, 2] = Just CabalSpecV2_2+  | v == [2, 0] = Just CabalSpecV2_0+  | v >= [1, 25] = Nothing+  | v >= [1, 23] = Just CabalSpecV1_24+  | v >= [1, 21] = Just CabalSpecV1_22+  | v >= [1, 19] = Just CabalSpecV1_20+  | v >= [1, 17] = Just CabalSpecV1_18+  | v >= [1, 11] = Just CabalSpecV1_12+  | v >= [1, 9] = Just CabalSpecV1_10+  | v >= [1, 7] = Just CabalSpecV1_8+  | v >= [1, 5] = Just CabalSpecV1_6+  | v >= [1, 3] = Just CabalSpecV1_4+  | v >= [1, 1] = Just CabalSpecV1_2+  | otherwise = Just CabalSpecV1_0  -- | @since 3.4.0.0 cabalSpecToVersionDigits :: CabalSpecVersion -> [Int]-cabalSpecToVersionDigits CabalSpecV3_8   = [3,8]-cabalSpecToVersionDigits CabalSpecV3_6   = [3,6]-cabalSpecToVersionDigits CabalSpecV3_4   = [3,4]-cabalSpecToVersionDigits CabalSpecV3_0   = [3,0]-cabalSpecToVersionDigits CabalSpecV2_4   = [2,4]-cabalSpecToVersionDigits CabalSpecV2_2   = [2,2]-cabalSpecToVersionDigits CabalSpecV2_0   = [2,0]-cabalSpecToVersionDigits CabalSpecV1_24  = [1,24]-cabalSpecToVersionDigits CabalSpecV1_22  = [1,22]-cabalSpecToVersionDigits CabalSpecV1_20  = [1,20]-cabalSpecToVersionDigits CabalSpecV1_18  = [1,18]-cabalSpecToVersionDigits CabalSpecV1_12  = [1,12]-cabalSpecToVersionDigits CabalSpecV1_10  = [1,10]-cabalSpecToVersionDigits CabalSpecV1_8   = [1,8]-cabalSpecToVersionDigits CabalSpecV1_6   = [1,6]-cabalSpecToVersionDigits CabalSpecV1_4   = [1,4]-cabalSpecToVersionDigits CabalSpecV1_2   = [1,2]-cabalSpecToVersionDigits CabalSpecV1_0   = [1,0]+cabalSpecToVersionDigits CabalSpecV3_12 = [3, 12]+cabalSpecToVersionDigits CabalSpecV3_8 = [3, 8]+cabalSpecToVersionDigits CabalSpecV3_6 = [3, 6]+cabalSpecToVersionDigits CabalSpecV3_4 = [3, 4]+cabalSpecToVersionDigits CabalSpecV3_0 = [3, 0]+cabalSpecToVersionDigits CabalSpecV2_4 = [2, 4]+cabalSpecToVersionDigits CabalSpecV2_2 = [2, 2]+cabalSpecToVersionDigits CabalSpecV2_0 = [2, 0]+cabalSpecToVersionDigits CabalSpecV1_24 = [1, 24]+cabalSpecToVersionDigits CabalSpecV1_22 = [1, 22]+cabalSpecToVersionDigits CabalSpecV1_20 = [1, 20]+cabalSpecToVersionDigits CabalSpecV1_18 = [1, 18]+cabalSpecToVersionDigits CabalSpecV1_12 = [1, 12]+cabalSpecToVersionDigits CabalSpecV1_10 = [1, 10]+cabalSpecToVersionDigits CabalSpecV1_8 = [1, 8]+cabalSpecToVersionDigits CabalSpecV1_6 = [1, 6]+cabalSpecToVersionDigits CabalSpecV1_4 = [1, 4]+cabalSpecToVersionDigits CabalSpecV1_2 = [1, 2]+cabalSpecToVersionDigits CabalSpecV1_0 = [1, 0]  -- | What is the minimum Cabal library version which knows how handle -- this spec version.@@ -124,20 +129,20 @@ -- -- @since 3.4.0.0 cabalSpecMinimumLibraryVersion :: CabalSpecVersion -> [Int]-cabalSpecMinimumLibraryVersion CabalSpecV1_0 = [1,0]+cabalSpecMinimumLibraryVersion CabalSpecV1_0 = [1, 0] cabalSpecMinimumLibraryVersion csv = case cabalSpecToVersionDigits (pred csv) of-    [x,y] -> [x, y+1]-    xs    -> xs+  [x, y] -> [x, y + 1]+  xs -> xs  specHasCommonStanzas :: CabalSpecVersion -> HasCommonStanzas specHasCommonStanzas v =-    if v >= CabalSpecV2_2+  if v >= CabalSpecV2_2     then HasCommonStanzas     else NoCommonStanzas  specHasElif :: CabalSpecVersion -> HasElif specHasElif v =-    if v >= CabalSpecV2_2+  if v >= CabalSpecV2_2     then HasElif     else NoElif 

@@ -2,10 +2,10 @@ {-# LANGUAGE PatternSynonyms #-}  module Distribution.Compat.Binary-       ( decodeOrFailIO-       , decodeFileOrFail'-       , module Data.Binary-       ) where+  ( decodeOrFailIO+  , decodeFileOrFail'+  , module Data.Binary+  ) where  import Control.Exception (ErrorCall (..), catch, evaluate) import Data.ByteString.Lazy (ByteString)@@ -18,6 +18,6 @@  decodeOrFailIO :: Binary a => ByteString -> IO (Either String a) decodeOrFailIO bs =-    catch (evaluate (decode bs) >>= return . Right) handler+  catch (evaluate (decode bs) >>= return . Right) handler   where     handler (ErrorCallWithLocation str _) = return $ Left str

@@ -1,8 +1,12 @@-{-# LANGUAGE GADTs #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fspec-constr -fspec-constr-count=8 #-}+ -----------------------------------------------------------------------------++-----------------------------------------------------------------------------+ -- | -- Module      :  Distribution.Compat.CharParsing -- Copyright   :  (c) Edward Kmett 2011@@ -15,28 +19,27 @@ -- Parsers for character streams -- -- Originally in @parsers@ package.--------------------------------------------------------------------------------- module Distribution.Compat.CharParsing-  (-  -- * Combinators-    oneOf        -- :: CharParsing m => [Char] -> m Char-  , noneOf       -- :: CharParsing m => [Char] -> m Char-  , spaces       -- :: CharParsing m => m ()-  , space        -- :: CharParsing m => m Char-  , newline      -- :: CharParsing m => m Char-  , tab          -- :: CharParsing m => m Char-  , upper        -- :: CharParsing m => m Char-  , lower        -- :: CharParsing m => m Char-  , alphaNum     -- :: CharParsing m => m Char-  , letter       -- :: CharParsing m => m Char-  , digit        -- :: CharParsing m => m Char-  , hexDigit     -- :: CharParsing m => m Char-  , octDigit     -- :: CharParsing m => m Char+  ( -- * Combinators+    oneOf -- :: CharParsing m => [Char] -> m Char+  , noneOf -- :: CharParsing m => [Char] -> m Char+  , spaces -- :: CharParsing m => m ()+  , space -- :: CharParsing m => m Char+  , newline -- :: CharParsing m => m Char+  , tab -- :: CharParsing m => m Char+  , upper -- :: CharParsing m => m Char+  , lower -- :: CharParsing m => m Char+  , alphaNum -- :: CharParsing m => m Char+  , letter -- :: CharParsing m => m Char+  , digit -- :: CharParsing m => m Char+  , hexDigit -- :: CharParsing m => m Char+  , octDigit -- :: CharParsing m => m Char   , satisfyRange -- :: CharParsing m => Char -> Char -> m Char-  -- * Class-  , CharParsing(..)-  -- * Cabal additions++    -- * Class+  , CharParsing (..)++    -- * Cabal additions   , integral   , signedIntegral   , munch1@@ -45,18 +48,18 @@   , module Distribution.Compat.Parsing   ) where -import Prelude () import Distribution.Compat.Prelude+import Prelude ()  import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.Identity (IdentityT (..))+import Control.Monad.Trans.RWS.Lazy as Lazy+import Control.Monad.Trans.RWS.Strict as Strict+import Control.Monad.Trans.Reader (ReaderT (..)) import Control.Monad.Trans.State.Lazy as Lazy import Control.Monad.Trans.State.Strict as Strict import Control.Monad.Trans.Writer.Lazy as Lazy import Control.Monad.Trans.Writer.Strict as Strict-import Control.Monad.Trans.RWS.Lazy as Lazy-import Control.Monad.Trans.RWS.Strict as Strict-import Control.Monad.Trans.Reader (ReaderT (..))-import Control.Monad.Trans.Identity (IdentityT (..)) import Data.Char import Data.Text (Text, unpack) @@ -194,13 +197,13 @@ instance (CharParsing m, MonadPlus m) => CharParsing (Lazy.StateT s m) where   satisfy = lift . satisfy   {-# INLINE satisfy #-}-  char    = lift . char+  char = lift . char   {-# INLINE char #-}   notChar = lift . notChar   {-# INLINE notChar #-}   anyChar = lift anyChar   {-# INLINE anyChar #-}-  string  = lift . string+  string = lift . string   {-# INLINE string #-}   text = lift . text   {-# INLINE text #-}@@ -208,13 +211,13 @@ instance (CharParsing m, MonadPlus m) => CharParsing (Strict.StateT s m) where   satisfy = lift . satisfy   {-# INLINE satisfy #-}-  char    = lift . char+  char = lift . char   {-# INLINE char #-}   notChar = lift . notChar   {-# INLINE notChar #-}   anyChar = lift anyChar   {-# INLINE anyChar #-}-  string  = lift . string+  string = lift . string   {-# INLINE string #-}   text = lift . text   {-# INLINE text #-}@@ -222,13 +225,13 @@ instance (CharParsing m, MonadPlus m) => CharParsing (ReaderT e m) where   satisfy = lift . satisfy   {-# INLINE satisfy #-}-  char    = lift . char+  char = lift . char   {-# INLINE char #-}   notChar = lift . notChar   {-# INLINE notChar #-}   anyChar = lift anyChar   {-# INLINE anyChar #-}-  string  = lift . string+  string = lift . string   {-# INLINE string #-}   text = lift . text   {-# INLINE text #-}@@ -236,13 +239,13 @@ instance (CharParsing m, MonadPlus m, Monoid w) => CharParsing (Strict.WriterT w m) where   satisfy = lift . satisfy   {-# INLINE satisfy #-}-  char    = lift . char+  char = lift . char   {-# INLINE char #-}   notChar = lift . notChar   {-# INLINE notChar #-}   anyChar = lift anyChar   {-# INLINE anyChar #-}-  string  = lift . string+  string = lift . string   {-# INLINE string #-}   text = lift . text   {-# INLINE text #-}@@ -250,13 +253,13 @@ instance (CharParsing m, MonadPlus m, Monoid w) => CharParsing (Lazy.WriterT w m) where   satisfy = lift . satisfy   {-# INLINE satisfy #-}-  char    = lift . char+  char = lift . char   {-# INLINE char #-}   notChar = lift . notChar   {-# INLINE notChar #-}   anyChar = lift anyChar   {-# INLINE anyChar #-}-  string  = lift . string+  string = lift . string   {-# INLINE string #-}   text = lift . text   {-# INLINE text #-}@@ -264,13 +267,13 @@ instance (CharParsing m, MonadPlus m, Monoid w) => CharParsing (Lazy.RWST r w s m) where   satisfy = lift . satisfy   {-# INLINE satisfy #-}-  char    = lift . char+  char = lift . char   {-# INLINE char #-}   notChar = lift . notChar   {-# INLINE notChar #-}   anyChar = lift anyChar   {-# INLINE anyChar #-}-  string  = lift . string+  string = lift . string   {-# INLINE string #-}   text = lift . text   {-# INLINE text #-}@@ -278,13 +281,13 @@ instance (CharParsing m, MonadPlus m, Monoid w) => CharParsing (Strict.RWST r w s m) where   satisfy = lift . satisfy   {-# INLINE satisfy #-}-  char    = lift . char+  char = lift . char   {-# INLINE char #-}   notChar = lift . notChar   {-# INLINE notChar #-}   anyChar = lift anyChar   {-# INLINE anyChar #-}-  string  = lift . string+  string = lift . string   {-# INLINE string #-}   text = lift . text   {-# INLINE text #-}@@ -292,23 +295,23 @@ instance (CharParsing m, MonadPlus m) => CharParsing (IdentityT m) where   satisfy = lift . satisfy   {-# INLINE satisfy #-}-  char    = lift . char+  char = lift . char   {-# INLINE char #-}   notChar = lift . notChar   {-# INLINE notChar #-}   anyChar = lift anyChar   {-# INLINE anyChar #-}-  string  = lift . string+  string = lift . string   {-# INLINE string #-}   text = lift . text   {-# INLINE text #-}  instance Parsec.Stream s m Char => CharParsing (Parsec.ParsecT s u m) where-  satisfy   = Parsec.satisfy-  char      = Parsec.char+  satisfy = Parsec.satisfy+  char = Parsec.char   notChar c = Parsec.satisfy (/= c)-  anyChar   = Parsec.anyChar-  string    = Parsec.string+  anyChar = Parsec.anyChar+  string = Parsec.string  ------------------------------------------------------------------------------- -- Our additions@@ -329,7 +332,7 @@     f '7' = 7     f '8' = 8     f '9' = 9-    f _   = error "panic! integral"+    f _ = error "panic! integral" {-# INLINE integral #-}  -- | Accepts negative (starting with @-@) and positive (without sign) integral

@@ -1,4 +1,5 @@ -----------------------------------------------------------------------------+ -- | -- Module      :  Distribution.Compat.DList -- Copyright   :  (c) Ben Gamari 2015-2019@@ -9,18 +10,18 @@ -- Portability :  portable -- -- A very simple difference list.-module Distribution.Compat.DList (-    DList,-    runDList,-    empty,-    singleton,-    fromList,-    toList,-    snoc,-) where+module Distribution.Compat.DList+  ( DList+  , runDList+  , empty+  , singleton+  , fromList+  , toList+  , snoc+  ) where +import Distribution.Compat.Prelude hiding (empty, toList) import Prelude ()-import Distribution.Compat.Prelude hiding (toList, empty)  -- | Difference list. newtype DList a = DList ([a] -> [a])@@ -30,7 +31,7 @@  -- | Make 'DList' containing single element. singleton :: a -> DList a-singleton a = DList (a:)+singleton a = DList (a :)  -- | @since 3.4.0.0 empty :: DList a@@ -46,7 +47,7 @@ snoc xs x = xs <> singleton x  instance Monoid (DList a) where-  mempty  = empty+  mempty = empty   mappend = (<>)  instance Semigroup (DList a) where

@@ -1,14 +1,15 @@ {-# LANGUAGE CPP #-}-module Distribution.Compat.Exception (-  catchIO,-  catchExit,-  tryIO,-  displayException,++module Distribution.Compat.Exception+  ( catchIO+  , catchExit+  , tryIO+  , displayException   ) where -import System.Exit-import qualified Control.Exception as Exception import Control.Exception (displayException)+import qualified Control.Exception as Exception+import System.Exit  -- | Try 'IOException'. tryIO :: IO a -> IO (Either Exception.IOException a)

@@ -1,12 +1,16 @@-{-# LANGUAGE BangPatterns         #-}-{-# LANGUAGE CPP                  #-}-{-# LANGUAGE DeriveDataTypeable   #-}-{-# LANGUAGE FlexibleContexts     #-}-{-# LANGUAGE ScopedTypeVariables  #-}-{-# LANGUAGE TypeFamilies         #-}-{-# LANGUAGE TypeOperators        #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-}+ -----------------------------------------------------------------------------++-----------------------------------------------------------------------------+ -- | -- Module      :  Distribution.Compat.Graph -- Copyright   :  (c) Edward Z. Yang 2016@@ -38,81 +42,87 @@ -- vertices of a graph using 'broken' (and should, e.g., to ensure that -- a closure of a graph is well-formed.)  It's possible to take a closed -- subset of a broken graph and get a well-formed graph.---------------------------------------------------------------------------------+module Distribution.Compat.Graph+  ( -- * Graph type+    Graph+  , IsNode (..) -module Distribution.Compat.Graph (-    -- * Graph type-    Graph,-    IsNode(..),     -- * Query-    null,-    size,-    member,-    lookup,+  , null+  , size+  , member+  , lookup+     -- * Construction-    empty,-    insert,-    deleteKey,-    deleteLookup,+  , empty+  , insert+  , deleteKey+  , deleteLookup+     -- * Combine-    unionLeft,-    unionRight,+  , unionLeft+  , unionRight+     -- * Graph algorithms-    stronglyConnComp,-    SCC(..),-    cycles,-    broken,-    neighbors,-    revNeighbors,-    closure,-    revClosure,-    topSort,-    revTopSort,+  , stronglyConnComp+  , SCC (..)+  , cycles+  , broken+  , neighbors+  , revNeighbors+  , closure+  , revClosure+  , topSort+  , revTopSort+     -- * Conversions+     -- ** Maps-    toMap,+  , toMap+     -- ** Lists-    fromDistinctList,-    toList,-    keys,+  , fromDistinctList+  , toList+  , keys+     -- ** Sets-    keysSet,+  , keysSet+     -- ** Graphs-    toGraph,+  , toGraph+     -- * Node type-    Node(..),-    nodeValue,-) where+  , Node (..)+  , nodeValue+  ) where  import Distribution.Compat.Prelude hiding (empty, lookup, null, toList) import Prelude () -import Data.Array                    ((!))-import Data.Graph                    (SCC (..))+import Data.Array ((!))+import Data.Graph (SCC (..)) import Distribution.Utils.Structured (Structure (..), Structured (..)) -import qualified Data.Array                  as Array-import qualified Data.Foldable               as Foldable-import qualified Data.Graph                  as G-import qualified Data.Map.Strict             as Map-import qualified Data.Set                    as Set-import qualified Data.Tree                   as Tree+import qualified Data.Array as Array+import qualified Data.Foldable as Foldable+import qualified Data.Graph as G+import qualified Data.Map.Strict as Map+import qualified Data.Set as Set+import qualified Data.Tree as Tree import qualified Distribution.Compat.Prelude as Prelude  -- | A graph of nodes @a@.  The nodes are expected to have instance -- of class 'IsNode'.-data Graph a-    = Graph {-        graphMap          :: !(Map (Key a) a),-        -- Lazily cached graph representation-        graphForward      :: G.Graph,-        graphAdjoint      :: G.Graph,-        graphVertexToNode :: G.Vertex -> a,-        graphKeyToVertex  :: Key a -> Maybe G.Vertex,-        graphBroken       :: [(a, [Key a])]-    }-    deriving (Typeable)+data Graph a = Graph+  { graphMap :: !(Map (Key a) a)+  , -- Lazily cached graph representation+    graphForward :: G.Graph+  , graphAdjoint :: G.Graph+  , graphVertexToNode :: G.Vertex -> a+  , graphKeyToVertex :: Key a -> Maybe G.Vertex+  , graphBroken :: [(a, [Key a])]+  }+  deriving (Typeable)  -- NB: Not a Functor! (or Traversable), because you need -- to restrict Key a ~ Key b.  We provide our own mapping@@ -122,50 +132,51 @@ -- Map representation.  instance Show a => Show (Graph a) where-    show = show . toList+  show = show . toList  instance (IsNode a, Read a, Show (Key a)) => Read (Graph a) where-    readsPrec d s = map (\(a,r) -> (fromDistinctList a, r)) (readsPrec d s)+  readsPrec d s = map (\(a, r) -> (fromDistinctList a, r)) (readsPrec d s)  instance (IsNode a, Binary a, Show (Key a)) => Binary (Graph a) where-    put x = put (toList x)-    get = fmap fromDistinctList get+  put x = put (toList x)+  get = fmap fromDistinctList get  instance Structured a => Structured (Graph a) where-    structure p = Nominal (typeRep p) 0 "Graph" [structure (Proxy :: Proxy a)]+  structure p = Nominal (typeRep p) 0 "Graph" [structure (Proxy :: Proxy a)]  instance (Eq (Key a), Eq a) => Eq (Graph a) where-    g1 == g2 = graphMap g1 == graphMap g2+  g1 == g2 = graphMap g1 == graphMap g2  instance Foldable.Foldable Graph where-    fold = Foldable.fold . graphMap-    foldr f z = Foldable.foldr f z . graphMap-    foldl f z = Foldable.foldl f z . graphMap-    foldMap f = Foldable.foldMap f . graphMap-    foldl' f z = Foldable.foldl' f z . graphMap-    foldr' f z = Foldable.foldr' f z . graphMap+  fold = Foldable.fold . graphMap+  foldr f z = Foldable.foldr f z . graphMap+  foldl f z = Foldable.foldl f z . graphMap+  foldMap f = Foldable.foldMap f . graphMap+  foldl' f z = Foldable.foldl' f z . graphMap+  foldr' f z = Foldable.foldr' f z . graphMap #ifdef MIN_VERSION_base #if MIN_VERSION_base(4,8,0)-    length = Foldable.length . graphMap-    null   = Foldable.null   . graphMap-    toList = Foldable.toList . graphMap-    elem x = Foldable.elem x . graphMap-    maximum = Foldable.maximum . graphMap-    minimum = Foldable.minimum . graphMap-    sum     = Foldable.sum     . graphMap-    product = Foldable.product . graphMap+  length = Foldable.length . graphMap+  null   = Foldable.null   . graphMap+  toList = Foldable.toList . graphMap+  elem x = Foldable.elem x . graphMap+  maximum = Foldable.maximum . graphMap+  minimum = Foldable.minimum . graphMap+  sum     = Foldable.sum     . graphMap+  product = Foldable.product . graphMap #endif #endif  instance (NFData a, NFData (Key a)) => NFData (Graph a) where-    rnf Graph {-        graphMap = m,-        graphForward = gf,-        graphAdjoint = ga,-        graphVertexToNode = vtn,-        graphKeyToVertex = ktv,-        graphBroken = b-    } = gf `seq` ga `seq` vtn `seq` ktv `seq` b `seq` rnf m+  rnf+    Graph+      { graphMap = m+      , graphForward = gf+      , graphAdjoint = ga+      , graphVertexToNode = vtn+      , graphKeyToVertex = ktv+      , graphBroken = b+      } = gf `seq` ga `seq` vtn `seq` ktv `seq` b `seq` rnf m  -- TODO: Data instance? @@ -174,32 +185,32 @@ -- type @'Key' a@; given a node we can determine its key ('nodeKey') -- and the keys of its neighbors ('nodeNeighbors'). class Ord (Key a) => IsNode a where-    type Key a-    nodeKey :: a -> Key a-    nodeNeighbors :: a -> [Key a]+  type Key a+  nodeKey :: a -> Key a+  nodeNeighbors :: a -> [Key a]  instance (IsNode a, IsNode b, Key a ~ Key b) => IsNode (Either a b) where-    type Key (Either a b) = Key a-    nodeKey (Left x)  = nodeKey x-    nodeKey (Right x) = nodeKey x-    nodeNeighbors (Left x)  = nodeNeighbors x-    nodeNeighbors (Right x) = nodeNeighbors x+  type Key (Either a b) = Key a+  nodeKey (Left x) = nodeKey x+  nodeKey (Right x) = nodeKey x+  nodeNeighbors (Left x) = nodeNeighbors x+  nodeNeighbors (Right x) = nodeNeighbors x  -- | A simple, trivial data type which admits an 'IsNode' instance. data Node k a = N a k [k]-    deriving (Show, Eq)+  deriving (Show, Eq)  -- | Get the value from a 'Node'. nodeValue :: Node k a -> a nodeValue (N a _ _) = a  instance Functor (Node k) where-    fmap f (N a k ks) = N (f a) k ks+  fmap f (N a k ks) = N (f a) k ks  instance Ord k => IsNode (Node k a) where-    type Key (Node k a) = k-    nodeKey (N _ k _) = k-    nodeNeighbors (N _ _ ks) = ks+  type Key (Node k a) = k+  nodeKey (N _ k _) = k+  nodeNeighbors (N _ _ ks) = ks  -- TODO: Maybe introduce a typeclass for items which just -- keys (so, Key associated type, and nodeKey method).  But@@ -241,8 +252,8 @@ -- value if it existed. deleteLookup :: IsNode a => Key a -> Graph a -> (Maybe a, Graph a) deleteLookup k g =-    let (r, m') = Map.updateLookupWithKey (\_ _ -> Nothing) k (toMap g)-    in (r, fromMap m')+  let (r, m') = Map.updateLookupWithKey (\_ _ -> Nothing) k (toMap g)+   in (r, fromMap m')  -- Combining @@ -266,18 +277,20 @@   where     forest = G.scc (graphForward g)     decode (Tree.Node v [])-        | mentions_itself v = CyclicSCC  [graphVertexToNode g v]-        | otherwise         = AcyclicSCC (graphVertexToNode g v)+      | mentions_itself v = CyclicSCC [graphVertexToNode g v]+      | otherwise = AcyclicSCC (graphVertexToNode g v)     decode other = CyclicSCC (dec other [])-        where dec (Tree.Node v ts) vs-                = graphVertexToNode g v : foldr dec vs ts+      where+        dec (Tree.Node v ts) vs =+          graphVertexToNode g v : foldr dec vs ts     mentions_itself v = v `elem` (graphForward g ! v)+ -- Implementation copied from 'stronglyConnCompR' in 'Data.Graph'.  -- | /Ω(V + E)/. Compute the cycles of a graph. -- Requires amortized construction of graph. cycles :: Graph a -> [[a]]-cycles g = [ vs | CyclicSCC vs <- stronglyConnComp g ]+cycles g = [vs | CyclicSCC vs <- stronglyConnComp g]  -- | /O(1)/.  Return a list of nodes paired with their broken -- neighbors (i.e., neighbor keys which are not in the graph).@@ -289,15 +302,15 @@ -- Requires amortized construction of graph. neighbors :: Graph a -> Key a -> Maybe [a] neighbors g k = do-    v <- graphKeyToVertex g k-    return (map (graphVertexToNode g) (graphForward g ! v))+  v <- graphKeyToVertex g k+  return (map (graphVertexToNode g) (graphForward g ! v))  -- | Lookup the immediate reverse neighbors from a key in the graph. -- Requires amortized construction of graph. revNeighbors :: Graph a -> Key a -> Maybe [a] revNeighbors g k = do-    v <- graphKeyToVertex g k-    return (map (graphVertexToNode g) (graphAdjoint g ! v))+  v <- graphKeyToVertex g k+  return (map (graphVertexToNode g) (graphAdjoint g ! v))  -- | Compute the subgraph which is the closure of some set of keys. -- Returns @Nothing@ if one (or more) keys are not present in@@ -305,8 +318,8 @@ -- Requires amortized construction of graph. closure :: Graph a -> [Key a] -> Maybe [a] closure g ks = do-    vs <- traverse (graphKeyToVertex g) ks-    return (decodeVertexForest g (G.dfs (graphForward g) vs))+  vs <- traverse (graphKeyToVertex g) ks+  return (decodeVertexForest g (G.dfs (graphForward g) vs))  -- | Compute the reverse closure of a graph from some set -- of keys.  Returns @Nothing@ if one (or more) keys are not present in@@ -314,8 +327,8 @@ -- Requires amortized construction of graph. revClosure :: Graph a -> [Key a] -> Maybe [a] revClosure g ks = do-    vs <- traverse (graphKeyToVertex g) ks-    return (decodeVertexForest g (G.dfs (graphAdjoint g) vs))+  vs <- traverse (graphKeyToVertex g) ks+  return (decodeVertexForest g (G.dfs (graphAdjoint g) vs))  flattenForest :: Tree.Forest a -> [a] flattenForest = concatMap Tree.flatten@@ -342,44 +355,49 @@ -- instead.  The values of the map are assumed to already -- be in WHNF. fromMap :: IsNode a => Map (Key a) a -> Graph a-fromMap m-    = Graph { graphMap = m-            -- These are lazily computed!-            , graphForward = g-            , graphAdjoint = G.transposeG g-            , graphVertexToNode = vertex_to_node-            , graphKeyToVertex = key_to_vertex-            , graphBroken = broke-            }+fromMap m =+  Graph+    { graphMap = m+    , -- These are lazily computed!+      graphForward = g+    , graphAdjoint = G.transposeG g+    , graphVertexToNode = vertex_to_node+    , graphKeyToVertex = key_to_vertex+    , graphBroken = broke+    }   where     try_key_to_vertex k = maybe (Left k) Right (key_to_vertex k) -    (brokenEdges, edges)-        = unzip-        $ [ partitionEithers (map try_key_to_vertex (nodeNeighbors n))-          | n <- ns ]+    (brokenEdges, edges) =+      unzip $+        [ partitionEithers (map try_key_to_vertex (nodeNeighbors n))+        | n <- ns+        ]     broke = filter (not . Prelude.null . snd) (zip ns brokenEdges)      g = Array.listArray bounds edges -    ns              = Map.elems m -- sorted ascending-    vertices        = zip (map nodeKey ns) [0..]-    vertex_map      = Map.fromAscList vertices+    ns = Map.elems m -- sorted ascending+    vertices = zip (map nodeKey ns) [0 ..]+    vertex_map = Map.fromAscList vertices     key_to_vertex k = Map.lookup k vertex_map      vertex_to_node vertex = nodeTable ! vertex -    nodeTable   = Array.listArray bounds ns+    nodeTable = Array.listArray bounds ns     bounds = (0, Map.size m - 1)  -- | /O(V log V)/. Convert a list of nodes (with distinct keys) into a graph. fromDistinctList :: (IsNode a, Show (Key a)) => [a] -> Graph a-fromDistinctList = fromMap-                 . Map.fromListWith (\_ -> duplicateError)-                 . map (\n -> n `seq` (nodeKey n, n))+fromDistinctList =+  fromMap+    . Map.fromListWith (\_ -> duplicateError)+    . map (\n -> n `seq` (nodeKey n, n))   where-    duplicateError n = error $ "Graph.fromDistinctList: duplicate key: "-                            ++ show (nodeKey n)+    duplicateError n =+      error $+        "Graph.fromDistinctList: duplicate key: "+          ++ show (nodeKey n)  -- Map-like operations 

@@ -1,78 +1,95 @@ {-# LANGUAGE RankNTypes #-}+ -- | This module provides very basic lens functionality, without extra dependencies. -- -- For the documentation of the combinators see <http://hackage.haskell.org/package/lens lens> package. -- This module uses the same vocabulary.-module Distribution.Compat.Lens (-    -- * Types-    Lens,-    Lens',-    Traversal,-    Traversal',+module Distribution.Compat.Lens+  ( -- * Types+    Lens+  , Lens'+  , Traversal+  , Traversal'+     -- ** LensLike-    LensLike,-    LensLike',+  , LensLike+  , LensLike'+     -- ** rank-1 types-    Getting,-    AGetter,-    ASetter,-    ALens,-    ALens',+  , Getting+  , AGetter+  , ASetter+  , ALens+  , ALens'+     -- * Getter-    view,-    use,-    getting,+  , view+  , use+  , getting+     -- * Setter-    set,-    over,+  , set+  , over+     -- * Fold-    toDListOf,-    toListOf,-    toSetOf,+  , toDListOf+  , toListOf+  , toSetOf+     -- * Lens-    cloneLens,-    aview,+  , cloneLens+  , aview+     -- * Common lenses-    _1, _2,+  , _1+  , _2+     -- * Operators-    (&),-    (^.),-    (.~), (?~), (%~),-    (.=), (?=), (%=),-    (^#),-    (#~), (#%~),+  , (&)+  , (^.)+  , (.~)+  , (?~)+  , (%~)+  , (.=)+  , (?=)+  , (%=)+  , (^#)+  , (#~)+  , (#%~)+     -- * Internal Comonads-    Pretext (..),+  , Pretext (..)+     -- * Cabal developer info     -- $development-    ) where+  ) where -import Prelude() import Distribution.Compat.Prelude+import Prelude ()  import Control.Monad.State.Class (MonadState (..), gets, modify) -import qualified Distribution.Compat.DList as DList import qualified Data.Set as Set+import qualified Distribution.Compat.DList as DList  ------------------------------------------------------------------------------- -- Types ------------------------------------------------------------------------------- -type LensLike  f s t a b = (a -> f b) -> s -> f t-type LensLike' f s   a   = (a -> f a) -> s -> f s+type LensLike f s t a b = (a -> f b) -> s -> f t+type LensLike' f s a = (a -> f a) -> s -> f s -type Lens      s t a b = forall f. Functor f     => LensLike f s t a b+type Lens s t a b = forall f. Functor f => LensLike f s t a b type Traversal s t a b = forall f. Applicative f => LensLike f s t a b -type Lens'      s a = Lens s s a a+type Lens' s a = Lens s s a a type Traversal' s a = Traversal s s a a  type Getting r s a = LensLike (Const r) s s a a -type AGetter s   a   = LensLike (Const a)     s s a a  -- this doesn't exist in 'lens'-type ASetter s t a b = LensLike Identity      s t a b-type ALens   s t a b = LensLike (Pretext a b) s t a b+type AGetter s a = LensLike (Const a) s s a a -- this doesn't exist in 'lens'+type ASetter s t a b = LensLike Identity s t a b+type ALens s t a b = LensLike (Pretext a b) s t a b  type ALens' s a = ALens s s a a @@ -80,7 +97,7 @@ -- Getter ------------------------------------------------------------------------------- -view :: Getting a s a -> s ->  a+view :: Getting a s a -> s -> a view l s = getConst (l Const s) {-# INLINE view #-} @@ -100,7 +117,7 @@ -- Setter ------------------------------------------------------------------------------- -set :: ASetter s t a  b -> b -> s -> t+set :: ASetter s t a b -> b -> s -> t set l x = over l (const x)  over :: ASetter s t a b -> (a -> b) -> s -> t@@ -116,7 +133,7 @@ toListOf :: Getting (DList.DList a) s a -> s -> [a] toListOf l = DList.runDList . toDListOf l -toSetOf  :: Getting (Set.Set a) s a -> s -> Set.Set a+toSetOf :: Getting (Set.Set a) s a -> s -> Set.Set a toSetOf l s = getConst (l (\x -> Const (Set.singleton x)) s)  -------------------------------------------------------------------------------@@ -124,7 +141,7 @@ -------------------------------------------------------------------------------  aview :: ALens s t a b -> s -> a-aview l = pretextPos  . l pretextSell+aview l = pretextPos . l pretextSell {-# INLINE aview #-}  {-@@ -136,10 +153,10 @@ -- Common ------------------------------------------------------------------------------- -_1 ::  Lens (a, c) (b, c) a b+_1 :: Lens (a, c) (b, c) a b _1 f (a, c) = flip (,) c <$> f a -_2 ::  Lens (c, a) (c, b) a b+_2 :: Lens (c, a) (c, b) a b _2 f (c, a) = (,) c <$> f a  -------------------------------------------------------------------------------@@ -150,6 +167,7 @@ (&) :: a -> (a -> b) -> b (&) = flip ($) {-# INLINE (&) #-}+ infixl 1 &  infixl 8 ^., ^#@@ -221,10 +239,10 @@ -------------------------------------------------------------------------------  -- | @lens@ variant is also parametrised by profunctor.-data Pretext a b t = Pretext { runPretext :: forall f. Functor f => (a -> f b) -> f t }+data Pretext a b t = Pretext {runPretext :: forall f. Functor f => (a -> f b) -> f t}  instance Functor (Pretext a b) where-    fmap f (Pretext pretext) = Pretext (\afb -> fmap f (pretext afb))+  fmap f (Pretext pretext) = Pretext (\afb -> fmap f (pretext afb))  ------------------------------------------------------------------------------- -- Documentation

@@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-}  -- | Compatibility layer for "Control.Monad.Fail"-module Distribution.Compat.MonadFail ( Control.Monad.Fail.MonadFail(fail) ) where+module Distribution.Compat.MonadFail (Control.Monad.Fail.MonadFail (fail)) where+ import Control.Monad.Fail

@@ -1,20 +1,21 @@-{-# LANGUAGE CPP                    #-}-{-# LANGUAGE DefaultSignatures      #-}-{-# LANGUAGE FlexibleInstances      #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-}+ -- | Per Conor McBride, the 'Newtype' typeclass represents the packing and -- unpacking of a newtype, and allows you to operate under that newtype with -- functions such as 'ala'.-module Distribution.Compat.Newtype (-    Newtype (..),-    ala,-    alaf,-    pack',-    unpack',-    ) where+module Distribution.Compat.Newtype+  ( Newtype (..)+  , ala+  , alaf+  , pack'+  , unpack'+  ) where  import Data.Functor.Identity (Identity (..))-import Data.Monoid (Sum (..), Product (..), Endo (..))+import Data.Monoid (Endo (..), Product (..), Sum (..))  #if MIN_VERSION_base(4,7,0) import Data.Coerce (coerce, Coercible)@@ -36,25 +37,26 @@ -- Another approach would be to use @TypeFamilies@ (and possibly -- compute inner type using "GHC.Generics"), but we think @FunctionalDependencies@ -- version gives cleaner type signatures.---+{- FOURMOLU_DISABLE -} class Newtype o n | n -> o where-    pack   :: o -> n+  pack :: o -> n #if MIN_VERSION_base(4,7,0)-    default pack :: Coercible o n => o -> n-    pack = coerce+  default pack :: Coercible o n => o -> n+  pack = coerce #else-    default pack :: o -> n-    pack = unsafeCoerce+  default pack :: o -> n+  pack = unsafeCoerce #endif -    unpack :: n -> o+  unpack :: n -> o #if MIN_VERSION_base(4,7,0)-    default unpack :: Coercible n o => n -> o-    unpack = coerce+  default unpack :: Coercible n o => n -> o+  unpack = coerce #else-    default unpack :: n -> o-    unpack = unsafeCoerce+  default unpack :: n -> o+  unpack = unsafeCoerce #endif+{- FOURMOLU_ENABLE -}  instance Newtype a (Identity a) instance Newtype a (Sum a)

@@ -1,36 +1,43 @@-{-# LANGUAGE CPP                #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-}-module Distribution.Compat.NonEmptySet (-    NonEmptySet,++module Distribution.Compat.NonEmptySet+  ( NonEmptySet+     -- * Construction-    singleton,+  , singleton+     -- * Insertion-    insert,+  , insert+     -- * Deletion-    delete,+  , delete+     -- * Conversions-    toNonEmpty,-    fromNonEmpty,-    toList,-    toSet,+  , toNonEmpty+  , fromNonEmpty+  , toList+  , toSet+     -- * Query-    member,+  , member+     -- * Map-    map,-) where+  , map+  ) where  import Prelude (Bool (..), Eq, Maybe (..), Ord (..), Read, Show (..), String, error, otherwise, return, showParen, showString, ($), (++), (.)) -import Control.DeepSeq    (NFData (..))-import Data.Data          (Data)+import Control.DeepSeq (NFData (..))+import Data.Data (Data) import Data.List.NonEmpty (NonEmpty (..))-import Data.Semigroup     (Semigroup (..))-import Data.Typeable      (Typeable)+import Data.Semigroup (Semigroup (..))+import Data.Typeable (Typeable)  import qualified Data.Foldable as F-import qualified Data.Set      as Set+import qualified Data.Set as Set -import Distribution.Compat.Binary    (Binary (..))+import Distribution.Compat.Binary (Binary (..)) import Distribution.Utils.Structured  #if MIN_VERSION_binary(0,6,0)@@ -48,40 +55,43 @@ -------------------------------------------------------------------------------  instance Show a => Show (NonEmptySet a) where-    showsPrec d s = showParen (d > 10)-        $ showString "fromNonEmpty "+  showsPrec d s =+    showParen (d > 10) $+      showString "fromNonEmpty "         . showsPrec 11 (toNonEmpty s) +{- FOURMOLU_DISABLE -} instance Binary a => Binary (NonEmptySet a) where-    put (NES s) = put s-    get = do-        xs <- get-        if Set.null xs+  put (NES s) = put s+  get = do+      xs <- get+      if Set.null xs #if MIN_VERSION_binary(0,6,0)-        then empty+      then empty #else-        then fail "NonEmptySet: empty"+      then fail "NonEmptySet: empty" #endif-        else return (NES xs)+      else return (NES xs)+{- FOURMOLU_ENABLE -}  instance Structured a => Structured (NonEmptySet a) where-    structure = containerStructure+  structure = containerStructure  instance NFData a => NFData (NonEmptySet a) where-    rnf (NES x) = rnf x+  rnf (NES x) = rnf x  -- | Note: there aren't @Monoid@ instance. instance Ord a => Semigroup (NonEmptySet a) where-    NES x <> NES y = NES (Set.union x y)+  NES x <> NES y = NES (Set.union x y)  instance F.Foldable NonEmptySet where-    foldMap f (NES s) = F.foldMap f s-    foldr f z (NES s) = F.foldr f z s+  foldMap f (NES s) = F.foldMap f s+  foldr f z (NES s) = F.foldr f z s  #if MIN_VERSION_base(4,8,0)-    toList         = toList-    null _         = False-    length (NES s) = F.length s+  toList         = toList+  null _         = False+  length (NES s) = F.length s #endif  -------------------------------------------------------------------------------@@ -104,8 +114,8 @@  delete :: Ord a => a -> NonEmptySet a -> Maybe (NonEmptySet a) delete x (NES xs)-    | Set.null res = Nothing-    | otherwise    = Just (NES xs)+  | Set.null res = Nothing+  | otherwise = Just (NES xs)   where     res = Set.delete x xs @@ -118,8 +128,8 @@  toNonEmpty :: NonEmptySet a -> NonEmpty a toNonEmpty (NES s) = case Set.toList s of-    []   -> panic "toNonEmpty"-    x:xs -> x :| xs+  [] -> panic "toNonEmpty"+  x : xs -> x :| xs  toList :: NonEmptySet a -> [a] toList (NES s) = Set.toList s@@ -138,6 +148,7 @@ -- Map ------------------------------------------------------------------------------- +{- FOURMOLU_DISABLE -} map     :: ( Ord b #if !MIN_VERSION_containers(0,5,2)@@ -146,6 +157,7 @@        )     => (a -> b) -> NonEmptySet a -> NonEmptySet b map f (NES x) = NES (Set.map f x)+{- FOURMOLU_ENABLE -}  ------------------------------------------------------------------------------- -- Internal

@@ -1,5 +1,10 @@-{-# LANGUAGE GADTs, UndecidableInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE UndecidableInstances #-}+ -----------------------------------------------------------------------------++-----------------------------------------------------------------------------+ -- | -- Module      :  Distribution.Compat.Parsing -- Copyright   :  (c) Edward Kmett 2011-2012@@ -12,18 +17,15 @@ -- Alternative parser combinators. -- -- Originally in @parsers@ package.--------------------------------------------------------------------------------- module Distribution.Compat.Parsing-  (-  -- * Parsing Combinators+  ( -- * Parsing Combinators     choice   , option   , optional -- from Control.Applicative, parsec optionMaybe   , skipOptional -- parsec optional   , between-  , some     -- from Control.Applicative, parsec many1-  , many     -- from Control.Applicative+  , some -- from Control.Applicative, parsec many1+  , many -- from Control.Applicative   , sepBy   , sepByNonEmpty   , sepEndByNonEmpty@@ -36,23 +38,24 @@   , chainl1   , chainr1   , manyTill-  -- * Parsing Class-  , Parsing(..)++    -- * Parsing Class+  , Parsing (..)   ) where -import Prelude () import Distribution.Compat.Prelude+import Prelude () -import Control.Applicative ((<**>), optional)+import Control.Applicative (optional, (<**>)) import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.Identity (IdentityT (..))+import Control.Monad.Trans.RWS.Lazy as Lazy+import Control.Monad.Trans.RWS.Strict as Strict+import Control.Monad.Trans.Reader (ReaderT (..)) import Control.Monad.Trans.State.Lazy as Lazy import Control.Monad.Trans.State.Strict as Strict import Control.Monad.Trans.Writer.Lazy as Lazy import Control.Monad.Trans.Writer.Strict as Strict-import Control.Monad.Trans.RWS.Lazy as Lazy-import Control.Monad.Trans.RWS.Strict as Strict-import Control.Monad.Trans.Reader (ReaderT (..))-import Control.Monad.Trans.Identity (IdentityT (..)) import Data.Foldable (asum)  import qualified Data.List.NonEmpty as NE@@ -136,8 +139,9 @@ -- equal to zero, the parser equals to @return []@. Returns a list of -- @n@ values returned by @p@. count :: Applicative m => Int -> m a -> m [a]-count n p | n <= 0    = pure []-          | otherwise = sequenceA (replicate n p)+count n p+  | n <= 0 = pure []+  | otherwise = sequenceA (replicate n p) {-# INLINE count #-}  -- | @chainr p op x@ parses /zero/ or more occurrences of @p@,@@ -174,9 +178,10 @@ -- >  addop  = (+) <$ symbol "+" -- >       <|> (-) <$ symbol "-" chainl1 :: Alternative m => m a -> m (a -> a -> a) -> m a-chainl1 p op = scan where-  scan = p <**> rst-  rst = (\f y g x -> g (f x y)) <$> op <*> p <*> rst <|> pure id+chainl1 p op = scan+  where+    scan = p <**> rst+    rst = (\f y g x -> g (f x y)) <$> op <*> p <*> rst <|> pure id {-# INLINE chainl1 #-}  -- | @chainr1 p op x@ parses /one/ or more occurrences of @p@,@@ -184,9 +189,10 @@ -- application of all functions returned by @op@ to the values returned -- by @p@. chainr1 :: Alternative m => m a -> m (a -> a -> a) -> m a-chainr1 p op = scan where-  scan = p <**> rst-  rst = (flip <$> op <*> scan) <|> pure id+chainr1 p op = scan+  where+    scan = p <**> rst+    rst = (flip <$> op <*> scan) <|> pure id {-# INLINE chainr1 #-}  -- | @manyTill p end@ applies parser @p@ /zero/ or more times until@@ -255,8 +261,8 @@   {-# INLINE unexpected #-}   eof = lift eof   {-# INLINE eof #-}-  notFollowedBy (Lazy.StateT m) = Lazy.StateT-    $ \s -> notFollowedBy (fst <$> m s) >> return ((),s)+  notFollowedBy (Lazy.StateT m) = Lazy.StateT $+    \s -> notFollowedBy (fst <$> m s) >> return ((), s)   {-# INLINE notFollowedBy #-}  instance (Parsing m, MonadPlus m) => Parsing (Strict.StateT s m) where@@ -268,8 +274,8 @@   {-# INLINE unexpected #-}   eof = lift eof   {-# INLINE eof #-}-  notFollowedBy (Strict.StateT m) = Strict.StateT-    $ \s -> notFollowedBy (fst <$> m s) >> return ((),s)+  notFollowedBy (Strict.StateT m) = Strict.StateT $+    \s -> notFollowedBy (fst <$> m s) >> return ((), s)   {-# INLINE notFollowedBy #-}  instance (Parsing m, MonadPlus m) => Parsing (ReaderT e m) where@@ -295,8 +301,9 @@   {-# INLINE unexpected #-}   eof = lift eof   {-# INLINE eof #-}-  notFollowedBy (Strict.WriterT m) = Strict.WriterT-    $ notFollowedBy (fst <$> m) >>= \x -> return (x, mempty)+  notFollowedBy (Strict.WriterT m) =+    Strict.WriterT $+      notFollowedBy (fst <$> m) >>= \x -> return (x, mempty)   {-# INLINE notFollowedBy #-}  instance (Parsing m, MonadPlus m, Monoid w) => Parsing (Lazy.WriterT w m) where@@ -308,8 +315,9 @@   {-# INLINE unexpected #-}   eof = lift eof   {-# INLINE eof #-}-  notFollowedBy (Lazy.WriterT m) = Lazy.WriterT-    $ notFollowedBy (fst <$> m) >>= \x -> return (x, mempty)+  notFollowedBy (Lazy.WriterT m) =+    Lazy.WriterT $+      notFollowedBy (fst <$> m) >>= \x -> return (x, mempty)   {-# INLINE notFollowedBy #-}  instance (Parsing m, MonadPlus m, Monoid w) => Parsing (Lazy.RWST r w s m) where@@ -321,8 +329,8 @@   {-# INLINE unexpected #-}   eof = lift eof   {-# INLINE eof #-}-  notFollowedBy (Lazy.RWST m) = Lazy.RWST-    $ \r s -> notFollowedBy ((\(a,_,_) -> a) <$> m r s) >>= \x -> return (x, s, mempty)+  notFollowedBy (Lazy.RWST m) = Lazy.RWST $+    \r s -> notFollowedBy ((\(a, _, _) -> a) <$> m r s) >>= \x -> return (x, s, mempty)   {-# INLINE notFollowedBy #-}  instance (Parsing m, MonadPlus m, Monoid w) => Parsing (Strict.RWST r w s m) where@@ -334,8 +342,8 @@   {-# INLINE unexpected #-}   eof = lift eof   {-# INLINE eof #-}-  notFollowedBy (Strict.RWST m) = Strict.RWST-    $ \r s -> notFollowedBy ((\(a,_,_) -> a) <$> m r s) >>= \x -> return (x, s, mempty)+  notFollowedBy (Strict.RWST m) = Strict.RWST $+    \r s -> notFollowedBy ((\(a, _, _) -> a) <$> m r s) >>= \x -> return (x, s, mempty)   {-# INLINE notFollowedBy #-}  instance (Parsing m, Monad m) => Parsing (IdentityT m) where@@ -353,10 +361,10 @@   {-# INLINE notFollowedBy #-}  instance (Parsec.Stream s m t, Show t) => Parsing (Parsec.ParsecT s u m) where-  try           = Parsec.try-  (<?>)         = (Parsec.<?>)-  skipMany      = Parsec.skipMany-  skipSome      = Parsec.skipMany1-  unexpected    = Parsec.unexpected-  eof           = Parsec.eof+  try = Parsec.try+  (<?>) = (Parsec.<?>)+  skipMany = Parsec.skipMany+  skipSome = Parsec.skipMany1+  unexpected = Parsec.unexpected+  eof = Parsec.eof   notFollowedBy = Parsec.notFollowedBy

@@ -1,134 +1,195 @@-{-# LANGUAGE CPP              #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE RankNTypes       #-}-{-# LANGUAGE Trustworthy      #-}-{-# LANGUAGE TypeOperators    #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE TypeOperators #-} +{- FOURMOLU_DISABLE -} #ifdef MIN_VERSION_base #define MINVER_base_411 MIN_VERSION_base(4,11,0) #else #define MINVER_base_411 (__GLASGOW_HASKELL__ >= 804) #endif+{- FOURMOLU_ENABLE -}  -- | This module does two things: -- -- * Acts as a compatibility layer, like @base-compat@. -- -- * Provides commonly used imports.-module Distribution.Compat.Prelude (-    -- * Prelude-    ---    -- Prelude is re-exported, following is hidden:-    module BasePrelude,+module Distribution.Compat.Prelude+  ( -- * Prelude +  --+  -- Prelude is re-exported, following is hidden:+      module BasePrelude+     -- * Common type-classes-    Semigroup (..),-    gmappend, gmempty,-    Typeable, TypeRep, typeRep,-    Data,-    Generic,-    NFData (..), genericRnf,-    Binary (..),-    Structured,-    Alternative (..),-    MonadPlus (..),-    IsString (..),+  , Semigroup (..)+  , gmappend+  , gmempty+  , Typeable+  , TypeRep+  , typeRep+  , Data+  , Generic+  , NFData (..)+  , genericRnf+  , Binary (..)+  , Structured+  , Alternative (..)+  , MonadPlus (..)+  , IsString (..)      -- * Some types-    Map,-    Set,-    NonEmptySet,-    Identity (..),-    Proxy (..),-    Const (..),-    Void,+  , Map+  , Set+  , NonEmptySet+  , Identity (..)+  , Proxy (..)+  , Const (..)+  , Void      -- * Data.Either-    partitionEithers,+  , partitionEithers      -- * Data.Maybe-    catMaybes, mapMaybe,-    fromMaybe,-    maybeToList, listToMaybe,-    isNothing, isJust,+  , catMaybes+  , mapMaybe+  , fromMaybe+  , maybeToList+  , listToMaybe+  , isNothing+  , isJust      -- * Data.List-    unfoldr,-    isPrefixOf, isSuffixOf,-    intercalate, intersperse,-    sort, sortBy,-    nub, nubBy,-    partition,-    dropWhileEnd,+  , unfoldr+  , isPrefixOf+  , isSuffixOf+  , intercalate+  , intersperse+  , sort+  , sortBy+  , nub+  , nubBy+  , partition+  , dropWhileEnd      -- * Data.List.NonEmpty-    NonEmpty((:|)), nonEmpty, foldl1, foldr1,-    head, tail, last, init,+  , NonEmpty ((:|))+  , nonEmpty+  , foldl1+  , foldr1+  , head+  , tail+  , last+  , init      -- * Data.Foldable-    Foldable, foldMap, foldr,-    null, length,-    find, foldl',-    traverse_, for_,-    any, all,-    toList,+  , Foldable+  , foldMap+  , foldr+  , null+  , length+  , find+  , foldl'+  , traverse_+  , for_+  , any+  , all+  , toList      -- * Data.Traversable-    Traversable, traverse, sequenceA,-    for,+  , Traversable+  , traverse+  , sequenceA+  , for      -- * Data.Function-    on,+  , on      -- * Data.Ord-    comparing,+  , comparing      -- * Control.Arrow-    first,+  , first      -- * Control.Monad-    liftM, liftM2,-    unless, when,-    ap, void,-    foldM, filterM,-    join, guard,+  , liftM+  , liftM2+  , unless+  , when+  , ap+  , void+  , foldM+  , filterM+  , join+  , guard      -- * Control.Exception-    catch, throwIO, evaluate,-    Exception (..), IOException, SomeException (..),-    tryIO, catchIO, catchExit,+  , catch+  , throwIO+  , evaluate+  , Exception (..)+  , IOException+  , SomeException (..)+  , tryIO+  , catchIO+  , catchExit      -- * Control.DeepSeq-    deepseq, force,+  , deepseq+  , force      -- * Data.Char-    isSpace, isDigit, isUpper, isAlpha, isAlphaNum,-    chr, ord,-    toLower, toUpper,+  , isSpace+  , isDigit+  , isUpper+  , isAlpha+  , isAlphaNum+  , chr+  , ord+  , toLower+  , toUpper      -- * Data.Void-    absurd, vacuous,+  , absurd+  , vacuous      -- * Data.Word & Data.Int-    Word,-    Word8, Word16, Word32, Word64,-    Int8, Int16, Int32, Int64,+  , Word+  , Word8+  , Word16+  , Word32+  , Word64+  , Int8+  , Int16+  , Int32+  , Int64      -- * Text.PrettyPrint-    (<<>>), (Disp.<+>),+  , (<<>>)+  , (Disp.<+>)      -- * System.Exit-    ExitCode (..),-    exitWith, exitSuccess, exitFailure,+  , ExitCode (..)+  , exitWith+  , exitSuccess+  , exitFailure      -- * Text.Read-    readMaybe,+  , readMaybe      -- * Debug.Trace (as deprecated functions)-    trace, traceShow, traceShowId,-    ) where+  , trace+  , traceShow+  , traceShowId+  , traceM+  , traceShowM+  ) where  -- We also could hide few partial function+{- FOURMOLU_DISABLE -} import Prelude                       as BasePrelude hiding     ( mapM, mapM_, sequence, any, all, head, tail, last, init     -- partial functions@@ -143,58 +204,59 @@     , Traversable, traverse, sequenceA     , Foldable(..)     )-import Data.Foldable as BasePrelude (foldl, elem, sum, product, maximum, minimum)+{- FOURMOLU_ENABLE -}+import Data.Foldable as BasePrelude (elem, foldl, maximum, minimum, product, sum)  -- AMP import Data.Foldable-    ( Foldable(toList),-      length,-      null,-      Foldable(foldMap, foldr),-      all,-      any,-      find,-      foldl',-      for_,-      traverse_ )+  ( Foldable (foldMap, foldr, toList)+  , all+  , any+  , find+  , foldl'+  , for_+  , length+  , null+  , traverse_+  ) import Data.Traversable (Traversable (sequenceA, traverse), for)  import qualified Data.Foldable  -- Extra exports-import Control.Applicative           (Alternative (..), Const(..))-import Control.Arrow                 (first)-import Control.DeepSeq               (NFData (..), deepseq, force)-import Control.Exception             (Exception (..), IOException, SomeException (..), catch, evaluate, throwIO)-import Control.Monad                 (MonadPlus (..), ap, filterM, foldM, guard, join, liftM, liftM2, unless, void, when)-import Data.Char                     (chr, isAlpha, isAlphaNum, isDigit, isSpace, isUpper, ord, toLower, toUpper)-import Data.Data                     (Data)-import Data.Either                   (partitionEithers)-import Data.Function                 (on)-import Data.Functor.Identity         (Identity (..))-import Data.Int                      (Int16, Int32, Int64, Int8)-import Data.List                     (dropWhileEnd, intercalate, intersperse, isPrefixOf, isSuffixOf, nub, nubBy, partition, sort, sortBy, unfoldr)-import Data.List.NonEmpty            (NonEmpty ((:|)), nonEmpty, head, init, last, tail)-import Data.Map                      (Map)-import Data.Maybe                    (catMaybes, fromMaybe, isJust, isNothing, listToMaybe, mapMaybe, maybeToList)-import Data.Ord                      (comparing)-import Data.Proxy                    (Proxy (..))-import Data.Set                      (Set)-import Data.String                   (IsString (..))-import Data.Void                     (Void, absurd, vacuous)-import Data.Word                     (Word, Word16, Word32, Word64, Word8)-import Distribution.Compat.Binary    (Binary (..))+import Control.Applicative (Alternative (..), Const (..))+import Control.Arrow (first)+import Control.DeepSeq (NFData (..), deepseq, force)+import Control.Exception (Exception (..), IOException, SomeException (..), catch, evaluate, throwIO)+import Control.Monad (MonadPlus (..), ap, filterM, foldM, guard, join, liftM, liftM2, unless, void, when)+import Data.Char (chr, isAlpha, isAlphaNum, isDigit, isSpace, isUpper, ord, toLower, toUpper)+import Data.Data (Data)+import Data.Either (partitionEithers)+import Data.Function (on)+import Data.Functor.Identity (Identity (..))+import Data.Int (Int16, Int32, Int64, Int8)+import Data.List (dropWhileEnd, intercalate, intersperse, isPrefixOf, isSuffixOf, nub, nubBy, partition, sort, sortBy, unfoldr)+import Data.List.NonEmpty (NonEmpty ((:|)), head, init, last, nonEmpty, tail)+import Data.Map (Map)+import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, listToMaybe, mapMaybe, maybeToList)+import Data.Ord (comparing)+import Data.Proxy (Proxy (..))+import Data.Set (Set)+import Data.String (IsString (..))+import Data.Void (Void, absurd, vacuous)+import Data.Word (Word, Word16, Word32, Word64, Word8)+import Distribution.Compat.Binary (Binary (..)) import Distribution.Compat.Semigroup (Semigroup (..), gmappend, gmempty)-import Distribution.Compat.Typeable  (TypeRep, Typeable, typeRep)-import GHC.Generics                  (Generic (..), K1 (unK1), M1 (unM1), U1 (U1), V1, (:*:) ((:*:)), (:+:) (L1, R1))-import System.Exit                   (ExitCode (..), exitFailure, exitSuccess, exitWith)-import Text.Read                     (readMaybe)+import Distribution.Compat.Typeable (TypeRep, Typeable, typeRep)+import GHC.Generics (Generic (..), K1 (unK1), M1 (unM1), U1 (U1), V1, (:*:) ((:*:)), (:+:) (L1, R1))+import System.Exit (ExitCode (..), exitFailure, exitSuccess, exitWith)+import Text.Read (readMaybe)  import qualified Text.PrettyPrint as Disp  import Distribution.Compat.Exception import Distribution.Compat.NonEmptySet (NonEmptySet)-import Distribution.Utils.Structured   (Structured)+import Distribution.Utils.Structured (Structured)  import qualified Debug.Trace @@ -243,7 +305,6 @@   grnf (R1 x) = grnf x   {-# INLINEABLE grnf #-} - -- TODO: if we want foldr1/foldl1 to work on more than NonEmpty, we -- can define a local typeclass 'Foldable1', e.g. --@@ -286,3 +347,11 @@ traceShow :: Show a => a -> b -> b traceShow = Debug.Trace.traceShow {-# DEPRECATED traceShow "Don't leave me in the code" #-}++traceM :: Applicative f => String -> f ()+traceM = Debug.Trace.traceM+{-# DEPRECATED traceM "Don't leave me in the code" #-}++traceShowM :: (Show a, Applicative f) => a -> f ()+traceShowM = Debug.Trace.traceShowM+{-# DEPRECATED traceShowM "Don't leave me in the code" #-}

@@ -1,46 +1,44 @@-{-# LANGUAGE CPP                         #-}-{-# LANGUAGE DeriveDataTypeable          #-}-{-# LANGUAGE DeriveGeneric               #-}-{-# LANGUAGE FlexibleContexts            #-}-{-# LANGUAGE GeneralizedNewtypeDeriving  #-}-{-# LANGUAGE TypeOperators               #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TypeOperators #-}  -- | Compatibility layer for "Data.Semigroup" module Distribution.Compat.Semigroup-    ( Semigroup((<>))-    , Mon.Monoid(..)-    , All(..)-    , Any(..)--    , First'(..)-    , Last'(..)--    , Option'(..)--    , gmappend-    , gmempty-    ) where+  ( Semigroup ((<>))+  , Mon.Monoid (..)+  , All (..)+  , Any (..)+  , First' (..)+  , Last' (..)+  , Option' (..)+  , gmappend+  , gmempty+  ) where +import Data.Typeable (Typeable) import Distribution.Compat.Binary (Binary) import Distribution.Utils.Structured (Structured)-import Data.Typeable (Typeable)  import GHC.Generics+ -- Data.Semigroup is available since GHC 8.0/base-4.9 in `base` -- for older GHC/base, it's provided by `semigroups`-import Data.Semigroup-import qualified Data.Monoid as Mon +import qualified Data.Monoid as Mon+import Data.Semigroup  -- | A copy of 'Data.Semigroup.First'.-newtype First' a = First' { getFirst' :: a }+newtype First' a = First' {getFirst' :: a}   deriving (Eq, Ord, Show)  instance Semigroup (First' a) where   a <> _ = a  -- | A copy of 'Data.Semigroup.Last'.-newtype Last' a = Last' { getLast' :: a }+newtype Last' a = Last' {getLast' :: a}   deriving (Eq, Ord, Read, Show, Generic, Binary, Typeable)  instance Structured a => Structured (Last' a)@@ -53,15 +51,15 @@  -- | A wrapper around 'Maybe', providing the 'Semigroup' and 'Monoid' instances -- implemented for 'Maybe' since @base-4.11@.-newtype Option' a = Option' { getOption' :: Maybe a }+newtype Option' a = Option' {getOption' :: Maybe a}   deriving (Eq, Ord, Read, Show, Binary, Generic, Functor, Typeable)  instance Structured a => Structured (Option' a)  instance Semigroup a => Semigroup (Option' a) where   Option' (Just a) <> Option' (Just b) = Option' (Just (a <> b))-  Option' Nothing  <> b                = b-  a                <> Option' Nothing  = a+  Option' Nothing <> b = b+  a <> Option' Nothing = a  instance Semigroup a => Monoid (Option' a) where   mempty = Option' Nothing@@ -83,16 +81,16 @@ gmappend x y = to (gmappend' (from x) (from y))  class GSemigroup f where-    gmappend' :: f p -> f p -> f p+  gmappend' :: f p -> f p -> f p  instance Semigroup a => GSemigroup (K1 i a) where-    gmappend' (K1 x) (K1 y) = K1 (x <> y)+  gmappend' (K1 x) (K1 y) = K1 (x <> y)  instance GSemigroup f => GSemigroup (M1 i c f) where-    gmappend' (M1 x) (M1 y) = M1 (gmappend' x y)+  gmappend' (M1 x) (M1 y) = M1 (gmappend' x y)  instance (GSemigroup f, GSemigroup g) => GSemigroup (f :*: g) where-    gmappend' (x1 :*: x2) (y1 :*: y2) = gmappend' x1 y1 :*: gmappend' x2 y2+  gmappend' (x1 :*: x2) (y1 :*: y2) = gmappend' x1 y1 :*: gmappend' x2 y2  -- | Generically generate a 'Monoid' 'mempty' for any product-like type -- implementing 'Generic'.@@ -102,18 +100,17 @@ -- @ -- 'gmappend' 'gmempty' a = a = 'gmappend' a 'gmempty' -- @- gmempty :: (Generic a, GMonoid (Rep a)) => a gmempty = to gmempty'  class GSemigroup f => GMonoid f where-    gmempty' :: f p+  gmempty' :: f p  instance (Semigroup a, Monoid a) => GMonoid (K1 i a) where-    gmempty' = K1 mempty+  gmempty' = K1 mempty  instance GMonoid f => GMonoid (M1 i c f) where-    gmempty' = M1 gmempty'+  gmempty' = M1 gmempty'  instance (GMonoid f, GMonoid g) => GMonoid (f :*: g) where-    gmempty' = gmempty' :*: gmempty'+  gmempty' = gmempty' :*: gmempty'

@@ -1,10 +1,11 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-}-module Distribution.Compat.Typeable (-    Typeable,-    TypeRep,-    typeRep,-    ) where++module Distribution.Compat.Typeable+  ( Typeable+  , TypeRep+  , typeRep+  ) where  #if MIN_VERSION_base(4,7,0) import Data.Typeable (Typeable, TypeRep, typeRep)

@@ -1,10 +1,11 @@ {-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-}  -----------------------------------------------------------------------------+ -- | -- Module      :  Distribution.Compiler -- Copyright   :  Isaac Jones 2003-2004@@ -26,44 +27,54 @@ -- 'UserHooks' api, which would break all custom @Setup.hs@ files, so for the -- moment we just have to live with this deficiency. If you're interested, see -- ticket #57.--module Distribution.Compiler (-  -- * Compiler flavor-  CompilerFlavor(..),-  buildCompilerId,-  buildCompilerFlavor,-  defaultCompilerFlavor,-  classifyCompilerFlavor,-  knownCompilerFlavors,+module Distribution.Compiler+  ( -- * Compiler flavor+    CompilerFlavor (..)+  , buildCompilerId+  , buildCompilerFlavor+  , defaultCompilerFlavor+  , classifyCompilerFlavor+  , knownCompilerFlavors -  -- * Per compiler flavor-  PerCompilerFlavor (..),-  perCompilerFlavorToList,+    -- * Per compiler flavor+  , PerCompilerFlavor (..)+  , perCompilerFlavorToList -  -- * Compiler id-  CompilerId(..),+    -- * Compiler id+  , CompilerId (..) -  -- * Compiler info-  CompilerInfo(..),-  unknownCompilerInfo,-  AbiTag(..), abiTagString+    -- * Compiler info+  , CompilerInfo (..)+  , unknownCompilerInfo+  , AbiTag (..)+  , abiTagString   ) where -import Prelude () import Distribution.Compat.Prelude+import Prelude ()  import Language.Haskell.Extension  import Distribution.Version (Version, mkVersion', nullVersion) -import qualified System.Info (compilerName, compilerVersion)+import qualified Distribution.Compat.CharParsing as P import Distribution.Parsec (Parsec (..)) import Distribution.Pretty (Pretty (..), prettyShow)-import qualified Distribution.Compat.CharParsing as P+import qualified System.Info (compilerName, compilerVersion) import qualified Text.PrettyPrint as Disp -data CompilerFlavor =-  GHC | GHCJS | NHC | YHC | Hugs | HBC | Helium | JHC | LHC | UHC | Eta+data CompilerFlavor+  = GHC+  | GHCJS+  | NHC+  | YHC+  | Hugs+  | HBC+  | Helium+  | JHC+  | LHC+  | UHC+  | Eta   | HaskellSuite String -- string is the id of the actual compiler   | OtherCompiler String   deriving (Generic, Show, Read, Eq, Ord, Typeable, Data)@@ -78,23 +89,25 @@  instance Pretty CompilerFlavor where   pretty (OtherCompiler name) = Disp.text name-  pretty (HaskellSuite name)  = Disp.text name-  pretty NHC                  = Disp.text "nhc98"-  pretty other                = Disp.text (lowercase (show other))+  pretty (HaskellSuite name) = Disp.text name+  pretty NHC = Disp.text "nhc98"+  pretty other = Disp.text (lowercase (show other))  instance Parsec CompilerFlavor where-    parsec = classifyCompilerFlavor <$> component-      where-        component = do-          cs <- P.munch1 isAlphaNum-          if all isDigit cs then fail "all digits compiler name" else return cs+  parsec = classifyCompilerFlavor <$> component+    where+      component = do+        cs <- P.munch1 isAlphaNum+        if all isDigit cs then fail "all digits compiler name" else return cs  classifyCompilerFlavor :: String -> CompilerFlavor classifyCompilerFlavor s =   fromMaybe (OtherCompiler s) $ lookup (lowercase s) compilerMap   where-    compilerMap = [ (lowercase (prettyShow compiler), compiler)-                  | compiler <- knownCompilerFlavors ]+    compilerMap =+      [ (lowercase (prettyShow compiler), compiler)+      | compiler <- knownCompilerFlavors+      ]  buildCompilerFlavor :: CompilerFlavor buildCompilerFlavor = classifyCompilerFlavor System.Info.compilerName@@ -110,11 +123,10 @@ -- -- However if it's not a recognised compiler then it's 'Nothing' and the user -- will have to specify which compiler they want.--- defaultCompilerFlavor :: Maybe CompilerFlavor defaultCompilerFlavor = case buildCompilerFlavor of   OtherCompiler _ -> Nothing-  _               -> Just buildCompilerFlavor+  _ -> Just buildCompilerFlavor  ------------------------------------------------------------------------------- -- Per compiler data@@ -123,10 +135,19 @@ -- | 'PerCompilerFlavor' carries only info per GHC and GHCJS -- -- Cabal parses only @ghc-options@ and @ghcjs-options@, others are omitted.--- data PerCompilerFlavor v = PerCompilerFlavor v v-  deriving (Generic, Show, Read, Eq, Ord, Typeable, Data, Functor, Foldable-           , Traversable)+  deriving+    ( Generic+    , Show+    , Read+    , Eq+    , Ord+    , Typeable+    , Data+    , Functor+    , Foldable+    , Traversable+    )  instance Binary a => Binary (PerCompilerFlavor a) instance Structured a => Structured (PerCompilerFlavor a)@@ -136,15 +157,19 @@ perCompilerFlavorToList (PerCompilerFlavor a b) = [(GHC, a), (GHCJS, b)]  instance Semigroup a => Semigroup (PerCompilerFlavor a) where-    PerCompilerFlavor a b <> PerCompilerFlavor a' b' = PerCompilerFlavor-        (a <> a') (b <> b')+  PerCompilerFlavor a b <> PerCompilerFlavor a' b' =+    PerCompilerFlavor+      (a <> a')+      (b <> b')  instance (Semigroup a, Monoid a) => Monoid (PerCompilerFlavor a) where-    mempty = PerCompilerFlavor mempty mempty-    mappend = (<>)+  mempty = PerCompilerFlavor mempty mempty+  mappend = (<>)  -- ------------------------------------------------------------+ -- * Compiler Id+ -- ------------------------------------------------------------  data CompilerId = CompilerId CompilerFlavor Version@@ -157,7 +182,7 @@ instance Pretty CompilerId where   pretty (CompilerId f v)     | v == nullVersion = pretty f-    | otherwise        = pretty f <<>> Disp.char '-' <<>> pretty v+    | otherwise = pretty f <<>> Disp.char '-' <<>> pretty v  instance Parsec CompilerId where   parsec = do@@ -169,28 +194,29 @@ lowercase = map toLower  -- ------------------------------------------------------------+ -- * Compiler Info+ -- ------------------------------------------------------------  -- | Compiler information used for resolving configurations. Some --   fields can be set to Nothing to indicate that the information is --   unknown.--data CompilerInfo = CompilerInfo {-         compilerInfoId         :: CompilerId,-         -- ^ Compiler flavour and version.-         compilerInfoAbiTag     :: AbiTag,-         -- ^ Tag for distinguishing incompatible ABI's on the same-         -- architecture/os.-         compilerInfoCompat     :: Maybe [CompilerId],-         -- ^ Other implementations that this compiler claims to be-         -- compatible with, if known.-         compilerInfoLanguages  :: Maybe [Language],-         -- ^ Supported language standards, if known.-         compilerInfoExtensions :: Maybe [Extension]-         -- ^ Supported extensions, if known.-     }-     deriving (Generic, Show, Read)+data CompilerInfo = CompilerInfo+  { compilerInfoId :: CompilerId+  -- ^ Compiler flavour and version.+  , compilerInfoAbiTag :: AbiTag+  -- ^ Tag for distinguishing incompatible ABI's on the same+  -- architecture/os.+  , compilerInfoCompat :: Maybe [CompilerId]+  -- ^ Other implementations that this compiler claims to be+  -- compatible with, if known.+  , compilerInfoLanguages :: Maybe [Language]+  -- ^ Supported language standards, if known.+  , compilerInfoExtensions :: Maybe [Extension]+  -- ^ Supported extensions, if known.+  }+  deriving (Generic, Show, Read)  instance Binary CompilerInfo @@ -203,7 +229,7 @@ instance Structured AbiTag  instance Pretty AbiTag where-  pretty NoAbiTag     = Disp.empty+  pretty NoAbiTag = Disp.empty   pretty (AbiTag tag) = Disp.text tag  instance Parsec AbiTag where@@ -212,7 +238,7 @@     if null tag then return NoAbiTag else return (AbiTag tag)  abiTagString :: AbiTag -> String-abiTagString NoAbiTag     = ""+abiTagString NoAbiTag = "" abiTagString (AbiTag tag) = tag  -- | Make a CompilerInfo of which only the known information is its CompilerId,

@@ -1,34 +1,38 @@-{-# LANGUAGE FlexibleContexts    #-}-{-# LANGUAGE FlexibleInstances   #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-}+ -- | This module provides a way to specify a grammar of @.cabal@ -like files.-module Distribution.FieldGrammar  (-    -- * Field grammar type-    FieldGrammar (..),-    uniqueField,-    optionalField,-    optionalFieldDef,-    monoidalField,+module Distribution.FieldGrammar+  ( -- * Field grammar type+    FieldGrammar (..)+  , uniqueField+  , optionalField+  , optionalFieldDef+  , monoidalField+     -- * Concrete grammar implementations-    ParsecFieldGrammar,-    ParsecFieldGrammar',-    parseFieldGrammar,-    fieldGrammarKnownFieldList,-    PrettyFieldGrammar,-    PrettyFieldGrammar',-    prettyFieldGrammar,+  , ParsecFieldGrammar+  , ParsecFieldGrammar'+  , parseFieldGrammar+  , fieldGrammarKnownFieldList+  , PrettyFieldGrammar+  , PrettyFieldGrammar'+  , prettyFieldGrammar+     -- * Auxiliary-    (^^^),-    Section(..),-    Fields,-    partitionFields,-    takeFields,-    runFieldParser,-    runFieldParser',-    defaultFreeTextFieldDefST,+  , (^^^)+  , Section (..)+  , Fields+  , partitionFields+  , takeFields+  , runFieldParser+  , runFieldParser'+  , defaultFreeTextFieldDefST+     -- * Newtypes-    module Distribution.FieldGrammar.Newtypes,-    )  where+  , module Distribution.FieldGrammar.Newtypes+  ) where  import Distribution.Compat.Prelude import Prelude ()@@ -40,7 +44,7 @@ import Distribution.FieldGrammar.Parsec import Distribution.FieldGrammar.Pretty import Distribution.Fields.Field-import Distribution.Utils.Generic         (spanMaybe)+import Distribution.Utils.Generic (spanMaybe)  type ParsecFieldGrammar' a = ParsecFieldGrammar a a type PrettyFieldGrammar' a = PrettyFieldGrammar a a@@ -66,17 +70,18 @@   where     finalize :: PS ann -> (Fields ann, [[Section ann]])     finalize (PS fs s ss)-        | null s    = (fs, reverse ss)-        | otherwise = (fs, reverse (reverse s : ss))+      | null s = (fs, reverse ss)+      | otherwise = (fs, reverse (reverse s : ss))      f :: PS ann -> Field ann -> PS ann     f (PS fs s ss) (Field (Name ann name) fss) =-        PS (Map.insertWith (flip (++)) name [MkNamelessField ann fss] fs) [] ss'+      PS (Map.insertWith (flip (++)) name [MkNamelessField ann fss] fs) [] ss'       where-        ss' | null s    = ss-            | otherwise = reverse s : ss+        ss'+          | null s = ss+          | otherwise = reverse s : ss     f (PS fs s ss) (Section name sargs sfields) =-        PS fs (MkSection name sargs sfields : s) ss+      PS fs (MkSection name sargs sfields : s) ss  -- | Take all fields from the front. takeFields :: [Field ann] -> (Fields ann, [Field ann])

@@ -1,24 +1,25 @@-{-# LANGUAGE CPP                     #-}-{-# LANGUAGE ConstraintKinds         #-}-{-# LANGUAGE FunctionalDependencies  #-}-{-# LANGUAGE RankNTypes              #-}-{-# LANGUAGE ScopedTypeVariables     #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UndecidableSuperClasses #-}-module Distribution.FieldGrammar.Class (-    FieldGrammar (..),-    uniqueField,-    optionalField,-    optionalFieldDef,-    monoidalField,-    defaultFreeTextFieldDefST,-) where +module Distribution.FieldGrammar.Class+  ( FieldGrammar (..)+  , uniqueField+  , optionalField+  , optionalFieldDef+  , monoidalField+  , defaultFreeTextFieldDefST+  ) where+ import Distribution.Compat.Lens import Distribution.Compat.Prelude import Prelude () -import Distribution.CabalSpecVersion      (CabalSpecVersion)-import Distribution.Compat.Newtype        (Newtype)+import Distribution.CabalSpecVersion (CabalSpecVersion)+import Distribution.Compat.Newtype (Newtype) import Distribution.FieldGrammar.Newtypes import Distribution.Fields.Field import Distribution.Utils.ShortText@@ -31,171 +32,213 @@ -- * @a@ type of the field. -- -- /Note:/ We'd like to have @forall s. Applicative (f s)@ context.--- class-    ( c SpecVersion, c TestedWith, c SpecLicense, c Token, c Token', c FilePathNT-    )-    => FieldGrammar c g | g -> c+  ( c SpecVersion+  , c TestedWith+  , c SpecLicense+  , c Token+  , c Token'+  , c FilePathNT+  ) =>+  FieldGrammar c g+    | g -> c   where-    -- | Unfocus, zoom out, /blur/ 'FieldGrammar'.-    blurFieldGrammar :: ALens' a b -> g b d -> g a d+  -- | Unfocus, zoom out, /blur/ 'FieldGrammar'.+  blurFieldGrammar :: ALens' a b -> g b d -> g a d -    -- | Field which should be defined, exactly once.-    uniqueFieldAla-        :: (c b, Newtype a b)-        => FieldName   -- ^ field name-        -> (a -> b)    -- ^ 'Newtype' pack-        -> ALens' s a  -- ^ lens into the field-        -> g s a+  -- | Field which should be defined, exactly once.+  uniqueFieldAla+    :: (c b, Newtype a b)+    => FieldName+    -- ^ field name+    -> (a -> b)+    -- ^ 'Newtype' pack+    -> ALens' s a+    -- ^ lens into the field+    -> g s a -    -- | Boolean field with a default value.-    booleanFieldDef-        :: FieldName     -- ^ field name-        -> ALens' s Bool -- ^ lens into the field-        -> Bool          -- ^ default-        -> g s Bool+  -- | Boolean field with a default value.+  booleanFieldDef+    :: FieldName+    -- ^ field name+    -> ALens' s Bool+    -- ^ lens into the field+    -> Bool+    -- ^ default+    -> g s Bool -    -- | Optional field.-    optionalFieldAla-        :: (c b, Newtype a b)-        => FieldName          -- ^ field name-        -> (a -> b)           -- ^ 'pack'-        -> ALens' s (Maybe a) -- ^ lens into the field-        -> g s (Maybe a)+  -- | Optional field.+  optionalFieldAla+    :: (c b, Newtype a b)+    => FieldName+    -- ^ field name+    -> (a -> b)+    -- ^ 'pack'+    -> ALens' s (Maybe a)+    -- ^ lens into the field+    -> g s (Maybe a) -    -- | Optional field with default value.-    optionalFieldDefAla-        :: (c b, Newtype a b, Eq a)-        => FieldName   -- ^ field name-        -> (a -> b)    -- ^ 'Newtype' pack-        -> ALens' s a  -- ^ @'Lens'' s a@: lens into the field-        -> a           -- ^ default value-        -> g s a+  -- | Optional field with default value.+  optionalFieldDefAla+    :: (c b, Newtype a b, Eq a)+    => FieldName+    -- ^ field name+    -> (a -> b)+    -- ^ 'Newtype' pack+    -> ALens' s a+    -- ^ @'Lens'' s a@: lens into the field+    -> a+    -- ^ default value+    -> g s a -    --  | Free text field is essentially 'optionalFieldDefAla` with @""@-    --  as the default and "accept everything" parser.-    ---    -- @since 3.0.0.0-    freeTextField-        :: FieldName-        -> ALens' s (Maybe String) -- ^ lens into the field-        -> g s (Maybe String)+  --  | Free text field is essentially 'optionalFieldDefAla` with @""@+  --  as the default and "accept everything" parser.+  --+  -- @since 3.0.0.0+  freeTextField+    :: FieldName+    -> ALens' s (Maybe String)+    -- ^ lens into the field+    -> g s (Maybe String) -    --  | Free text field is essentially 'optionalFieldDefAla` with @""@-    --  as the default and "accept everything" parser.-    ---    -- @since 3.0.0.0-    freeTextFieldDef-        :: FieldName-        -> ALens' s String -- ^ lens into the field-        -> g s String+  --  | Free text field is essentially 'optionalFieldDefAla` with @""@+  --  as the default and "accept everything" parser.+  --+  -- @since 3.0.0.0+  freeTextFieldDef+    :: FieldName+    -> ALens' s String+    -- ^ lens into the field+    -> g s String -    -- | @since 3.2.0.0-    freeTextFieldDefST-        :: FieldName-        -> ALens' s ShortText -- ^ lens into the field-        -> g s ShortText+  -- | @since 3.2.0.0+  freeTextFieldDefST+    :: FieldName+    -> ALens' s ShortText+    -- ^ lens into the field+    -> g s ShortText -    -- | Monoidal field.-    ---    -- Values are combined with 'mappend'.-    ---    -- /Note:/ 'optionalFieldAla' is a @monoidalField@ with 'Last' monoid.-    ---    monoidalFieldAla-        :: (c b, Monoid a, Newtype a b)-        => FieldName   -- ^ field name-        -> (a -> b)    -- ^ 'pack'-        -> ALens' s a  -- ^ lens into the field-        -> g s a+  -- | Monoidal field.+  --+  -- Values are combined with 'mappend'.+  --+  -- /Note:/ 'optionalFieldAla' is a @monoidalField@ with 'Last' monoid.+  monoidalFieldAla+    :: (c b, Monoid a, Newtype a b)+    => FieldName+    -- ^ field name+    -> (a -> b)+    -- ^ 'pack'+    -> ALens' s a+    -- ^ lens into the field+    -> g s a -    -- | Parser matching all fields with a name starting with a prefix.-    prefixedFields-        :: FieldName                    -- ^ field name prefix-        -> ALens' s [(String, String)]  -- ^ lens into the field-        -> g s [(String, String)]+  -- | Parser matching all fields with a name starting with a prefix.+  prefixedFields+    :: FieldName+    -- ^ field name prefix+    -> ALens' s [(String, String)]+    -- ^ lens into the field+    -> g s [(String, String)] -    -- | Known field, which we don't parse, nor pretty print.-    knownField :: FieldName -> g s ()+  -- | Known field, which we don't parse, nor pretty print.+  knownField :: FieldName -> g s () -    -- | Field which is parsed but not pretty printed.-    hiddenField :: g s a -> g s a+  -- | Field which is parsed but not pretty printed.+  hiddenField :: g s a -> g s a -    -- | Deprecated since-    deprecatedSince-        :: CabalSpecVersion   -- ^ version-        -> String             -- ^ deprecation message-        -> g s a-        -> g s a+  -- | Deprecated since+  deprecatedSince+    :: CabalSpecVersion+    -- ^ version+    -> String+    -- ^ deprecation message+    -> g s a+    -> g s a -    -- | Removed in. If we encounter removed field, parsing fails.-    removedIn-        :: CabalSpecVersion   -- ^ version-        -> String             -- ^ removal message-        -> g s a-        -> g s a+  -- | Removed in. If we encounter removed field, parsing fails.+  removedIn+    :: CabalSpecVersion+    -- ^ version+    -> String+    -- ^ removal message+    -> g s a+    -> g s a -    -- | Annotate field with since spec-version.-    availableSince-        :: CabalSpecVersion  -- ^ spec version-        -> a                 -- ^ default value-        -> g s a-        -> g s a+  -- | Annotate field with since spec-version.+  availableSince+    :: CabalSpecVersion+    -- ^ spec version+    -> a+    -- ^ default value+    -> g s a+    -> g s a -    -- | Annotate field with since spec-version.-    -- This is used to recognise, but warn about the field.-    -- It is used to process @other-extensions@ field.-    ---    -- Default implementation is to not warn.-    ---    -- @since 3.4.0.0-    availableSinceWarn-        :: CabalSpecVersion  -- ^ spec version-        -> g s a-        -> g s a-    availableSinceWarn _ = id+  -- | Annotate field with since spec-version.+  -- This is used to recognise, but warn about the field.+  -- It is used to process @other-extensions@ field.+  --+  -- Default implementation is to not warn.+  --+  -- @since 3.4.0.0+  availableSinceWarn+    :: CabalSpecVersion+    -- ^ spec version+    -> g s a+    -> g s a+  availableSinceWarn _ = id  -- | Field which can be defined at most once. uniqueField-    :: (FieldGrammar c g, c (Identity a))-    => FieldName   -- ^ field name-    -> ALens' s a  -- ^ lens into the field-    -> g s a+  :: (FieldGrammar c g, c (Identity a))+  => FieldName+  -- ^ field name+  -> ALens' s a+  -- ^ lens into the field+  -> g s a uniqueField fn l = uniqueFieldAla fn Identity l  -- | Field which can be defined at most once. optionalField-    :: (FieldGrammar c g, c (Identity a))-    => FieldName          -- ^ field name-    -> ALens' s (Maybe a) -- ^ lens into the field-    -> g s (Maybe a)+  :: (FieldGrammar c g, c (Identity a))+  => FieldName+  -- ^ field name+  -> ALens' s (Maybe a)+  -- ^ lens into the field+  -> g s (Maybe a) optionalField fn l = optionalFieldAla fn Identity l  -- | Optional field with default value. optionalFieldDef-    :: (FieldGrammar c g, Functor (g s), c (Identity a), Eq a)-    => FieldName   -- ^ field name-    -> ALens' s a  -- ^ @'Lens'' s a@: lens into the field-    -> a           -- ^ default value-    -> g s a+  :: (FieldGrammar c g, Functor (g s), c (Identity a), Eq a)+  => FieldName+  -- ^ field name+  -> ALens' s a+  -- ^ @'Lens'' s a@: lens into the field+  -> a+  -- ^ default value+  -> g s a optionalFieldDef fn l x = optionalFieldDefAla fn Identity l x  -- | Field which can be define multiple times, and the results are @mappend@ed. monoidalField-    :: (FieldGrammar c g, c (Identity a), Monoid a)-    => FieldName   -- ^ field name-    -> ALens' s a  -- ^ lens into the field-    -> g s a+  :: (FieldGrammar c g, c (Identity a), Monoid a)+  => FieldName+  -- ^ field name+  -> ALens' s a+  -- ^ lens into the field+  -> g s a monoidalField fn l = monoidalFieldAla fn Identity l  -- | Default implementation for 'freeTextFieldDefST'. defaultFreeTextFieldDefST-    :: (Functor (g s), FieldGrammar c g)-    => FieldName-    -> ALens' s ShortText -- ^ lens into the field-    -> g s ShortText+  :: (Functor (g s), FieldGrammar c g)+  => FieldName+  -> ALens' s ShortText+  -- ^ lens into the field+  -> g s ShortText defaultFreeTextFieldDefST fn l =-    toShortText <$> freeTextFieldDef fn (cloneLens l . st)+  toShortText <$> freeTextFieldDef fn (cloneLens l . st)   where     st :: Lens' ShortText String     st f s = toShortText <$> f (fromShortText s)

@@ -1,43 +1,44 @@-{-# LANGUAGE DeriveFunctor         #-}-{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE RankNTypes            #-}-{-# LANGUAGE UndecidableInstances  #-}-module Distribution.FieldGrammar.FieldDescrs (-    FieldDescrs,-    fieldDescrPretty,-    fieldDescrParse,-    fieldDescrsToList,-    ) where+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE UndecidableInstances #-} +module Distribution.FieldGrammar.FieldDescrs+  ( FieldDescrs+  , fieldDescrPretty+  , fieldDescrParse+  , fieldDescrsToList+  ) where+ import Distribution.Compat.Prelude import Prelude () -import Distribution.Compat.Lens    (aview, cloneLens)-import Distribution.Utils.String (trim)+import Distribution.Compat.Lens (aview, cloneLens) import Distribution.Compat.Newtype import Distribution.FieldGrammar-import Distribution.Pretty         (Pretty (..), showFreeText)+import Distribution.Pretty (Pretty (..), showFreeText)+import Distribution.Utils.String (trim) -import qualified Data.Map                        as Map+import qualified Data.Map as Map import qualified Distribution.Compat.CharParsing as C-import qualified Distribution.Fields             as P-import qualified Distribution.Parsec             as P-import qualified Text.PrettyPrint                as Disp+import qualified Distribution.Fields as P+import qualified Distribution.Parsec as P+import qualified Text.PrettyPrint as Disp  -- strict pair data SP s = SP-    { pPretty :: !(s -> Disp.Doc)-    , pParse  :: !(forall m. P.CabalParsing m => s -> m s)-    }+  { pPretty :: !(s -> Disp.Doc)+  , pParse :: !(forall m. P.CabalParsing m => s -> m s)+  }  -- | A collection of field parsers and pretty-printers.-newtype FieldDescrs s a = F { runF :: Map P.FieldName (SP s) }+newtype FieldDescrs s a = F {runF :: Map P.FieldName (SP s)}   deriving (Functor)  instance Applicative (FieldDescrs s) where-    pure _  = F mempty-    f <*> x = F (mappend (runF f) (runF x))+  pure _ = F mempty+  f <*> x = F (mappend (runF f) (runF x))  singletonF :: P.FieldName -> (s -> Disp.Doc) -> (forall m. P.CabalParsing m => s -> m s) -> FieldDescrs s a singletonF fn f g = F $ Map.singleton fn (SP f g)@@ -51,55 +52,65 @@ fieldDescrParse (F m) fn = (\f -> pParse f) <$> Map.lookup fn m  fieldDescrsToList-    :: P.CabalParsing m-    => FieldDescrs s a-    -> [(P.FieldName, s -> Disp.Doc, s -> m s)]-fieldDescrsToList = map mk . Map.toList . runF where+  :: P.CabalParsing m+  => FieldDescrs s a+  -> [(P.FieldName, s -> Disp.Doc, s -> m s)]+fieldDescrsToList = map mk . Map.toList . runF+  where     mk (name, SP ppr parse) = (name, ppr, parse)  -- | /Note:/ default values are printed. instance FieldGrammar ParsecPretty FieldDescrs where-    blurFieldGrammar l (F m) = F (fmap blur m) where-        blur (SP f g) = SP (f . aview l) (cloneLens l g)+  blurFieldGrammar l (F m) = F (fmap blur m)+    where+      blur (SP f g) = SP (f . aview l) (cloneLens l g) -    booleanFieldDef fn l _def = singletonF fn f g where-        f s = Disp.text (show (aview l s))-        g s = cloneLens l (const P.parsec) s-      -- Note: eta expansion is needed for RankNTypes type-checking to work.+  booleanFieldDef fn l _def = singletonF fn f g+    where+      f s = Disp.text (show (aview l s))+      g s = cloneLens l (const P.parsec) s -    uniqueFieldAla fn _pack l = singletonF fn f g where-        f s = pretty (pack' _pack (aview l s))-        g s = cloneLens l (const (unpack' _pack <$> P.parsec)) s+  -- Note: eta expansion is needed for RankNTypes type-checking to work. -    optionalFieldAla fn _pack l = singletonF fn f g where-        f s = maybe mempty (pretty . pack' _pack) (aview l s)-        g s = cloneLens l (const (Just . unpack' _pack <$> P.parsec)) s+  uniqueFieldAla fn _pack l = singletonF fn f g+    where+      f s = pretty (pack' _pack (aview l s))+      g s = cloneLens l (const (unpack' _pack <$> P.parsec)) s -    optionalFieldDefAla fn _pack l _def = singletonF fn f g where-        f s = pretty (pack' _pack (aview l s))-        g s = cloneLens l (const (unpack' _pack <$> P.parsec)) s+  optionalFieldAla fn _pack l = singletonF fn f g+    where+      f s = maybe mempty (pretty . pack' _pack) (aview l s)+      g s = cloneLens l (const (Just . unpack' _pack <$> P.parsec)) s -    freeTextField fn l = singletonF fn f g where-        f s = maybe mempty showFreeText (aview l s)-        g s = cloneLens l (const (Just <$> parsecFreeText)) s+  optionalFieldDefAla fn _pack l _def = singletonF fn f g+    where+      f s = pretty (pack' _pack (aview l s))+      g s = cloneLens l (const (unpack' _pack <$> P.parsec)) s -    freeTextFieldDef fn l = singletonF fn f g where-        f s = showFreeText (aview l s)-        g s = cloneLens l (const parsecFreeText) s+  freeTextField fn l = singletonF fn f g+    where+      f s = maybe mempty showFreeText (aview l s)+      g s = cloneLens l (const (Just <$> parsecFreeText)) s -    freeTextFieldDefST = defaultFreeTextFieldDefST+  freeTextFieldDef fn l = singletonF fn f g+    where+      f s = showFreeText (aview l s)+      g s = cloneLens l (const parsecFreeText) s -    monoidalFieldAla fn _pack l = singletonF fn f g where-        f s = pretty (pack' _pack (aview l s))-        g s = cloneLens l (\x -> mappend x . unpack' _pack <$> P.parsec) s+  freeTextFieldDefST = defaultFreeTextFieldDefST -    prefixedFields _fnPfx _l = F mempty-    knownField _           = pure ()-    deprecatedSince _  _ x = x-    removedIn _ _ x        = x-    availableSince _ _     = id-    hiddenField _          = F mempty+  monoidalFieldAla fn _pack l = singletonF fn f g+    where+      f s = pretty (pack' _pack (aview l s))+      g s = cloneLens l (\x -> mappend x . unpack' _pack <$> P.parsec) s +  prefixedFields _fnPfx _l = F mempty+  knownField _ = pure ()+  deprecatedSince _ _ x = x+  removedIn _ _ x = x+  availableSince _ _ = id+  hiddenField _ = F mempty+ parsecFreeText :: P.CabalParsing m => m String parsecFreeText = dropDotLines <$ C.spaces <*> many C.anyChar   where@@ -109,11 +120,10 @@     dropDotLines x = intercalate "\n" . map dotToEmpty . lines $ x      dotToEmpty x | trim' x == "." = ""-    dotToEmpty x                  = trim x+    dotToEmpty x = trim x      trim' :: String -> String     trim' = dropWhileEnd (`elem` (" \t" :: String)) --class    (P.Parsec a, Pretty a) => ParsecPretty a+class (P.Parsec a, Pretty a) => ParsecPretty a instance (P.Parsec a, Pretty a) => ParsecPretty a

@@ -1,60 +1,77 @@-{-# LANGUAGE FlexibleContexts       #-}-{-# LANGUAGE FlexibleInstances      #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE OverloadedStrings      #-}-{-# LANGUAGE RankNTypes             #-}-{-# LANGUAGE ScopedTypeVariables    #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+ -- | This module provides @newtype@ wrappers to be used with "Distribution.FieldGrammar".-module Distribution.FieldGrammar.Newtypes (-    -- * List-    alaList,-    alaList',+module Distribution.FieldGrammar.Newtypes+  ( -- * List+    alaList+  , alaList'+     -- ** Modifiers-    CommaVCat (..),-    CommaFSep (..),-    VCat (..),-    FSep (..),-    NoCommaFSep (..),-    Sep (..),+  , CommaVCat (..)+  , CommaFSep (..)+  , VCat (..)+  , FSep (..)+  , NoCommaFSep (..)+  , Sep (..)+     -- ** Type-    List,+  , List+     -- ** Set-    alaSet,-    alaSet',-    Set',+  , alaSet+  , alaSet'+  , Set'+     -- ** NonEmpty-    alaNonEmpty,-    alaNonEmpty',-    NonEmpty',+  , alaNonEmpty+  , alaNonEmpty'+  , NonEmpty'+     -- * Version & License-    SpecVersion (..),-    TestedWith (..),-    SpecLicense (..),+  , SpecVersion (..)+  , TestedWith (..)+  , SpecLicense (..)+     -- * Identifiers-    Token (..),-    Token' (..),-    MQuoted (..),-    FilePathNT (..),-    ) where+  , Token (..)+  , Token' (..)+  , MQuoted (..)+  , FilePathNT (..)+  ) where  import Distribution.Compat.Newtype import Distribution.Compat.Prelude import Prelude ()  import Distribution.CabalSpecVersion-import Distribution.Compiler         (CompilerFlavor)-import Distribution.License          (License)+import Distribution.Compiler (CompilerFlavor)+import Distribution.License (License) import Distribution.Parsec import Distribution.Pretty import Distribution.Version-       (LowerBound (..), Version, VersionInterval (..), VersionRange, VersionRangeF (..), anyVersion, asVersionIntervals, cataVersionRange, mkVersion,-       version0, versionNumbers)-import Text.PrettyPrint              (Doc, comma, fsep, punctuate, text, vcat)+  ( LowerBound (..)+  , Version+  , VersionInterval (..)+  , VersionRange+  , VersionRangeF (..)+  , anyVersion+  , asVersionIntervals+  , cataVersionRange+  , mkVersion+  , version0+  , versionNumbers+  )+import Text.PrettyPrint (Doc, comma, fsep, punctuate, text, vcat) -import qualified Data.List.NonEmpty              as NE-import qualified Data.Set                        as Set+import qualified Data.List.NonEmpty as NE+import qualified Data.Set as Set import qualified Distribution.Compat.CharParsing as P-import qualified Distribution.SPDX               as SPDX+import qualified Distribution.SPDX as SPDX  -- | Vertical list with commas. Displayed with 'vcat' data CommaVCat = CommaVCat@@ -71,48 +88,48 @@ -- | Paragraph fill list without commas. Displayed with 'fsep'. data NoCommaFSep = NoCommaFSep -class    Sep sep  where-    prettySep :: Proxy sep -> [Doc] -> Doc+class Sep sep where+  prettySep :: Proxy sep -> [Doc] -> Doc -    parseSep   :: CabalParsing m => Proxy sep -> m a -> m [a]-    parseSepNE :: CabalParsing m => Proxy sep -> m a -> m (NonEmpty a)+  parseSep :: CabalParsing m => Proxy sep -> m a -> m [a]+  parseSepNE :: CabalParsing m => Proxy sep -> m a -> m (NonEmpty a)  instance Sep CommaVCat where-    prettySep  _ = vcat . punctuate comma-    parseSep   _ p = do-        v <- askCabalSpecVersion-        if v >= CabalSpecV2_2 then parsecLeadingCommaList p else parsecCommaList p-    parseSepNE _ p = do-        v <- askCabalSpecVersion-        if v >= CabalSpecV2_2 then parsecLeadingCommaNonEmpty p else parsecCommaNonEmpty p+  prettySep _ = vcat . punctuate comma+  parseSep _ p = do+    v <- askCabalSpecVersion+    if v >= CabalSpecV2_2 then parsecLeadingCommaList p else parsecCommaList p+  parseSepNE _ p = do+    v <- askCabalSpecVersion+    if v >= CabalSpecV2_2 then parsecLeadingCommaNonEmpty p else parsecCommaNonEmpty p instance Sep CommaFSep where-    prettySep _ = fsep . punctuate comma-    parseSep   _ p = do-        v <- askCabalSpecVersion-        if v >= CabalSpecV2_2 then parsecLeadingCommaList p else parsecCommaList p-    parseSepNE _ p = do-        v <- askCabalSpecVersion-        if v >= CabalSpecV2_2 then parsecLeadingCommaNonEmpty p else parsecCommaNonEmpty p+  prettySep _ = fsep . punctuate comma+  parseSep _ p = do+    v <- askCabalSpecVersion+    if v >= CabalSpecV2_2 then parsecLeadingCommaList p else parsecCommaList p+  parseSepNE _ p = do+    v <- askCabalSpecVersion+    if v >= CabalSpecV2_2 then parsecLeadingCommaNonEmpty p else parsecCommaNonEmpty p instance Sep VCat where-    prettySep _  = vcat-    parseSep   _ p = do-        v <- askCabalSpecVersion-        if v >= CabalSpecV3_0 then parsecLeadingOptCommaList p else parsecOptCommaList p-    parseSepNE _ p = NE.some1 (p <* P.spaces)+  prettySep _ = vcat+  parseSep _ p = do+    v <- askCabalSpecVersion+    if v >= CabalSpecV3_0 then parsecLeadingOptCommaList p else parsecOptCommaList p+  parseSepNE _ p = NE.some1 (p <* P.spaces) instance Sep FSep where-    prettySep _  = fsep-    parseSep   _ p = do-        v <- askCabalSpecVersion-        if v >= CabalSpecV3_0 then parsecLeadingOptCommaList p else parsecOptCommaList p-    parseSepNE _ p = NE.some1 (p <* P.spaces)+  prettySep _ = fsep+  parseSep _ p = do+    v <- askCabalSpecVersion+    if v >= CabalSpecV3_0 then parsecLeadingOptCommaList p else parsecOptCommaList p+  parseSepNE _ p = NE.some1 (p <* P.spaces) instance Sep NoCommaFSep where-    prettySep _    = fsep-    parseSep  _ p  = many (p <* P.spaces)-    parseSepNE _ p = NE.some1 (p <* P.spaces)+  prettySep _ = fsep+  parseSep _ p = many (p <* P.spaces)+  parseSepNE _ p = NE.some1 (p <* P.spaces)  -- | List separated with optional commas. Displayed with @sep@, arguments of -- type @a@ are parsed and pretty-printed as @b@.-newtype List sep b a = List { _getList :: [a] }+newtype List sep b a = List {_getList :: [a]}  -- | 'alaList' and 'alaList'' are simply 'List', with additional phantom -- arguments to constrain the resulting type@@ -122,7 +139,6 @@ -- -- >>> :t alaList' FSep Token -- alaList' FSep Token :: [String] -> List FSep Token String--- alaList :: sep -> [a] -> List sep (Identity a) a alaList _ = List @@ -133,16 +149,17 @@ instance Newtype [a] (List sep wrapper a)  instance (Newtype a b, Sep sep, Parsec b) => Parsec (List sep b a) where-    parsec   = pack . map (unpack :: b -> a) <$> parseSep (Proxy :: Proxy sep) parsec+  parsec = pack . map (unpack :: b -> a) <$> parseSep (Proxy :: Proxy sep) parsec  instance (Newtype a b, Sep sep, Pretty b) => Pretty (List sep b a) where-    pretty = prettySep (Proxy :: Proxy sep) . map (pretty . (pack :: a -> b)) . unpack+  pretty = prettySep (Proxy :: Proxy sep) . map (pretty . (pack :: a -> b)) . unpack  --+ -- | Like 'List', but for 'Set'. -- -- @since 3.2.0.0-newtype Set' sep b a = Set' { _getSet :: Set a }+newtype Set' sep b a = Set' {_getSet :: Set a}  -- | 'alaSet' and 'alaSet'' are simply 'Set'' constructor, with additional phantom -- arguments to constrain the resulting type@@ -169,16 +186,17 @@ instance Newtype (Set a) (Set' sep wrapper a)  instance (Newtype a b, Ord a, Sep sep, Parsec b) => Parsec (Set' sep b a) where-    parsec   = pack . Set.fromList . map (unpack :: b -> a) <$> parseSep (Proxy :: Proxy sep) parsec+  parsec = pack . Set.fromList . map (unpack :: b -> a) <$> parseSep (Proxy :: Proxy sep) parsec  instance (Newtype a b, Sep sep, Pretty b) => Pretty (Set' sep b a) where-    pretty = prettySep (Proxy :: Proxy sep) . map (pretty . (pack :: a -> b)) . Set.toList . unpack+  pretty = prettySep (Proxy :: Proxy sep) . map (pretty . (pack :: a -> b)) . Set.toList . unpack  --+ -- | Like 'List', but for 'NonEmpty'. -- -- @since 3.2.0.0-newtype NonEmpty' sep b a = NonEmpty' { _getNonEmpty :: NonEmpty a }+newtype NonEmpty' sep b a = NonEmpty' {_getNonEmpty :: NonEmpty a}  -- | 'alaNonEmpty' and 'alaNonEmpty'' are simply 'NonEmpty'' constructor, with additional phantom -- arguments to constrain the resulting type@@ -202,62 +220,62 @@ instance Newtype (NonEmpty a) (NonEmpty' sep wrapper a)  instance (Newtype a b, Sep sep, Parsec b) => Parsec (NonEmpty' sep b a) where-    parsec   = pack . fmap (unpack :: b -> a) <$> parseSepNE (Proxy :: Proxy sep) parsec+  parsec = pack . fmap (unpack :: b -> a) <$> parseSepNE (Proxy :: Proxy sep) parsec  instance (Newtype a b, Sep sep, Pretty b) => Pretty (NonEmpty' sep b a) where-    pretty = prettySep (Proxy :: Proxy sep) . map (pretty . (pack :: a -> b)) . NE.toList . unpack+  pretty = prettySep (Proxy :: Proxy sep) . map (pretty . (pack :: a -> b)) . NE.toList . unpack  ------------------------------------------------------------------------------- -- Identifiers -------------------------------------------------------------------------------  -- | Haskell string or @[^ ,]+@-newtype Token = Token { getToken :: String }+newtype Token = Token {getToken :: String}  instance Newtype String Token  instance Parsec Token where-    parsec = pack <$> parsecToken+  parsec = pack <$> parsecToken  instance Pretty Token where-    pretty = showToken . unpack+  pretty = showToken . unpack  -- | Haskell string or @[^ ]+@-newtype Token' = Token' { getToken' :: String }+newtype Token' = Token' {getToken' :: String}  instance Newtype String Token'  instance Parsec Token' where-    parsec = pack <$> parsecToken'+  parsec = pack <$> parsecToken'  instance Pretty Token' where-    pretty = showToken . unpack+  pretty = showToken . unpack  -- | Either @"quoted"@ or @un-quoted@.-newtype MQuoted a = MQuoted { getMQuoted :: a }+newtype MQuoted a = MQuoted {getMQuoted :: a}  instance Newtype a (MQuoted a)  instance Parsec a => Parsec (MQuoted a) where-    parsec = pack <$> parsecMaybeQuoted parsec+  parsec = pack <$> parsecMaybeQuoted parsec -instance Pretty a => Pretty (MQuoted a)  where-    pretty = pretty . unpack+instance Pretty a => Pretty (MQuoted a) where+  pretty = pretty . unpack  -- | Filepath are parsed as 'Token'.-newtype FilePathNT = FilePathNT { getFilePathNT :: String }+newtype FilePathNT = FilePathNT {getFilePathNT :: String}  instance Newtype String FilePathNT  instance Parsec FilePathNT where-    parsec = do-        token <- parsecToken-        if null token-        then P.unexpected "empty FilePath"-        else return (FilePathNT token)+  parsec = do+    token <- parsecToken+    if null token+      then P.unexpected "empty FilePath"+      else return (FilePathNT token)  instance Pretty FilePathNT where-    pretty = showFilePath . unpack+  pretty = showFilePath . unpack  ------------------------------------------------------------------------------- -- SpecVersion@@ -275,119 +293,124 @@ -- We have this newtype, as writing Parsec and Pretty instances -- for CabalSpecVersion would cause cycle in modules: --     Version -> CabalSpecVersion -> Parsec -> ...----newtype SpecVersion = SpecVersion { getSpecVersion :: CabalSpecVersion }+newtype SpecVersion = SpecVersion {getSpecVersion :: CabalSpecVersion}   deriving (Eq, Show) -- instances needed for tests  instance Newtype CabalSpecVersion SpecVersion  instance Parsec SpecVersion where-    parsec = do-        e <- parsecSpecVersion-        let ver    :: Version-            ver    = either id specVersionFromRange e--            digits :: [Int]-            digits = versionNumbers ver--        case cabalSpecFromVersionDigits digits of-            Nothing  -> fail $ "Unknown cabal spec version specified: " ++ prettyShow ver-            Just csv -> do-                -- Check some warnings:-                case e of-                    -- example:   cabal-version: 1.10-                    -- should be  cabal-version: >=1.10-                    Left _v | csv < CabalSpecV1_12 -> parsecWarning PWTSpecVersion $ concat-                        [ "With 1.10 or earlier, the 'cabal-version' field must use "-                        , "range syntax rather than a simple version number. Use "-                        , "'cabal-version: >= " ++ prettyShow ver ++ "'."-                        ]--                    -- example:   cabal-version: >=1.12-                    -- should be  cabal-version: 1.12-                    Right _vr | csv >= CabalSpecV1_12 -> parsecWarning PWTSpecVersion $ concat-                        [ "Packages with 'cabal-version: 1.12' or later should specify a "-                        , "specific version of the Cabal spec of the form "-                        , "'cabal-version: x.y'. "-                        , "Use 'cabal-version: " ++ prettyShow ver ++ "'."-                        ]--                    -- example:   cabal-version: >=1.10 && <1.12-                    -- should be  cabal-version: >=1.10-                    Right vr | csv < CabalSpecV1_12-                            , not (simpleSpecVersionRangeSyntax vr) -> parsecWarning PWTSpecVersion $ concat-                        [ "It is recommended that the 'cabal-version' field only specify a "-                        , "version range of the form '>= x.y' for older cabal versions. Use "-                        , "'cabal-version: >= " ++ prettyShow ver ++ "'. "-                        , "Tools based on Cabal 1.10 and later will ignore upper bounds."-                        ]+  parsec = do+    e <- parsecSpecVersion+    let ver :: Version+        ver = either id specVersionFromRange e -                    -- otherwise no warnings-                    _ -> pure ()+        digits :: [Int]+        digits = versionNumbers ver -                return (pack csv)-      where-        parsecSpecVersion = Left <$> parsec <|> Right <$> range+    case cabalSpecFromVersionDigits digits of+      Nothing -> fail $ "Unknown cabal spec version specified: " ++ prettyShow ver+      Just csv -> do+        -- Check some warnings:+        case e of+          -- example:   cabal-version: 1.10+          -- should be  cabal-version: >=1.10+          Left _v+            | csv < CabalSpecV1_12 ->+                parsecWarning PWTSpecVersion $+                  concat+                    [ "With 1.10 or earlier, the 'cabal-version' field must use "+                    , "range syntax rather than a simple version number. Use "+                    , "'cabal-version: >= " ++ prettyShow ver ++ "'."+                    ]+          -- example:   cabal-version: >=1.12+          -- should be  cabal-version: 1.12+          Right _vr+            | csv >= CabalSpecV1_12 ->+                parsecWarning PWTSpecVersion $+                  concat+                    [ "Packages with 'cabal-version: 1.12' or later should specify a "+                    , "specific version of the Cabal spec of the form "+                    , "'cabal-version: x.y'. "+                    , "Use 'cabal-version: " ++ prettyShow ver ++ "'."+                    ]+          -- example:   cabal-version: >=1.10 && <1.12+          -- should be  cabal-version: >=1.10+          Right vr+            | csv < CabalSpecV1_12+            , not (simpleSpecVersionRangeSyntax vr) ->+                parsecWarning PWTSpecVersion $+                  concat+                    [ "It is recommended that the 'cabal-version' field only specify a "+                    , "version range of the form '>= x.y' for older cabal versions. Use "+                    , "'cabal-version: >= " ++ prettyShow ver ++ "'. "+                    , "Tools based on Cabal 1.10 and later will ignore upper bounds."+                    ]+          -- otherwise no warnings+          _ -> pure () -        range = do-            vr <- parsec-            if specVersionFromRange vr >= mkVersion [2,1]-            then fail "cabal-version higher than 2.2 cannot be specified as a range. See https://github.com/haskell/cabal/issues/4899"-            else return vr+        return (pack csv)+    where+      parsecSpecVersion = Left <$> parsec <|> Right <$> range -        specVersionFromRange :: VersionRange -> Version-        specVersionFromRange versionRange = case asVersionIntervals versionRange of-            []                                           -> version0-            VersionInterval (LowerBound version _) _ : _ -> version+      range = do+        vr <- parsec+        if specVersionFromRange vr >= mkVersion [2, 1]+          then fail "cabal-version higher than 2.2 cannot be specified as a range. See https://github.com/haskell/cabal/issues/4899"+          else return vr -        simpleSpecVersionRangeSyntax = cataVersionRange alg where-            alg (OrLaterVersionF _) = True-            alg _                   = False+      specVersionFromRange :: VersionRange -> Version+      specVersionFromRange versionRange = case asVersionIntervals versionRange of+        [] -> version0+        VersionInterval (LowerBound version _) _ : _ -> version +      simpleSpecVersionRangeSyntax = cataVersionRange alg+        where+          alg (OrLaterVersionF _) = True+          alg _ = False  instance Pretty SpecVersion where-    pretty (SpecVersion csv)-        | csv >= CabalSpecV1_12 = text (showCabalSpecVersion csv)-        | otherwise             = text ">=" <<>> text (showCabalSpecVersion csv)+  pretty (SpecVersion csv)+    | csv >= CabalSpecV1_12 = text (showCabalSpecVersion csv)+    | otherwise = text ">=" <<>> text (showCabalSpecVersion csv)  ------------------------------------------------------------------------------- -- SpecLicense -------------------------------------------------------------------------------  -- | SPDX License expression or legacy license-newtype SpecLicense = SpecLicense { getSpecLicense :: Either SPDX.License License }-    deriving (Show, Eq)+newtype SpecLicense = SpecLicense {getSpecLicense :: Either SPDX.License License}+  deriving (Show, Eq)  instance Newtype (Either SPDX.License License) SpecLicense  instance Parsec SpecLicense where-    parsec = do-        v <- askCabalSpecVersion-        if v >= CabalSpecV2_2-        then SpecLicense . Left <$> parsec-        else SpecLicense . Right <$> parsec+  parsec = do+    v <- askCabalSpecVersion+    if v >= CabalSpecV2_2+      then SpecLicense . Left <$> parsec+      else SpecLicense . Right <$> parsec  instance Pretty SpecLicense where-    pretty = either pretty pretty . unpack+  pretty = either pretty pretty . unpack  ------------------------------------------------------------------------------- -- TestedWith -------------------------------------------------------------------------------  -- | Version range or just version-newtype TestedWith = TestedWith { getTestedWith :: (CompilerFlavor, VersionRange) }+newtype TestedWith = TestedWith {getTestedWith :: (CompilerFlavor, VersionRange)}  instance Newtype (CompilerFlavor, VersionRange) TestedWith  instance Parsec TestedWith where-    parsec = pack <$> parsecTestedWith+  parsec = pack <$> parsecTestedWith  instance Pretty TestedWith where-    pretty x = case unpack x of-        (compiler, vr) -> pretty compiler <+> pretty vr+  pretty x = case unpack x of+    (compiler, vr) -> pretty compiler <+> pretty vr  parsecTestedWith :: CabalParsing m => m (CompilerFlavor, VersionRange) parsecTestedWith = do-    name <- lexemeParsec-    ver  <- parsec <|> pure anyVersion-    return (name, ver)+  name <- lexemeParsec+  ver <- parsec <|> pure anyVersion+  return (name, ver)

@@ -1,7 +1,8 @@-{-# LANGUAGE DeriveFunctor         #-}+{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings     #-}-{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+ -- | This module provides a 'FieldGrammarParser', one way to parse -- @.cabal@ -like files. --@@ -50,34 +51,34 @@ -- We can parse 'Fields' like we parse @aeson@ objects, yet we use -- slightly higher-level API, so we can process unspecified fields, -- to report unknown fields and save custom @x-fields@.----module Distribution.FieldGrammar.Parsec (-    ParsecFieldGrammar,-    parseFieldGrammar,-    fieldGrammarKnownFieldList,+module Distribution.FieldGrammar.Parsec+  ( ParsecFieldGrammar+  , parseFieldGrammar+  , fieldGrammarKnownFieldList+     -- * Auxiliary-    Fields,-    NamelessField (..),-    namelessFieldAnn,-    Section (..),-    runFieldParser,-    runFieldParser',-    fieldLinesToStream,-    )  where+  , Fields+  , NamelessField (..)+  , namelessFieldAnn+  , Section (..)+  , runFieldParser+  , runFieldParser'+  , fieldLinesToStream+  ) where  import Distribution.Compat.Newtype import Distribution.Compat.Prelude-import Distribution.Utils.Generic  (fromUTF8BS)+import Distribution.Utils.Generic (fromUTF8BS) import Distribution.Utils.String (trim) import Prelude () -import qualified Data.ByteString              as BS-import qualified Data.List.NonEmpty           as NE-import qualified Data.Map.Strict              as Map-import qualified Data.Set                     as Set+import qualified Data.ByteString as BS+import qualified Data.List.NonEmpty as NE+import qualified Data.Map.Strict as Map+import qualified Data.Set as Set import qualified Distribution.Utils.ShortText as ShortText-import qualified Text.Parsec                  as P-import qualified Text.Parsec.Error            as P+import qualified Text.Parsec as P+import qualified Text.Parsec.Error as P  import Distribution.CabalSpecVersion import Distribution.FieldGrammar.Class@@ -85,7 +86,7 @@ import Distribution.Fields.ParseResult import Distribution.Parsec import Distribution.Parsec.FieldLineStream-import Distribution.Parsec.Position        (positionCol, positionRow)+import Distribution.Parsec.Position (positionCol, positionRow)  ------------------------------------------------------------------------------- -- Auxiliary types@@ -109,238 +110,240 @@ -------------------------------------------------------------------------------  data ParsecFieldGrammar s a = ParsecFG-    { fieldGrammarKnownFields   :: !(Set FieldName)-    , fieldGrammarKnownPrefixes :: !(Set FieldName)-    , fieldGrammarParser        :: !(CabalSpecVersion -> Fields Position -> ParseResult a)-    }+  { fieldGrammarKnownFields :: !(Set FieldName)+  , fieldGrammarKnownPrefixes :: !(Set FieldName)+  , fieldGrammarParser :: !(CabalSpecVersion -> Fields Position -> ParseResult a)+  }   deriving (Functor)  parseFieldGrammar :: CabalSpecVersion -> Fields Position -> ParsecFieldGrammar s a -> ParseResult a parseFieldGrammar v fields grammar = do-    for_ (Map.toList (Map.filterWithKey isUnknownField fields)) $ \(name, nfields) ->-        for_ nfields $ \(MkNamelessField pos _) ->-            parseWarning pos PWTUnknownField $ "Unknown field: " ++ show name-            -- TODO: fields allowed in this section--    -- parse-    fieldGrammarParser grammar v fields+  for_ (Map.toList (Map.filterWithKey isUnknownField fields)) $ \(name, nfields) ->+    for_ nfields $ \(MkNamelessField pos _) ->+      parseWarning pos PWTUnknownField $ "Unknown field: " ++ show name+  -- TODO: fields allowed in this section +  -- parse+  fieldGrammarParser grammar v fields   where-    isUnknownField k _ = not $+    isUnknownField k _ =+      not $         k `Set.member` fieldGrammarKnownFields grammar-        || any (`BS.isPrefixOf` k) (fieldGrammarKnownPrefixes grammar)+          || any (`BS.isPrefixOf` k) (fieldGrammarKnownPrefixes grammar)  fieldGrammarKnownFieldList :: ParsecFieldGrammar s a -> [FieldName] fieldGrammarKnownFieldList = Set.toList . fieldGrammarKnownFields  instance Applicative (ParsecFieldGrammar s) where-    pure x = ParsecFG mempty mempty (\_ _  -> pure x)-    {-# INLINE pure  #-}+  pure x = ParsecFG mempty mempty (\_ _ -> pure x)+  {-# INLINE pure #-} -    ParsecFG f f' f'' <*> ParsecFG x x' x'' = ParsecFG-        (mappend f x)-        (mappend f' x')-        (\v fields -> f'' v fields <*> x'' v fields)-    {-# INLINE (<*>) #-}+  ParsecFG f f' f'' <*> ParsecFG x x' x'' =+    ParsecFG+      (mappend f x)+      (mappend f' x')+      (\v fields -> f'' v fields <*> x'' v fields)+  {-# INLINE (<*>) #-}  warnMultipleSingularFields :: FieldName -> [NamelessField Position] -> ParseResult () warnMultipleSingularFields _ [] = pure () warnMultipleSingularFields fn (x : xs) = do-    let pos  = namelessFieldAnn x-        poss = map namelessFieldAnn xs-    parseWarning pos PWTMultipleSingularField $-        "The field " <> show fn <> " is specified more than once at positions " ++ intercalate ", " (map showPos (pos : poss))+  let pos = namelessFieldAnn x+      poss = map namelessFieldAnn xs+  parseWarning pos PWTMultipleSingularField $+    "The field " <> show fn <> " is specified more than once at positions " ++ intercalate ", " (map showPos (pos : poss))  instance FieldGrammar Parsec ParsecFieldGrammar where-    blurFieldGrammar _ (ParsecFG s s' parser) = ParsecFG s s' parser--    uniqueFieldAla fn _pack _extract = ParsecFG (Set.singleton fn) Set.empty parser-      where-        parser v fields = case Map.lookup fn fields of-            Nothing          -> parseFatalFailure zeroPos $ show fn ++ " field missing"-            Just []          -> parseFatalFailure zeroPos $ show fn ++ " field missing"-            Just [x]         -> parseOne v x-            Just xs@(_:y:ys) -> do-                warnMultipleSingularFields fn xs-                NE.last <$> traverse (parseOne v) (y:|ys)--        parseOne v (MkNamelessField pos fls) =-            unpack' _pack <$> runFieldParser pos parsec v fls--    booleanFieldDef fn _extract def = ParsecFG (Set.singleton fn) Set.empty parser-      where-        parser v fields = case Map.lookup fn fields of-            Nothing          -> pure def-            Just []          -> pure def-            Just [x]         -> parseOne v x-            Just xs@(_:y:ys) -> do-                warnMultipleSingularFields fn xs-                NE.last <$> traverse (parseOne v) (y:|ys)--        parseOne v (MkNamelessField pos fls) = runFieldParser pos parsec v fls+  blurFieldGrammar _ (ParsecFG s s' parser) = ParsecFG s s' parser -    optionalFieldAla fn _pack _extract = ParsecFG (Set.singleton fn) Set.empty parser-      where-        parser v fields = case Map.lookup fn fields of-            Nothing          -> pure Nothing-            Just []          -> pure Nothing-            Just [x]         -> parseOne v x-            Just xs@(_:y:ys) -> do-                warnMultipleSingularFields fn xs-                NE.last <$> traverse (parseOne v) (y:|ys)+  uniqueFieldAla fn _pack _extract = ParsecFG (Set.singleton fn) Set.empty parser+    where+      parser v fields = case Map.lookup fn fields of+        Nothing -> parseFatalFailure zeroPos $ show fn ++ " field missing"+        Just [] -> parseFatalFailure zeroPos $ show fn ++ " field missing"+        Just [x] -> parseOne v x+        Just xs@(_ : y : ys) -> do+          warnMultipleSingularFields fn xs+          NE.last <$> traverse (parseOne v) (y :| ys) -        parseOne v (MkNamelessField pos fls)-            | null fls  = pure Nothing-            | otherwise = Just . unpack' _pack <$> runFieldParser pos parsec v fls+      parseOne v (MkNamelessField pos fls) =+        unpack' _pack <$> runFieldParser pos parsec v fls -    optionalFieldDefAla fn _pack _extract def = ParsecFG (Set.singleton fn) Set.empty parser-      where-        parser v fields = case Map.lookup fn fields of-            Nothing          -> pure def-            Just []          -> pure def-            Just [x]         -> parseOne v x-            Just xs@(_:y:ys) -> do-                warnMultipleSingularFields fn xs-                NE.last <$> traverse (parseOne v) (y:|ys)+  booleanFieldDef fn _extract def = ParsecFG (Set.singleton fn) Set.empty parser+    where+      parser v fields = case Map.lookup fn fields of+        Nothing -> pure def+        Just [] -> pure def+        Just [x] -> parseOne v x+        Just xs@(_ : y : ys) -> do+          warnMultipleSingularFields fn xs+          NE.last <$> traverse (parseOne v) (y :| ys) -        parseOne v (MkNamelessField pos fls)-            | null fls  = pure def-            | otherwise = unpack' _pack <$> runFieldParser pos parsec v fls+      parseOne v (MkNamelessField pos fls) = runFieldParser pos parsec v fls -    freeTextField fn _ = ParsecFG (Set.singleton fn) Set.empty parser where-        parser v fields = case Map.lookup fn fields of-            Nothing          -> pure Nothing-            Just []          -> pure Nothing-            Just [x]         -> parseOne v x-            Just xs@(_:y:ys) -> do-                warnMultipleSingularFields fn xs-                NE.last <$> traverse (parseOne v) (y:|ys)+  optionalFieldAla fn _pack _extract = ParsecFG (Set.singleton fn) Set.empty parser+    where+      parser v fields = case Map.lookup fn fields of+        Nothing -> pure Nothing+        Just [] -> pure Nothing+        Just [x] -> parseOne v x+        Just xs@(_ : y : ys) -> do+          warnMultipleSingularFields fn xs+          NE.last <$> traverse (parseOne v) (y :| ys) -        parseOne v (MkNamelessField pos fls)-            | null fls           = pure Nothing-            | v >= CabalSpecV3_0 = pure (Just (fieldlinesToFreeText3 pos fls))-            | otherwise          = pure (Just (fieldlinesToFreeText fls))+      parseOne v (MkNamelessField pos fls)+        | null fls = pure Nothing+        | otherwise = Just . unpack' _pack <$> runFieldParser pos parsec v fls -    freeTextFieldDef fn _ = ParsecFG (Set.singleton fn) Set.empty parser where-        parser v fields = case Map.lookup fn fields of-            Nothing          -> pure ""-            Just []          -> pure ""-            Just [x]         -> parseOne v x-            Just xs@(_:y:ys) -> do-                warnMultipleSingularFields fn xs-                NE.last <$> traverse (parseOne v) (y:|ys)+  optionalFieldDefAla fn _pack _extract def = ParsecFG (Set.singleton fn) Set.empty parser+    where+      parser v fields = case Map.lookup fn fields of+        Nothing -> pure def+        Just [] -> pure def+        Just [x] -> parseOne v x+        Just xs@(_ : y : ys) -> do+          warnMultipleSingularFields fn xs+          NE.last <$> traverse (parseOne v) (y :| ys) -        parseOne v (MkNamelessField pos fls)-            | null fls           = pure ""-            | v >= CabalSpecV3_0 = pure (fieldlinesToFreeText3 pos fls)-            | otherwise          = pure (fieldlinesToFreeText fls)+      parseOne v (MkNamelessField pos fls)+        | null fls = pure def+        | otherwise = unpack' _pack <$> runFieldParser pos parsec v fls -    -- freeTextFieldDefST = defaultFreeTextFieldDefST-    freeTextFieldDefST fn _ = ParsecFG (Set.singleton fn) Set.empty parser where-        parser v fields = case Map.lookup fn fields of-            Nothing          -> pure mempty-            Just []          -> pure mempty-            Just [x]         -> parseOne v x-            Just xs@(_:y:ys) -> do-                warnMultipleSingularFields fn xs-                NE.last <$> traverse (parseOne v) (y:|ys)+  freeTextField fn _ = ParsecFG (Set.singleton fn) Set.empty parser+    where+      parser v fields = case Map.lookup fn fields of+        Nothing -> pure Nothing+        Just [] -> pure Nothing+        Just [x] -> parseOne v x+        Just xs@(_ : y : ys) -> do+          warnMultipleSingularFields fn xs+          NE.last <$> traverse (parseOne v) (y :| ys) -        parseOne v (MkNamelessField pos fls) = case fls of-            []                     -> pure mempty-            [FieldLine _  bs]      -> pure (ShortText.unsafeFromUTF8BS bs)-            _ | v >= CabalSpecV3_0 -> pure (ShortText.toShortText $ fieldlinesToFreeText3 pos fls)-              | otherwise          -> pure (ShortText.toShortText $ fieldlinesToFreeText fls)+      parseOne v (MkNamelessField pos fls)+        | null fls = pure Nothing+        | v >= CabalSpecV3_0 = pure (Just (fieldlinesToFreeText3 pos fls))+        | otherwise = pure (Just (fieldlinesToFreeText fls)) -    monoidalFieldAla fn _pack _extract = ParsecFG (Set.singleton fn) Set.empty parser-      where-        parser v fields = case Map.lookup fn fields of-            Nothing -> pure mempty-            Just xs -> foldMap (unpack' _pack) <$> traverse (parseOne v) xs+  freeTextFieldDef fn _ = ParsecFG (Set.singleton fn) Set.empty parser+    where+      parser v fields = case Map.lookup fn fields of+        Nothing -> pure ""+        Just [] -> pure ""+        Just [x] -> parseOne v x+        Just xs@(_ : y : ys) -> do+          warnMultipleSingularFields fn xs+          NE.last <$> traverse (parseOne v) (y :| ys) -        parseOne v (MkNamelessField pos fls) = runFieldParser pos parsec v fls+      parseOne v (MkNamelessField pos fls)+        | null fls = pure ""+        | v >= CabalSpecV3_0 = pure (fieldlinesToFreeText3 pos fls)+        | otherwise = pure (fieldlinesToFreeText fls) -    prefixedFields fnPfx _extract = ParsecFG mempty (Set.singleton fnPfx) (\_ fs -> pure (parser fs))-      where-        parser :: Fields Position -> [(String, String)]-        parser values = reorder $ concatMap convert $ filter match $ Map.toList values+  -- freeTextFieldDefST = defaultFreeTextFieldDefST+  freeTextFieldDefST fn _ = ParsecFG (Set.singleton fn) Set.empty parser+    where+      parser v fields = case Map.lookup fn fields of+        Nothing -> pure mempty+        Just [] -> pure mempty+        Just [x] -> parseOne v x+        Just xs@(_ : y : ys) -> do+          warnMultipleSingularFields fn xs+          NE.last <$> traverse (parseOne v) (y :| ys) -        match (fn, _) = fnPfx `BS.isPrefixOf` fn-        convert (fn, fields) =-            [ (pos, (fromUTF8BS fn, trim $ fromUTF8BS $ fieldlinesToBS fls))-            | MkNamelessField pos fls <- fields-            ]-        -- hack: recover the order of prefixed fields-        reorder = map snd . sortBy (comparing fst)+      parseOne v (MkNamelessField pos fls) = case fls of+        [] -> pure mempty+        [FieldLine _ bs] -> pure (ShortText.unsafeFromUTF8BS bs)+        _+          | v >= CabalSpecV3_0 -> pure (ShortText.toShortText $ fieldlinesToFreeText3 pos fls)+          | otherwise -> pure (ShortText.toShortText $ fieldlinesToFreeText fls) -    availableSince vs def (ParsecFG names prefixes parser) = ParsecFG names prefixes parser'-      where-        parser' v values-            | v >= vs = parser v values-            | otherwise = do-                let unknownFields = Map.intersection values $ Map.fromSet (const ()) names-                for_ (Map.toList unknownFields) $ \(name, fields) ->-                    for_ fields $ \(MkNamelessField pos _) ->-                        parseWarning pos PWTUnknownField $-                            "The field " <> show name <> " is available only since the Cabal specification version " ++ showCabalSpecVersion vs ++ ". This field will be ignored."+  monoidalFieldAla fn _pack _extract = ParsecFG (Set.singleton fn) Set.empty parser+    where+      parser v fields = case Map.lookup fn fields of+        Nothing -> pure mempty+        Just xs -> foldMap (unpack' _pack) <$> traverse (parseOne v) xs -                pure def+      parseOne v (MkNamelessField pos fls) = runFieldParser pos parsec v fls -    availableSinceWarn vs (ParsecFG names prefixes parser) = ParsecFG names prefixes parser'-      where-        parser' v values-            | v >= vs = parser v values-            | otherwise = do-                let unknownFields = Map.intersection values $ Map.fromSet (const ()) names-                for_ (Map.toList unknownFields) $ \(name, fields) ->-                    for_ fields $ \(MkNamelessField pos _) ->-                        parseWarning pos PWTUnknownField $-                            "The field " <> show name <> " is available only since the Cabal specification version " ++ showCabalSpecVersion vs ++ "."+  prefixedFields fnPfx _extract = ParsecFG mempty (Set.singleton fnPfx) (\_ fs -> pure (parser fs))+    where+      parser :: Fields Position -> [(String, String)]+      parser values = reorder $ concatMap convert $ filter match $ Map.toList values -                parser v values+      match (fn, _) = fnPfx `BS.isPrefixOf` fn+      convert (fn, fields) =+        [ (pos, (fromUTF8BS fn, trim $ fromUTF8BS $ fieldlinesToBS fls))+        | MkNamelessField pos fls <- fields+        ]+      -- hack: recover the order of prefixed fields+      reorder = map snd . sortBy (comparing fst) +  availableSince vs def (ParsecFG names prefixes parser) = ParsecFG names prefixes parser'+    where+      parser' v values+        | v >= vs = parser v values+        | otherwise = do+            let unknownFields = Map.intersection values $ Map.fromSet (const ()) names+            for_ (Map.toList unknownFields) $ \(name, fields) ->+              for_ fields $ \(MkNamelessField pos _) ->+                parseWarning pos PWTUnknownField $+                  "The field " <> show name <> " is available only since the Cabal specification version " ++ showCabalSpecVersion vs ++ ". This field will be ignored." -    -- todo we know about this field-    deprecatedSince vs msg (ParsecFG names prefixes parser) = ParsecFG names prefixes parser'-      where-        parser' v values-            | v >= vs = do-                let deprecatedFields = Map.intersection values $ Map.fromSet (const ()) names-                for_ (Map.toList deprecatedFields) $ \(name, fields) ->-                    for_ fields $ \(MkNamelessField pos _) ->-                        parseWarning pos PWTDeprecatedField $-                            "The field " <> show name <> " is deprecated in the Cabal specification version " ++ showCabalSpecVersion vs ++ ". " ++ msg+            pure def -                parser v values+  availableSinceWarn vs (ParsecFG names prefixes parser) = ParsecFG names prefixes parser'+    where+      parser' v values+        | v >= vs = parser v values+        | otherwise = do+            let unknownFields = Map.intersection values $ Map.fromSet (const ()) names+            for_ (Map.toList unknownFields) $ \(name, fields) ->+              for_ fields $ \(MkNamelessField pos _) ->+                parseWarning pos PWTUnknownField $+                  "The field " <> show name <> " is available only since the Cabal specification version " ++ showCabalSpecVersion vs ++ "." -            | otherwise = parser v values+            parser v values -    removedIn vs msg (ParsecFG names prefixes parser) = ParsecFG names prefixes parser' where-        parser' v values-            | v >= vs = do-                let msg' = if null msg then "" else ' ' : msg-                let unknownFields = Map.intersection values $ Map.fromSet (const ()) names-                let namePos =-                      [ (name, pos)-                      | (name, fields) <- Map.toList unknownFields-                      , MkNamelessField pos _ <- fields-                      ]+  -- todo we know about this field+  deprecatedSince vs msg (ParsecFG names prefixes parser) = ParsecFG names prefixes parser'+    where+      parser' v values+        | v >= vs = do+            let deprecatedFields = Map.intersection values $ Map.fromSet (const ()) names+            for_ (Map.toList deprecatedFields) $ \(name, fields) ->+              for_ fields $ \(MkNamelessField pos _) ->+                parseWarning pos PWTDeprecatedField $+                  "The field " <> show name <> " is deprecated in the Cabal specification version " ++ showCabalSpecVersion vs ++ ". " ++ msg -                let makeMsg name = "The field " <> show name <> " is removed in the Cabal specification version " ++ showCabalSpecVersion vs ++ "." ++ msg'+            parser v values+        | otherwise = parser v values -                case namePos of-                    -- no fields => proceed (with empty values, to be sure)-                    [] -> parser v mempty+  removedIn vs msg (ParsecFG names prefixes parser) = ParsecFG names prefixes parser'+    where+      parser' v values+        | v >= vs = do+            let msg' = if null msg then "" else ' ' : msg+            let unknownFields = Map.intersection values $ Map.fromSet (const ()) names+            let namePos =+                  [ (name, pos)+                  | (name, fields) <- Map.toList unknownFields+                  , MkNamelessField pos _ <- fields+                  ] -                    -- if there's single field: fail fatally with it-                    ((name, pos) : rest) -> do-                        for_ rest $ \(name', pos') -> parseFailure pos' $ makeMsg name'-                        parseFatalFailure pos $ makeMsg name+            let makeMsg name = "The field " <> show name <> " is removed in the Cabal specification version " ++ showCabalSpecVersion vs ++ "." ++ msg' -              | otherwise = parser v values+            case namePos of+              -- no fields => proceed (with empty values, to be sure)+              [] -> parser v mempty+              -- if there's single field: fail fatally with it+              ((name, pos) : rest) -> do+                for_ rest $ \(name', pos') -> parseFailure pos' $ makeMsg name'+                parseFatalFailure pos $ makeMsg name+        | otherwise = parser v values -    knownField fn = ParsecFG (Set.singleton fn) Set.empty (\_ _ -> pure ())+  knownField fn = ParsecFG (Set.singleton fn) Set.empty (\_ _ -> pure ()) -    hiddenField = id+  hiddenField = id  ------------------------------------------------------------------------------- -- Parsec@@ -348,26 +351,32 @@  runFieldParser' :: [Position] -> ParsecParser a -> CabalSpecVersion -> FieldLineStream -> ParseResult a runFieldParser' inputPoss p v str = case P.runParser p' [] "<field>" str of-    Right (pok, ws) -> do-        traverse_ (\(PWarning t pos w) -> parseWarning (mapPosition pos) t w) ws-        pure pok-    Left err        -> do-        let ppos = P.errorPos err-        let epos = mapPosition $ Position (P.sourceLine ppos) (P.sourceColumn ppos)+  Right (pok, ws) -> do+    traverse_ (\(PWarning t pos w) -> parseWarning (mapPosition pos) t w) ws+    pure pok+  Left err -> do+    let ppos = P.errorPos err+    let epos = mapPosition $ Position (P.sourceLine ppos) (P.sourceColumn ppos) -        let msg = P.showErrorMessages-                "or" "unknown parse error" "expecting" "unexpected" "end of input"-                (P.errorMessages err)-        parseFatalFailure epos $ msg ++ "\n"+    let msg =+          P.showErrorMessages+            "or"+            "unknown parse error"+            "expecting"+            "unexpected"+            "end of input"+            (P.errorMessages err)+    parseFatalFailure epos $ msg ++ "\n"   where     p' = (,) <$ P.spaces <*> unPP p v <* P.spaces <* P.eof <*> P.getState      -- Positions start from 1:1, not 0:0-    mapPosition (Position prow pcol) = go (prow - 1) inputPoss where-        go _ []                            = zeroPos-        go _ [Position row col]            = Position row (col + pcol - 1)-        go n (Position row col:_) | n <= 0 = Position row (col + pcol - 1)-        go n (_:ps)                        = go (n - 1) ps+    mapPosition (Position prow pcol) = go (prow - 1) inputPoss+      where+        go _ [] = zeroPos+        go _ [Position row col] = Position row (col + pcol - 1)+        go n (Position row col : _) | n <= 0 = Position row (col + pcol - 1)+        go n (_ : ps) = go (n - 1) ps  runFieldParser :: Position -> ParsecParser a -> CabalSpecVersion -> [FieldLine Position] -> ParseResult a runFieldParser pp p v ls = runFieldParser' poss p v (fieldLinesToStream ls)@@ -381,54 +390,55 @@ -- http://hackage.haskell.org/package/copilot-cbmc-0.1/copilot-cbmc.cabal fieldlinesToFreeText :: [FieldLine ann] -> String fieldlinesToFreeText [FieldLine _ "."] = "."-fieldlinesToFreeText fls               = intercalate "\n" (map go fls)+fieldlinesToFreeText fls = intercalate "\n" (map go fls)   where     go (FieldLine _ bs)-        | s == "." = ""-        | otherwise = s+      | s == "." = ""+      | otherwise = s       where         s = trim (fromUTF8BS bs)  fieldlinesToFreeText3 :: Position -> [FieldLine Position] -> String-fieldlinesToFreeText3 _   []               = ""-fieldlinesToFreeText3 _   [FieldLine _ bs] = fromUTF8BS bs+fieldlinesToFreeText3 _ [] = ""+fieldlinesToFreeText3 _ [FieldLine _ bs] = fromUTF8BS bs fieldlinesToFreeText3 pos (FieldLine pos1 bs1 : fls2@(FieldLine pos2 _ : _))-    -- if first line is on the same line with field name:-    -- the indentation level is either-    -- 1. the indentation of left most line in rest fields-    -- 2. the indentation of the first line-    -- whichever is leftmost-    | positionRow pos == positionRow pos1 = concat-        $ fromUTF8BS bs1-        : mealy (mk mcol1) pos1 fls2--    -- otherwise, also indent the first line-    | otherwise = concat-        $ replicate (positionCol pos1 - mcol2) ' '-        : fromUTF8BS bs1-        : mealy (mk mcol2) pos1 fls2-+  -- if first line is on the same line with field name:+  -- the indentation level is either+  -- 1. the indentation of left most line in rest fields+  -- 2. the indentation of the first line+  -- whichever is leftmost+  | positionRow pos == positionRow pos1 =+      concat $+        fromUTF8BS bs1+          : mealy (mk mcol1) pos1 fls2+  -- otherwise, also indent the first line+  | otherwise =+      concat $+        replicate (positionCol pos1 - mcol2) ' '+          : fromUTF8BS bs1+          : mealy (mk mcol2) pos1 fls2   where     mcol1 = foldl' (\a b -> min a $ positionCol $ fieldLineAnn b) (min (positionCol pos1) (positionCol pos2)) fls2     mcol2 = foldl' (\a b -> min a $ positionCol $ fieldLineAnn b) (positionCol pos1) fls2      mk :: Int -> Position -> FieldLine Position -> (Position, String)     mk col p (FieldLine q bs) =-        ( q-        , replicate newlines '\n'+      ( q+      , replicate newlines '\n'           ++ replicate indent ' '           ++ fromUTF8BS bs-        )+      )       where         newlines = positionRow q - positionRow p-        indent   = positionCol q - col+        indent = positionCol q - col  mealy :: (s -> a -> (s, b)) -> s -> [a] -> [b]-mealy f = go where+mealy f = go+  where     go _ [] = []     go s (x : xs) = let ~(s', y) = f s x in y : go s' xs  fieldLinesToStream :: [FieldLine ann] -> FieldLineStream-fieldLinesToStream []                    = fieldLineStreamEnd-fieldLinesToStream [FieldLine _ bs]      = FLSLast bs+fieldLinesToStream [] = fieldLineStreamEnd+fieldLinesToStream [FieldLine _ bs] = FLSLast bs fieldLinesToStream (FieldLine _ bs : fs) = FLSCons bs (fieldLinesToStream fs)

@@ -1,32 +1,33 @@-{-# LANGUAGE DeriveFunctor         #-}+{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE MultiParamTypeClasses #-}-module Distribution.FieldGrammar.Pretty (-    PrettyFieldGrammar,-    prettyFieldGrammar,-    ) where -import           Distribution.CabalSpecVersion-import           Distribution.Compat.Lens-import           Distribution.Compat.Newtype-import           Distribution.Compat.Prelude-import           Distribution.Fields.Field     (FieldName)-import           Distribution.Fields.Pretty    (PrettyField (..))-import           Distribution.Pretty           (Pretty (..), showFreeText, showFreeTextV3)-import           Distribution.Utils.Generic    (toUTF8BS)-import           Prelude ()-import           Text.PrettyPrint              (Doc)-import qualified Text.PrettyPrint              as PP+module Distribution.FieldGrammar.Pretty+  ( PrettyFieldGrammar+  , prettyFieldGrammar+  ) where +import Distribution.CabalSpecVersion+import Distribution.Compat.Lens+import Distribution.Compat.Newtype+import Distribution.Compat.Prelude+import Distribution.Fields.Field (FieldName)+import Distribution.Fields.Pretty (PrettyField (..))+import Distribution.Pretty (Pretty (..), showFreeText, showFreeTextV3)+import Distribution.Utils.Generic (toUTF8BS)+import Text.PrettyPrint (Doc)+import qualified Text.PrettyPrint as PP+import Prelude ()+ import Distribution.FieldGrammar.Class  newtype PrettyFieldGrammar s a = PrettyFG-    { fieldGrammarPretty :: CabalSpecVersion -> s -> [PrettyField ()]-    }+  { fieldGrammarPretty :: CabalSpecVersion -> s -> [PrettyField ()]+  }   deriving (Functor)  instance Applicative (PrettyFieldGrammar s) where-    pure _ = PrettyFG (\_ _ -> mempty)-    PrettyFG f <*> PrettyFG x = PrettyFG (\v s -> f v s <> x v s)+  pure _ = PrettyFG (\_ _ -> mempty)+  PrettyFG f <*> PrettyFG x = PrettyFG (\v s -> f v s <> x v s)  -- | We can use 'PrettyFieldGrammar' to pp print the @s@. --@@ -35,70 +36,77 @@ prettyFieldGrammar = flip fieldGrammarPretty  instance FieldGrammar Pretty PrettyFieldGrammar where-    blurFieldGrammar f (PrettyFG pp) = PrettyFG (\v -> pp v . aview f)+  blurFieldGrammar f (PrettyFG pp) = PrettyFG (\v -> pp v . aview f) -    uniqueFieldAla fn _pack l = PrettyFG $ \_v s ->-        ppField fn (pretty (pack' _pack (aview l s)))+  uniqueFieldAla fn _pack l = PrettyFG $ \_v s ->+    ppField fn (pretty (pack' _pack (aview l s))) -    booleanFieldDef fn l def = PrettyFG pp-      where-        pp _v s-            | b == def  = mempty-            | otherwise = ppField fn (PP.text (show b))-          where-            b = aview l s+  booleanFieldDef fn l def = PrettyFG pp+    where+      pp _v s+        | b == def = mempty+        | otherwise = ppField fn (PP.text (show b))+        where+          b = aview l s -    optionalFieldAla fn _pack l = PrettyFG pp-      where-        pp v s = case aview l s of-            Nothing -> mempty-            Just a  -> ppField fn (prettyVersioned v (pack' _pack a))+  optionalFieldAla fn _pack l = PrettyFG pp+    where+      pp v s = case aview l s of+        Nothing -> mempty+        Just a -> ppField fn (prettyVersioned v (pack' _pack a)) -    optionalFieldDefAla fn _pack l def = PrettyFG pp-      where-        pp v s-            | x == def  = mempty-            | otherwise = ppField fn (prettyVersioned v (pack' _pack x))-          where-            x = aview l s+  optionalFieldDefAla fn _pack l def = PrettyFG pp+    where+      pp v s+        | x == def = mempty+        | otherwise = ppField fn (prettyVersioned v (pack' _pack x))+        where+          x = aview l s -    freeTextField fn l = PrettyFG pp where-        pp v s = maybe mempty (ppField fn . showFT) (aview l s) where-            showFT | v >= CabalSpecV3_0 = showFreeTextV3-                   | otherwise          = showFreeText+  freeTextField fn l = PrettyFG pp+    where+      pp v s = maybe mempty (ppField fn . showFT) (aview l s)+        where+          showFT+            | v >= CabalSpecV3_0 = showFreeTextV3+            | otherwise = showFreeText -    -- it's ok to just show, as showFreeText of empty string is empty.-    freeTextFieldDef fn l = PrettyFG pp where-        pp v s = ppField fn (showFT (aview l s)) where-            showFT | v >= CabalSpecV3_0 = showFreeTextV3-                   | otherwise          = showFreeText+  -- it's ok to just show, as showFreeText of empty string is empty.+  freeTextFieldDef fn l = PrettyFG pp+    where+      pp v s = ppField fn (showFT (aview l s))+        where+          showFT+            | v >= CabalSpecV3_0 = showFreeTextV3+            | otherwise = showFreeText -    freeTextFieldDefST = defaultFreeTextFieldDefST+  freeTextFieldDefST = defaultFreeTextFieldDefST -    monoidalFieldAla fn _pack l = PrettyFG pp-      where-        pp v s = ppField fn (prettyVersioned v (pack' _pack (aview l s)))+  monoidalFieldAla fn _pack l = PrettyFG pp+    where+      pp v s = ppField fn (prettyVersioned v (pack' _pack (aview l s))) -    prefixedFields _fnPfx l = PrettyFG (\_ -> pp . aview l)-      where-        pp xs =-            -- always print the field, even its Doc is empty.-            -- i.e. don't use ppField-            [ PrettyField () (toUTF8BS n) $ PP.vcat $ map PP.text $ lines s-            | (n, s) <- xs-            -- fnPfx `isPrefixOf` n-            ]+  prefixedFields _fnPfx l = PrettyFG (\_ -> pp . aview l)+    where+      pp xs =+        -- always print the field, even its Doc is empty.+        -- i.e. don't use ppField+        [ PrettyField () (toUTF8BS n) $ PP.vcat $ map PP.text $ lines s+        | (n, s) <- xs+        -- fnPfx `isPrefixOf` n+        ] -    knownField _           = pure ()-    deprecatedSince _ _ x  = x-    -- TODO: as PrettyFieldGrammar isn't aware of cabal-version: we output the field-    -- this doesn't affect roundtrip as `removedIn` fields cannot be parsed-    -- so invalid documents can be only manually constructed.-    removedIn _ _ x        = x-    availableSince _ _     = id-    hiddenField _          = PrettyFG (\_ -> mempty)+  knownField _ = pure ()+  deprecatedSince _ _ x = x +  -- TODO: as PrettyFieldGrammar isn't aware of cabal-version: we output the field+  -- this doesn't affect roundtrip as `removedIn` fields cannot be parsed+  -- so invalid documents can be only manually constructed.+  removedIn _ _ x = x+  availableSince _ _ = id+  hiddenField _ = PrettyFG (\_ -> mempty)+ ppField :: FieldName -> Doc -> [PrettyField ()] ppField name fielddoc-    | PP.isEmpty fielddoc = []-    | otherwise        = [ PrettyField () name fielddoc ]+  | PP.isEmpty fielddoc = []+  | otherwise = [PrettyField () name fielddoc]

@@ -1,42 +1,49 @@ -- | Utilities to work with @.cabal@ like file structure.-module Distribution.Fields (-    -- * Types-    Field(..),-    Name(..),-    FieldLine(..),-    SectionArg(..),-    FieldName,+module Distribution.Fields+  ( -- * Types+    Field (..)+  , Name (..)+  , FieldLine (..)+  , SectionArg (..)+  , FieldName+     -- * Grammar and parsing-    ---    -- See "Distribution.Fields.Parser" for grammar.-    readFields,-    readFields',++  --+  -- See "Distribution.Fields.Parser" for grammar.+  , readFields+  , readFields'+     -- ** ParseResult-    ParseResult,-    runParseResult,-    parseWarning,-    parseWarnings,-    parseFailure,-    parseFatalFailure,+  , ParseResult+  , runParseResult+  , parseWarning+  , parseWarnings+  , parseFailure+  , parseFatalFailure+     -- ** Warnings-    PWarnType (..),-    PWarning (..),-    showPWarning,+  , PWarnType (..)+  , PWarning (..)+  , showPWarning+     -- ** Errors-    PError (..),-    showPError,+  , PError (..)+  , showPError+     -- * Pretty printing-    CommentPosition (..),-    PrettyField (..),-    showFields,+  , CommentPosition (..)+  , PrettyField (..)+  , showFields+     -- ** Transformation from Field-    genericFromParsecFields,-    fromParsecFields,-    ) where+  , genericFromParsecFields+  , fromParsecFields+  ) where  import Distribution.Fields.Field-import Distribution.Fields.Parser import Distribution.Fields.ParseResult+import Distribution.Fields.Parser import Distribution.Fields.Pretty import Distribution.Parsec.Error import Distribution.Parsec.Warning

@@ -1,47 +1,64 @@ {-# LANGUAGE OverloadedStrings #-}+ module Distribution.Fields.ConfVar (parseConditionConfVar, parseConditionConfVarFromClause) where -import Distribution.Compat.CharParsing     (char, integral)+import Distribution.Compat.CharParsing (char, integral) import Distribution.Compat.Prelude-import Distribution.Fields.Field           (SectionArg (..), Field(..))+import Distribution.Fields.Field (Field (..), SectionArg (..)) import Distribution.Fields.ParseResult-import Distribution.Parsec                 (Parsec (..), Position (..), runParsecParser)+import Distribution.Fields.Parser (readFields)+import Distribution.Parsec (Parsec (..), Position (..), runParsecParser) import Distribution.Parsec.FieldLineStream (fieldLineStreamFromBS) import Distribution.Types.Condition-import Distribution.Types.ConfVar          (ConfVar (..))-import Distribution.Fields.Parser          (readFields)+import Distribution.Types.ConfVar (ConfVar (..)) import Distribution.Version-       (anyVersion, earlierVersion, intersectVersionRanges, laterVersion, majorBoundVersion,-       mkVersion, noVersion, orEarlierVersion, orLaterVersion, thisVersion, unionVersionRanges,-       withinVersion)+  ( anyVersion+  , earlierVersion+  , intersectVersionRanges+  , laterVersion+  , majorBoundVersion+  , mkVersion+  , noVersion+  , orEarlierVersion+  , orLaterVersion+  , thisVersion+  , unionVersionRanges+  , withinVersion+  ) import Prelude () -import qualified Text.Parsec       as P-import qualified Text.Parsec.Pos   as P+import qualified Data.ByteString.Char8 as B8+import qualified Text.Parsec as P import qualified Text.Parsec.Error as P-import qualified Data.ByteString.Char8          as B8+import qualified Text.Parsec.Pos as P  parseConditionConfVarFromClause :: B8.ByteString -> Either P.ParseError (Condition ConfVar)-parseConditionConfVarFromClause x = readFields x >>= \r -> case r of-                                       (Section _ xs _ : _ ) -> P.runParser (parser <* P.eof) () "<condition>" xs-                                       _ -> Left $ P.newErrorMessage (P.Message "No fields in clause") (P.initialPos "<condition>")+parseConditionConfVarFromClause x =+  readFields x >>= \r -> case r of+    (Section _ xs _ : _) -> P.runParser (parser <* P.eof) () "<condition>" xs+    _ -> Left $ P.newErrorMessage (P.Message "No fields in clause") (P.initialPos "<condition>")  -- | Parse @'Condition' 'ConfVar'@ from section arguments provided by parsec -- based outline parser. parseConditionConfVar :: [SectionArg Position] -> ParseResult (Condition ConfVar) parseConditionConfVar args =-    -- The name of the input file is irrelevant, as we reformat the error message.-    case P.runParser (parser <* P.eof) () "<condition>" args of-        Right x  -> pure x-        Left err -> do-            -- Mangle the position to the actual one-            let ppos = P.errorPos err-            let epos = Position (P.sourceLine ppos) (P.sourceColumn ppos)-            let msg = P.showErrorMessages-                    "or" "unknown parse error" "expecting" "unexpected" "end of input"-                    (P.errorMessages err)-            parseFailure epos msg-            pure $ Lit True+  -- The name of the input file is irrelevant, as we reformat the error message.+  case P.runParser (parser <* P.eof) () "<condition>" args of+    Right x -> pure x+    Left err -> do+      -- Mangle the position to the actual one+      let ppos = P.errorPos err+      let epos = Position (P.sourceLine ppos) (P.sourceColumn ppos)+      let msg =+            P.showErrorMessages+              "or"+              "unknown parse error"+              "expecting"+              "unexpected"+              "end of input"+              (P.errorMessages err)+      parseFailure epos msg+      pure $ Lit True  type Parser = P.Parsec [SectionArg Position] () @@ -51,72 +68,77 @@ parser :: Parser (Condition ConfVar) parser = condOr   where-    condOr       = sepByNonEmpty condAnd (oper "||") >>= return . foldl1 COr-    condAnd      = sepByNonEmpty cond    (oper "&&") >>= return . foldl1 CAnd-    cond         = P.choice-         [ boolLiteral, parens condOr,  notCond, osCond, archCond, flagCond, implCond ]+    condOr = sepByNonEmpty condAnd (oper "||") >>= return . foldl1 COr+    condAnd = sepByNonEmpty cond (oper "&&") >>= return . foldl1 CAnd+    cond =+      P.choice+        [boolLiteral, parens condOr, notCond, osCond, archCond, flagCond, implCond] -    notCond      = CNot <$ oper "!" <*> cond+    notCond = CNot <$ oper "!" <*> cond -    boolLiteral  = Lit <$> boolLiteral'-    osCond       = Var . OS   <$ string "os"   <*> parens fromParsec-    flagCond     = Var . PackageFlag <$ string "flag" <*> parens fromParsec-    archCond     = Var . Arch <$ string "arch" <*> parens fromParsec-    implCond     = Var        <$ string "impl" <*> parens implCond'+    boolLiteral = Lit <$> boolLiteral'+    osCond = Var . OS <$ string "os" <*> parens fromParsec+    flagCond = Var . PackageFlag <$ string "flag" <*> parens fromParsec+    archCond = Var . Arch <$ string "arch" <*> parens fromParsec+    implCond = Var <$ string "impl" <*> parens implCond' -    implCond'    = Impl+    implCond' =+      Impl         <$> fromParsec         <*> P.option anyVersion versionRange      version = fromParsec-    versionStar  = mkVersion <$> fromParsec' versionStar' <* oper "*"+    versionStar = mkVersion <$> fromParsec' versionStar' <* oper "*"     versionStar' = some (integral <* char '.')      versionRange = expr       where-        expr = foldl1 unionVersionRanges     <$> sepByNonEmpty term   (oper "||")+        expr = foldl1 unionVersionRanges <$> sepByNonEmpty term (oper "||")         term = foldl1 intersectVersionRanges <$> sepByNonEmpty factor (oper "&&") -        factor = P.choice-            $ parens expr-            : parseAnyVersion-            : parseNoVersion-            : parseWildcardRange-            : map parseRangeOp rangeOps+        factor =+          P.choice $+            parens expr+              : parseAnyVersion+              : parseNoVersion+              : parseWildcardRange+              : map parseRangeOp rangeOps -        parseAnyVersion    = anyVersion <$ string "-any"-        parseNoVersion     = noVersion  <$ string "-none"+        parseAnyVersion = anyVersion <$ string "-any"+        parseNoVersion = noVersion <$ string "-none"          parseWildcardRange = P.try $ withinVersion <$ oper "==" <*> versionStar -        parseRangeOp (s,f) = P.try (f <$ oper s <*> version)-        rangeOps = [ ("<",  earlierVersion),-                     ("<=", orEarlierVersion),-                     (">",  laterVersion),-                     (">=", orLaterVersion),-                     ("^>=", majorBoundVersion),-                     ("==", thisVersion) ]+        parseRangeOp (s, f) = P.try (f <$ oper s <*> version)+        rangeOps =+          [ ("<", earlierVersion)+          , ("<=", orEarlierVersion)+          , (">", laterVersion)+          , (">=", orLaterVersion)+          , ("^>=", majorBoundVersion)+          , ("==", thisVersion)+          ]      -- Number token can have many dots in it: SecArgNum (Position 65 15) "7.6.1"     identBS = tokenPrim $ \t -> case t of-        SecArgName _ s -> Just s-        _              -> Nothing+      SecArgName _ s -> Just s+      _ -> Nothing      boolLiteral' = tokenPrim $ \t -> case t of-        SecArgName _ s-            | s == "True"  -> Just True-            | s == "true"  -> Just True-            | s == "False" -> Just False-            | s == "false" -> Just False-        _                  -> Nothing+      SecArgName _ s+        | s == "True" -> Just True+        | s == "true" -> Just True+        | s == "False" -> Just False+        | s == "false" -> Just False+      _ -> Nothing      string s = tokenPrim $ \t -> case t of-        SecArgName _ s' | s == s' -> Just ()-        _                         -> Nothing+      SecArgName _ s' | s == s' -> Just ()+      _ -> Nothing      oper o = tokenPrim $ \t -> case t of-        SecArgOther _ o' | o == o' -> Just ()-        _                          -> Nothing+      SecArgOther _ o' | o == o' -> Just ()+      _ -> Nothing      parens = P.between (oper "(") (oper ")") @@ -129,6 +151,6 @@     fromParsec = fromParsec' parsec      fromParsec' p = do-        bs <- identBS-        let fls = fieldLineStreamFromBS bs-        either (fail . show) pure (runParsecParser p "<fromParsec'>" fls)+      bs <- identBS+      let fls = fieldLineStreamFromBS bs+      either (fail . show) pure (runParsecParser p "<fromParsec'>" fls)

@@ -1,39 +1,46 @@-{-# LANGUAGE DeriveFoldable    #-}-{-# LANGUAGE DeriveFunctor     #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE StandaloneDeriving #-}+ -- | Cabal-like file AST types: 'Field', 'Section' etc -- -- These types are parametrized by an annotation.-module Distribution.Fields.Field (-    -- * Cabal file-    Field (..),-    fieldName,-    fieldAnn,-    fieldUniverse,-    FieldLine (..),-    fieldLineAnn,-    fieldLineBS,-    SectionArg (..),-    sectionArgAnn,+module Distribution.Fields.Field+  ( -- * Cabal file+    Field (..)+  , fieldName+  , fieldAnn+  , fieldUniverse+  , FieldLine (..)+  , fieldLineAnn+  , fieldLineBS+  , SectionArg (..)+  , sectionArgAnn+     -- * Name-    FieldName,-    Name (..),-    mkName,-    getName,-    nameAnn,-    -- * Conversions to String-    sectionArgsToString,-    fieldLinesToString,-    ) where+  , FieldName+  , Name (..)+  , mkName+  , getName+  , nameAnn -import           Data.ByteString             (ByteString)-import qualified Data.ByteString.Char8       as B-import qualified Data.Char                   as Char-import           Distribution.Compat.Prelude-import           Distribution.Pretty         (showTokenStr)-import           Distribution.Utils.Generic  (fromUTF8BS)-import           Prelude ()+    -- * Conversions to String+  , sectionArgsToString+  , fieldLinesToString+  ) where +import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as B+import qualified Data.Char as Char+import Distribution.Compat.Prelude+import Distribution.Pretty (showTokenStr)+import Distribution.Utils.Generic (fromUTF8BS)+import Prelude ()+#if MIN_VERSION_base(4,18,0)+import qualified Data.Foldable1 as F1+#endif  ------------------------------------------------------------------------------- -- Cabal file@@ -41,13 +48,16 @@  -- | A Cabal-like file consists of a series of fields (@foo: bar@) and sections (@library ...@). data Field ann-    = Field   !(Name ann) [FieldLine ann]-    | Section !(Name ann) [SectionArg ann] [Field ann]+  = Field !(Name ann) [FieldLine ann]+  | Section !(Name ann) [SectionArg ann] [Field ann]   deriving (Eq, Show, Functor, Foldable, Traversable) +-- | @since 3.12.0.0+deriving instance Ord ann => Ord (Field ann)+ -- | Section of field name fieldName :: Field ann -> Name ann-fieldName (Field n _ )    = n+fieldName (Field n _) = n fieldName (Section n _ _) = n  fieldAnn :: Field ann -> ann@@ -56,18 +66,20 @@ -- | All transitive descendants of 'Field', including itself. -- -- /Note:/ the resulting list is never empty.--- fieldUniverse :: Field ann -> [Field ann] fieldUniverse f@(Section _ _ fs) = f : concatMap fieldUniverse fs-fieldUniverse f@(Field _ _)      = [f]+fieldUniverse f@(Field _ _) = [f]  -- | A line of text representing the value of a field from a Cabal file. -- A field may contain multiple lines. -- -- /Invariant:/ 'ByteString' has no newlines.-data FieldLine ann  = FieldLine  !ann !ByteString+data FieldLine ann = FieldLine !ann !ByteString   deriving (Eq, Show, Functor, Foldable, Traversable) +-- | @since 3.12.0.0+deriving instance Ord ann => Ord (FieldLine ann)+ -- | @since 3.0.0.0 fieldLineAnn :: FieldLine ann -> ann fieldLineAnn (FieldLine ann _) = ann@@ -78,18 +90,21 @@  -- | Section arguments, e.g. name of the library data SectionArg ann-    = SecArgName  !ann !ByteString-      -- ^ identifier, or something which looks like number. Also many dot numbers, i.e. "7.6.3"-    | SecArgStr   !ann !ByteString-      -- ^ quoted string-    | SecArgOther !ann !ByteString-      -- ^ everything else, mm. operators (e.g. in if-section conditionals)+  = -- | identifier, or something which looks like number. Also many dot numbers, i.e. "7.6.3"+    SecArgName !ann !ByteString+  | -- | quoted string+    SecArgStr !ann !ByteString+  | -- | everything else, mm. operators (e.g. in if-section conditionals)+    SecArgOther !ann !ByteString   deriving (Eq, Show, Functor, Foldable, Traversable) +-- | @since 3.12.0.0+deriving instance Ord ann => Ord (SectionArg ann)+ -- | Extract annotation from 'SectionArg'. sectionArgAnn :: SectionArg ann -> ann-sectionArgAnn (SecArgName ann _)  = ann-sectionArgAnn (SecArgStr ann _)   = ann+sectionArgAnn (SecArgName ann _) = ann+sectionArgAnn (SecArgStr ann _) = ann sectionArgAnn (SecArgOther ann _) = ann  -------------------------------------------------------------------------------@@ -101,9 +116,12 @@ -- | A field name. -- -- /Invariant/: 'ByteString' is lower-case ASCII.-data Name ann  = Name       !ann !FieldName+data Name ann = Name !ann !FieldName   deriving (Eq, Show, Functor, Foldable, Traversable) +-- | @since 3.12.0.0+deriving instance Ord ann => Ord (Name ann)+ mkName :: ann -> FieldName -> Name ann mkName ann bs = Name ann (B.map Char.toLower bs) @@ -121,10 +139,11 @@ -- -- @since 3.6.0.0 sectionArgsToString :: [SectionArg ann] -> String-sectionArgsToString = unwords . map toStr where+sectionArgsToString = unwords . map toStr+  where     toStr :: SectionArg ann -> String-    toStr (SecArgName _ bs)  = showTokenStr (fromUTF8BS bs)-    toStr (SecArgStr _ bs)   = showTokenStr (fromUTF8BS bs)+    toStr (SecArgName _ bs) = showTokenStr (fromUTF8BS bs)+    toStr (SecArgStr _ bs) = showTokenStr (fromUTF8BS bs)     toStr (SecArgOther _ bs) = fromUTF8BS bs  -- | Convert @['FieldLine']@ into String.@@ -135,7 +154,34 @@ -- @since 3.6.0.0 fieldLinesToString :: [FieldLine ann] -> String fieldLinesToString =-    -- intercalate to avoid trailing newline.-    intercalate "\n" . map toStr+  -- intercalate to avoid trailing newline.+  intercalate "\n" . map toStr   where     toStr (FieldLine _ bs) = fromUTF8BS bs++-------------------------------------------------------------------------------+-- Foldable1+-------------------------------------------------------------------------------++#if MIN_VERSION_base(4,18,0)++-- | @since 3.12.0.0+instance F1.Foldable1 Field where+  foldMap1 f (Field x ys) =+    F1.fold1 (F1.foldMap1 f x :| map (F1.foldMap1 f) ys)+  foldMap1 f (Section x ys zs) =+    F1.fold1 (F1.foldMap1 f x :| map (F1.foldMap1 f) ys ++ map (F1.foldMap1 f) zs)++-- | @since 3.12.0.0+instance F1.Foldable1 FieldLine where+  foldMap1 = (. fieldLineAnn)++-- | @since 3.12.0.0+instance F1.Foldable1 SectionArg where+  foldMap1 = (. sectionArgAnn)++-- | @since 3.12.0.0+instance F1.Foldable1 Name where+  foldMap1 = (. nameAnn)++#endif

@@ -1,589 +0,0 @@-{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-missing-signatures #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE MagicHash #-}-{-# LINE 1 "templates/Lexer.x" #-}--------------------------------------------------------------------------------- |--- Module      :  Distribution.Fields.Lexer--- License     :  BSD3------ Maintainer  :  cabal-devel@haskell.org--- Portability :  portable------ Lexer for the cabal files.-{-# LANGUAGE CPP #-}-{-# LANGUAGE BangPatterns #-}-#ifdef CABAL_PARSEC_DEBUG-{-# LANGUAGE PatternGuards #-}-#endif-{-# OPTIONS_GHC -fno-warn-unused-imports #-}-module Distribution.Fields.Lexer-  (ltest, lexToken, Token(..), LToken(..)-  ,bol_section, in_section, in_field_layout, in_field_braces-  ,mkLexState) where---- [Note: bootstrapping parsec parser]------ We manually produce the `Lexer.hs` file from `boot/Lexer.x` (make lexer)--- because bootstrapping cabal-install would be otherwise tricky.--- Alex is (atm) tricky package to build, cabal-install has some magic--- to move bundled generated files in place, so rather we don't depend--- on it before we can build it ourselves.--- Therefore there is one thing less to worry in bootstrap.sh, which is a win.------ See also https://github.com/haskell/cabal/issues/4633-----import Prelude ()-import qualified Prelude as Prelude-import Distribution.Compat.Prelude--import Distribution.Fields.LexerMonad-import Distribution.Parsec.Position (Position (..), incPos, retPos)-import Data.ByteString (ByteString)-import qualified Data.ByteString as B-import qualified Data.ByteString.Char8 as B.Char8-import qualified Data.Word as Word--#ifdef CABAL_PARSEC_DEBUG-import Debug.Trace-import qualified Data.Vector as V-import qualified Data.Text   as T-import qualified Data.Text.Encoding as T-import qualified Data.Text.Encoding.Error as T-#endif-#if __GLASGOW_HASKELL__ >= 603-#include "ghcconfig.h"-#elif defined(__GLASGOW_HASKELL__)-#include "config.h"-#endif-#if __GLASGOW_HASKELL__ >= 503-import Data.Array-#else-import Array-#endif-#if __GLASGOW_HASKELL__ >= 503-import Data.Array.Base (unsafeAt)-import GHC.Exts-#else-import GlaExts-#endif-alex_tab_size :: Int-alex_tab_size = 8-alex_base :: AlexAddr-alex_base = AlexA#-  "\x12\xff\xff\xff\xf9\xff\xff\xff\xfb\xff\xff\xff\x01\x00\x00\x00\x2f\x00\x00\x00\x50\x00\x00\x00\xd0\x00\x00\x00\x50\x01\x00\x00\xd0\x01\x00\x00\x50\x02\x00\x00\x81\x00\x00\x00\xfe\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x69\xff\xff\xff\x03\x00\x00\x00\x09\x00\x00\x00\xf8\x00\x00\x00\xe2\xff\xff\xff\xd0\x02\x00\x00\x71\xff\xff\xff\x0b\x00\x00\x00\x0d\x00\x00\x00\x00\x00\x00\x00\x5f\xff\xff\xff\x5d\xff\xff\xff\x00\x00\x00\x00\xf0\x02\x00\x00\x00\x00\x00\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x03\x00\x00\x6a\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x66\x03\x00\x00\x98\x00\x00\x00\x80\xff\xff\xff\x00\x00\x00\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x03\x00\x00\x00\x00\x00\x00\xef\x03\x00\x00\x13\x04\x00\x00"#--alex_table :: AlexAddr-alex_table = AlexA#-  "\x00\x00\x18\x00\x11\x00\x17\x00\x02\x00\x17\x00\x16\x00\x0b\x00\x16\x00\x0f\x00\x03\x00\x17\x00\x0f\x00\x17\x00\x16\x00\x13\x00\x16\x00\x15\x00\x10\x00\x17\x00\x15\x00\x17\x00\x16\x00\x17\x00\x16\x00\x11\x00\x19\x00\x02\x00\x1a\x00\x1c\x00\x0b\x00\x22\x00\x10\x00\x03\x00\x27\x00\x0f\x00\x00\x00\x00\x00\x12\x00\x00\x00\x12\x00\x10\x00\x00\x00\x15\x00\x00\x00\x00\x00\x12\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x21\x00\x1c\x00\xff\xff\xff\xff\x1d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x21\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x00\x22\x00\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x00\x00\x00\x00\x00\x21\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x00\x00\x0c\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x21\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x00\x00\x1e\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x00\x00\x00\x00\x14\x00\x00\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x00\x00\x00\x0e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x26\x00\x00\x00\x14\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0b\x00\x27\x00\xff\xff\xff\xff\x28\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0b\x00\x2d\x00\x1b\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x00\x00\x2c\x00\x2c\x00\x2d\x00\x2d\x00\x2d\x00\x08\x00\x09\x00\x2d\x00\xff\xff\x11\x00\x17\x00\x00\x00\x00\x00\x16\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x00\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2c\x00\x2d\x00\x2c\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2a\x00\x2d\x00\x29\x00\x2d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x00\x00\xff\xff\xff\xff\x2d\x00\x2d\x00\x2d\x00\x0a\x00\x09\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x2d\x00\xff\xff\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x2d\x00\xff\xff\x2d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x00\x00\xff\xff\xff\xff\x2d\x00\x2d\x00\x2d\x00\x09\x00\x09\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x2d\x00\xff\xff\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x2d\x00\xff\xff\x2d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x2e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\xff\xff\x2d\x00\xff\xff\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2d\x00\x00\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2d\x00\x00\x00\x2d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x2e\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x00\x00\x2f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x30\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#--alex_check :: AlexAddr-alex_check = AlexA#-  "\xff\xff\xef\x00\x09\x00\x0a\x00\x09\x00\x0a\x00\x0d\x00\x09\x00\x0d\x00\xa0\x00\x09\x00\x0a\x00\x09\x00\x0a\x00\x0d\x00\x2d\x00\x0d\x00\xa0\x00\x09\x00\x0a\x00\x09\x00\x0a\x00\x0d\x00\x0a\x00\x0d\x00\x20\x00\xbb\x00\x20\x00\xbf\x00\x0a\x00\x20\x00\x0a\x00\xa0\x00\x20\x00\x0a\x00\x20\x00\xff\xff\xff\xff\x2d\x00\xff\xff\x2d\x00\x20\x00\xff\xff\x20\x00\xff\xff\xff\xff\x2d\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\xff\xff\x7d\x00\xff\xff\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x20\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\xff\xff\x7d\x00\xff\xff\x7f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\xc2\x00\xff\xff\xc2\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc2\x00\xff\xff\xc2\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc2\x00\xff\xff\xc2\x00\xff\xff\x7f\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x7f\x00\x09\x00\x0a\x00\xff\xff\xff\xff\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5b\x00\x5c\x00\x5d\x00\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5b\x00\x5c\x00\x5d\x00\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xc2\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5b\x00\x5c\x00\x5d\x00\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5b\x00\x5c\x00\x5d\x00\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\xff\xff\xff\xff\x22\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\xff\xff\x7f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x7f\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\xff\xff\x7d\x00\x21\x00\x7f\x00\x23\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7c\x00\xff\xff\x7e\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\xff\xff\xff\xff\x22\x00\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\xff\xff\xff\xff\x22\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7f\x00\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#--alex_deflt :: AlexAddr-alex_deflt = AlexA#-  "\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\x24\x00\x07\x00\x07\x00\x07\x00\x07\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x13\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\xff\xff\x24\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1b\x00"#--alex_accept = listArray (0 :: Int, 48)-  [ AlexAcc 30-  , AlexAcc 29-  , AlexAcc 28-  , AlexAcc 27-  , AlexAccNone-  , AlexAccNone-  , AlexAccNone-  , AlexAcc 26-  , AlexAcc 25-  , AlexAcc 24-  , AlexAccSkip-  , AlexAccSkip-  , AlexAcc 23-  , AlexAcc 22-  , AlexAccNone-  , AlexAcc 21-  , AlexAcc 20-  , AlexAccNone-  , AlexAccNone-  , AlexAccSkip-  , AlexAccNone-  , AlexAccNone-  , AlexAcc 19-  , AlexAcc 18-  , AlexAccNone-  , AlexAccNone-  , AlexAcc 17-  , AlexAccNone-  , AlexAcc 16-  , AlexAcc 15-  , AlexAcc 14-  , AlexAcc 13-  , AlexAcc 12-  , AlexAccSkip-  , AlexAcc 11-  , AlexAcc 10-  , AlexAcc 9-  , AlexAccSkip-  , AlexAccNone-  , AlexAcc 8-  , AlexAcc 7-  , AlexAcc 6-  , AlexAcc 5-  , AlexAcc 4-  , AlexAcc 3-  , AlexAcc 2-  , AlexAcc 1-  , AlexAcc 0-  , AlexAccNone-  ]--alex_actions = array (0 :: Int, 31)-  [ (30,alex_action_0)-  , (29,alex_action_20)-  , (28,alex_action_16)-  , (27,alex_action_3)-  , (26,alex_action_8)-  , (25,alex_action_8)-  , (24,alex_action_8)-  , (23,alex_action_5)-  , (22,alex_action_4)-  , (21,alex_action_3)-  , (20,alex_action_16)-  , (19,alex_action_1)-  , (18,alex_action_1)-  , (17,alex_action_0)-  , (16,alex_action_25)-  , (15,alex_action_25)-  , (14,alex_action_24)-  , (13,alex_action_23)-  , (12,alex_action_22)-  , (11,alex_action_19)-  , (10,alex_action_19)-  , (9,alex_action_18)-  , (8,alex_action_15)-  , (7,alex_action_15)-  , (6,alex_action_14)-  , (5,alex_action_13)-  , (4,alex_action_12)-  , (3,alex_action_11)-  , (2,alex_action_10)-  , (1,alex_action_9)-  , (0,alex_action_9)-  ]--{-# LINE 151 "templates/Lexer.x" #-}--- | Tokens of outer cabal file structure. Field values are treated opaquely.-data Token = TokSym   !ByteString       -- ^ Haskell-like identifier, number or operator-           | TokStr   !ByteString       -- ^ String in quotes-           | TokOther !ByteString       -- ^ Operators and parens-           | Indent   !Int              -- ^ Indentation token-           | TokFieldLine !ByteString   -- ^ Lines after @:@-           | Colon-           | OpenBrace-           | CloseBrace-           | EOF-           | LexicalError InputStream --TODO: add separate string lexical error-  deriving Show--data LToken = L !Position !Token-  deriving Show--toki :: (ByteString -> Token) -> Position -> Int -> ByteString -> Lex LToken-toki t pos  len  input = return $! L pos (t (B.take len input))--tok :: Token -> Position -> Int -> ByteString -> Lex LToken-tok  t pos _len _input = return $! L pos t--checkLeadingWhitespace :: Position -> Int -> ByteString -> Lex Int-checkLeadingWhitespace pos len bs-    | B.any (== 9) (B.take len bs) = do-        addWarningAt pos LexWarningTab-        checkWhitespace pos len bs-    | otherwise = checkWhitespace pos len bs--checkWhitespace :: Position -> Int -> ByteString -> Lex Int-checkWhitespace pos len bs-    | B.any (== 194) (B.take len bs) = do-        addWarningAt pos LexWarningNBSP-        return $ len - B.count 194 (B.take len bs)-    | otherwise = return len---- -------------------------------------------------------------------------------- The input type--type AlexInput = InputStream--alexInputPrevChar :: AlexInput -> Char-alexInputPrevChar _ = error "alexInputPrevChar not used"--alexGetByte :: AlexInput -> Maybe (Word.Word8,AlexInput)-alexGetByte = B.uncons--lexicalError :: Position -> InputStream -> Lex LToken-lexicalError pos inp = do-  setInput B.empty-  return $! L pos (LexicalError inp)--lexToken :: Lex LToken-lexToken = do-  pos <- getPos-  inp <- getInput-  st  <- getStartCode-  case alexScan inp st of-    AlexEOF -> return (L pos EOF)-    AlexError inp' ->-        let !len_bytes = B.length inp - B.length inp' in-            --FIXME: we want len_chars here really-            -- need to decode utf8 up to this point-        lexicalError (incPos len_bytes pos) inp'-    AlexSkip  inp' len_chars -> do-        checkPosition pos inp inp' len_chars-        adjustPos (incPos len_chars)-        setInput inp'-        lexToken-    AlexToken inp' len_chars action -> do-        checkPosition pos inp inp' len_chars-        adjustPos (incPos len_chars)-        setInput inp'-        let !len_bytes = B.length inp - B.length inp'-        t <- action pos len_bytes inp-        --traceShow t $ return tok-        return t--checkPosition :: Position -> ByteString -> ByteString -> Int -> Lex ()-#ifdef CABAL_PARSEC_DEBUG-checkPosition pos@(Position lineno colno) inp inp' len_chars = do-    text_lines <- getDbgText-    let len_bytes = B.length inp - B.length inp'-        pos_txt   | lineno-1 < V.length text_lines = T.take len_chars (T.drop (colno-1) (text_lines V.! (lineno-1)))-                  | otherwise = T.empty-        real_txt  = B.take len_bytes inp-    when (pos_txt /= T.decodeUtf8 real_txt) $-      traceShow (pos, pos_txt, T.decodeUtf8 real_txt) $-      traceShow (take 3 (V.toList text_lines)) $ return ()-  where-    getDbgText = Lex $ \s@LexState{ dbgText = txt } -> LexResult s txt-#else-checkPosition _ _ _ _ = return ()-#endif--lexAll :: Lex [LToken]-lexAll = do-  t <- lexToken-  case t of-    L _ EOF -> return [t]-    _       -> do ts <- lexAll-                  return (t : ts)--ltest :: Int -> String -> Prelude.IO ()-ltest code s =-  let (ws, xs) = execLexer (setStartCode code >> lexAll) (B.Char8.pack s)-   in traverse_ print ws >> traverse_ print xs--mkLexState :: ByteString -> LexState-mkLexState input = LexState-  { curPos   = Position 1 1-  , curInput = input-  , curCode  = 0-  , warnings = []-#ifdef CABAL_PARSEC_DEBUG-  , dbgText  = V.fromList . lines' . T.decodeUtf8With T.lenientDecode $ input-#endif-  }--#ifdef CABAL_PARSEC_DEBUG-lines' :: T.Text -> [T.Text]-lines' s1-  | T.null s1 = []-  | otherwise = case T.break (\c -> c == '\r' || c == '\n') s1 of-                  (l, s2) | Just (c,s3) <- T.uncons s2-                         -> case T.uncons s3 of-                              Just ('\n', s4) | c == '\r' -> l `T.snoc` '\r' `T.snoc` '\n' : lines' s4-                              _                           -> l `T.snoc` c : lines' s3--                          | otherwise-                         -> [l]-#endif--bol_field_braces,bol_field_layout,bol_section,in_field_braces,in_field_layout,in_section :: Int-bol_field_braces = 1-bol_field_layout = 2-bol_section = 3-in_field_braces = 4-in_field_layout = 5-in_section = 6-alex_action_0 = \pos len _ -> do-              when (len /= 0) $ addWarningAt pos LexWarningBOM-              setStartCode bol_section-              lexToken-alex_action_1 = \pos len inp -> checkWhitespace pos len inp >> adjustPos retPos >> lexToken-alex_action_3 = \pos len inp -> checkLeadingWhitespace pos len inp >>-                                     if B.length inp == len-                                       then return (L pos EOF)-                                       else setStartCode in_section-                                         >> return (L pos (Indent len))-alex_action_4 = tok  OpenBrace-alex_action_5 = tok  CloseBrace-alex_action_8 = toki TokSym-alex_action_9 = \pos len inp -> return $! L pos (TokStr (B.take (len - 2) (B.tail inp)))-alex_action_10 = toki TokOther-alex_action_11 = toki TokOther-alex_action_12 = tok  Colon-alex_action_13 = tok  OpenBrace-alex_action_14 = tok  CloseBrace-alex_action_15 = \_ _ _ -> adjustPos retPos >> setStartCode bol_section >> lexToken-alex_action_16 = \pos len inp -> checkLeadingWhitespace pos len inp >>= \len' ->-                                  if B.length inp == len-                                    then return (L pos EOF)-                                    else setStartCode in_field_layout-                                      >> return (L pos (Indent len'))-alex_action_18 = toki TokFieldLine-alex_action_19 = \_ _ _ -> adjustPos retPos >> setStartCode bol_field_layout >> lexToken-alex_action_20 = \_ _ _ -> setStartCode in_field_braces >> lexToken-alex_action_22 = toki TokFieldLine-alex_action_23 = tok  OpenBrace-alex_action_24 = tok  CloseBrace-alex_action_25 = \_ _ _ -> adjustPos retPos >> setStartCode bol_field_braces >> lexToken--#define ALEX_GHC 1-#define ALEX_LATIN1 1-#define ALEX_NOPRED 1--- -------------------------------------------------------------------------------- ALEX TEMPLATE------ This code is in the PUBLIC DOMAIN; you may copy it freely and use--- it for any purpose whatsoever.---- -------------------------------------------------------------------------------- INTERNALS and main scanner engine--#ifdef ALEX_GHC-#  define ILIT(n) n#-#  define IBOX(n) (I# (n))-#  define FAST_INT Int#--- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex.-#  if __GLASGOW_HASKELL__ > 706-#    define GTE(n,m) (tagToEnum# (n >=# m))-#    define EQ(n,m) (tagToEnum# (n ==# m))-#  else-#    define GTE(n,m) (n >=# m)-#    define EQ(n,m) (n ==# m)-#  endif-#  define PLUS(n,m) (n +# m)-#  define MINUS(n,m) (n -# m)-#  define TIMES(n,m) (n *# m)-#  define NEGATE(n) (negateInt# (n))-#  define IF_GHC(x) (x)-#else-#  define ILIT(n) (n)-#  define IBOX(n) (n)-#  define FAST_INT Int-#  define GTE(n,m) (n >= m)-#  define EQ(n,m) (n == m)-#  define PLUS(n,m) (n + m)-#  define MINUS(n,m) (n - m)-#  define TIMES(n,m) (n * m)-#  define NEGATE(n) (negate (n))-#  define IF_GHC(x)-#endif--#ifdef ALEX_GHC-data AlexAddr = AlexA# Addr#--- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex.-#if __GLASGOW_HASKELL__ < 503-uncheckedShiftL# = shiftL#-#endif--{-# INLINE alexIndexInt16OffAddr #-}-alexIndexInt16OffAddr :: AlexAddr -> Int# -> Int#-alexIndexInt16OffAddr (AlexA# arr) off =-#ifdef WORDS_BIGENDIAN-  narrow16Int# i-  where-        i    = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low)-        high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))-        low  = int2Word# (ord# (indexCharOffAddr# arr off'))-        off' = off *# 2#-#else-#if __GLASGOW_HASKELL__ >= 901-  int16ToInt#-#endif-    (indexInt16OffAddr# arr off)-#endif-#else-alexIndexInt16OffAddr arr off = arr ! off-#endif--#ifdef ALEX_GHC-{-# INLINE alexIndexInt32OffAddr #-}-alexIndexInt32OffAddr :: AlexAddr -> Int# -> Int#-alexIndexInt32OffAddr (AlexA# arr) off =-#ifdef WORDS_BIGENDIAN-  narrow32Int# i-  where-   i    = word2Int# ((b3 `uncheckedShiftL#` 24#) `or#`-                     (b2 `uncheckedShiftL#` 16#) `or#`-                     (b1 `uncheckedShiftL#` 8#) `or#` b0)-   b3   = int2Word# (ord# (indexCharOffAddr# arr (off' +# 3#)))-   b2   = int2Word# (ord# (indexCharOffAddr# arr (off' +# 2#)))-   b1   = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))-   b0   = int2Word# (ord# (indexCharOffAddr# arr off'))-   off' = off *# 4#-#else-#if __GLASGOW_HASKELL__ >= 901-  int32ToInt#-#endif-    (indexInt32OffAddr# arr off)-#endif-#else-alexIndexInt32OffAddr arr off = arr ! off-#endif--#ifdef ALEX_GHC--#if __GLASGOW_HASKELL__ < 503-quickIndex arr i = arr ! i-#else--- GHC >= 503, unsafeAt is available from Data.Array.Base.-quickIndex = unsafeAt-#endif-#else-quickIndex arr i = arr ! i-#endif---- -------------------------------------------------------------------------------- Main lexing routines--data AlexReturn a-  = AlexEOF-  | AlexError  !AlexInput-  | AlexSkip   !AlexInput !Int-  | AlexToken  !AlexInput !Int a---- alexScan :: AlexInput -> StartCode -> AlexReturn a-alexScan input__ IBOX(sc)-  = alexScanUser undefined input__ IBOX(sc)--alexScanUser user__ input__ IBOX(sc)-  = case alex_scan_tkn user__ input__ ILIT(0) input__ sc AlexNone of-  (AlexNone, input__') ->-    case alexGetByte input__ of-      Nothing ->-#ifdef ALEX_DEBUG-                                   trace ("End of input.") $-#endif-                                   AlexEOF-      Just _ ->-#ifdef ALEX_DEBUG-                                   trace ("Error.") $-#endif-                                   AlexError input__'--  (AlexLastSkip input__'' len, _) ->-#ifdef ALEX_DEBUG-    trace ("Skipping.") $-#endif-    AlexSkip input__'' len--  (AlexLastAcc k input__''' len, _) ->-#ifdef ALEX_DEBUG-    trace ("Accept.") $-#endif-    AlexToken input__''' len (alex_actions ! k)---- Push the input through the DFA, remembering the most recent accepting--- state it encountered.--alex_scan_tkn user__ orig_input len input__ s last_acc =-  input__ `seq` -- strict in the input-  let-  new_acc = (check_accs (alex_accept `quickIndex` IBOX(s)))-  in-  new_acc `seq`-  case alexGetByte input__ of-     Nothing -> (new_acc, input__)-     Just (c, new_input) ->-#ifdef ALEX_DEBUG-      trace ("State: " ++ show IBOX(s) ++ ", char: " ++ show c) $-#endif-      case fromIntegral c of { IBOX(ord_c) ->-        let-                base   = alexIndexInt32OffAddr alex_base s-                offset = PLUS(base,ord_c)--                new_s = if GTE(offset,ILIT(0))-                          && let check  = alexIndexInt16OffAddr alex_check offset-                             in  EQ(check,ord_c)-                          then alexIndexInt16OffAddr alex_table offset-                          else alexIndexInt16OffAddr alex_deflt s-        in-        case new_s of-            ILIT(-1) -> (new_acc, input__)-                -- on an error, we want to keep the input *before* the-                -- character that failed, not after.-            _ -> alex_scan_tkn user__ orig_input-#ifdef ALEX_LATIN1-                   PLUS(len,ILIT(1))-                   -- issue 119: in the latin1 encoding, *each* byte is one character-#else-                   (if c < 0x80 || c >= 0xC0 then PLUS(len,ILIT(1)) else len)-                   -- note that the length is increased ONLY if this is the 1st byte in a char encoding)-#endif-                   new_input new_s new_acc-      }-  where-        check_accs (AlexAccNone) = last_acc-        check_accs (AlexAcc a  ) = AlexLastAcc a input__ IBOX(len)-        check_accs (AlexAccSkip) = AlexLastSkip  input__ IBOX(len)-#ifndef ALEX_NOPRED-        check_accs (AlexAccPred a predx rest)-           | predx user__ orig_input IBOX(len) input__-           = AlexLastAcc a input__ IBOX(len)-           | otherwise-           = check_accs rest-        check_accs (AlexAccSkipPred predx rest)-           | predx user__ orig_input IBOX(len) input__-           = AlexLastSkip input__ IBOX(len)-           | otherwise-           = check_accs rest-#endif--data AlexLastAcc-  = AlexNone-  | AlexLastAcc !Int !AlexInput !Int-  | AlexLastSkip     !AlexInput !Int--data AlexAcc user-  = AlexAccNone-  | AlexAcc Int-  | AlexAccSkip-#ifndef ALEX_NOPRED-  | AlexAccPred Int (AlexAccPred user) (AlexAcc user)-  | AlexAccSkipPred (AlexAccPred user) (AlexAcc user)--type AlexAccPred user = user -> AlexInput -> Int -> AlexInput -> Bool---- -------------------------------------------------------------------------------- Predicates on a rule--alexAndPred p1 p2 user__ in1 len in2-  = p1 user__ in1 len in2 && p2 user__ in1 len in2----alexPrevCharIsPred :: Char -> AlexAccPred _-alexPrevCharIs c _ input__ _ _ = c == alexInputPrevChar input__--alexPrevCharMatches f _ input__ _ _ = f (alexInputPrevChar input__)----alexPrevCharIsOneOfPred :: Array Char Bool -> AlexAccPred _-alexPrevCharIsOneOf arr _ input__ _ _ = arr ! alexInputPrevChar input__----alexRightContext :: Int -> AlexAccPred _-alexRightContext IBOX(sc) user__ _ _ input__ =-     case alex_scan_tkn user__ input__ ILIT(0) input__ sc AlexNone of-          (AlexNone, _) -> False-          _ -> True-        -- TODO: there's no need to find the longest-        -- match when checking the right context, just-        -- the first match will do.-#endif

@@ -0,0 +1,292 @@+{+-----------------------------------------------------------------------------+-- |+-- Module      :  Distribution.Fields.Lexer+-- License     :  BSD3+--+-- Maintainer  :  cabal-devel@haskell.org+-- Portability :  portable+--+-- Lexer for the cabal files.+{-# LANGUAGE CPP #-}+{-# LANGUAGE BangPatterns #-}+#ifdef CABAL_PARSEC_DEBUG+{-# LANGUAGE PatternGuards #-}+#endif+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+module Distribution.Fields.Lexer+  (ltest, lexToken, Token(..), LToken(..)+  ,bol_section, in_section, in_field_layout, in_field_braces+  ,mkLexState) where++import Prelude ()+import qualified Prelude as Prelude+import Distribution.Compat.Prelude++import Distribution.Fields.LexerMonad+import Distribution.Parsec.Position (Position (..), incPos, retPos)+import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as B.Char8+import qualified Data.Word as Word++#ifdef CABAL_PARSEC_DEBUG+import Debug.Trace+import qualified Data.Vector as V+import qualified Data.Text   as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.Encoding.Error as T+#endif++}+-- Various character classes++%encoding "latin1"++$space           = \          -- single space char+$ctlchar         = [\x0-\x1f \x7f]+$printable       = \x0-\xff # $ctlchar   -- so no \n \r+$symbol'         = [ \, \= \< \> \+ \* \& \| \! \$ \% \^ \@ \# \? \/ \\ \~ ]+$symbol          = [$symbol' \- \.]+$spacetab        = [$space \t]++$paren           = [ \( \) \[ \] ]+$field_layout    = [$printable \t]+$field_layout'   = [$printable] # [$space]+$field_braces    = [$printable \t] # [\{ \}]+$field_braces'   = [$printable] # [\{ \} $space]+$comment         = [$printable \t]+$namecore        = [$printable] # [$space \: \" \{ \} $paren $symbol']+$instr           = [$printable $space] # [\"]+$instresc        = $printable++@bom          = \xef \xbb \xbf+@nbsp         = \xc2 \xa0+@nbspspacetab = ($spacetab | @nbsp)+@nbspspace    = ($space | @nbsp)+@nl           = \n | \r\n | \r+@name         = $namecore++@string       = \" ( $instr | \\ $instresc )* \"+@oplike       = $symbol++++tokens :-++<0> {+  @bom?  { \pos len _ -> do+              when (len /= 0) $ addWarningAt pos LexWarningBOM+              setPos pos -- reset position as if BOM didn't exist+              setStartCode bol_section+              lexToken+         }+}++<bol_section, bol_field_layout, bol_field_braces> {+  @nbspspacetab* @nl         { \pos len inp -> checkWhitespace pos len inp >> adjustPos retPos >> lexToken }+  -- no @nl here to allow for comments on last line of the file with no trailing \n+  $spacetab* "--" $comment*  ;  -- TODO: check the lack of @nl works here+                                -- including counting line numbers+}++<bol_section> {+  @nbspspacetab*   { \pos len inp -> checkLeadingWhitespace pos len inp >>= \len' ->+                                     -- len' is character whitespace length (counting nbsp as one)+                                     if B.length inp == len+                                       then return (L pos EOF)+                                       else do+                                        -- Small hack: if char and byte length mismatch+                                        -- subtract the difference, so lexToken will count position correctly.+                                        -- Proper (and slower) fix is to count utf8 length in lexToken+                                        when (len' /= len) $ adjustPos (incPos (len' - len))+                                        setStartCode in_section+                                        return (L pos (Indent len')) }+  $spacetab* \{    { tok  OpenBrace }+  $spacetab* \}    { tok  CloseBrace }+}++<in_section> {+  $spacetab+   ; --TODO: don't allow tab as leading space++  "--" $comment* ;++  @name        { toki TokSym }+  @string      { \pos len inp -> return $! L pos (TokStr (B.take (len - 2) (B.tail inp))) }+  @oplike      { toki TokOther }+  $paren       { toki TokOther }+  \:           { tok  Colon }+  \{           { tok  OpenBrace }+  \}           { tok  CloseBrace }+  @nl          { \_ _ _ -> adjustPos retPos >> setStartCode bol_section >> lexToken }+}++<bol_field_layout> {+  @nbspspacetab* { \pos len inp -> checkLeadingWhitespace pos len inp >>= \len' ->+                                  if B.length inp == len+                                    then return (L pos EOF)+                                    else do+                                      -- Small hack: if char and byte length mismatch+                                      -- subtract the difference, so lexToken will count position correctly.+                                      -- Proper (and slower) fix is to count utf8 length in lexToken+                                      when (len' /= len) $ adjustPos (incPos (len' - len))+                                      setStartCode in_field_layout+                                      return (L pos (Indent len')) }+}++<in_field_layout> {+  $spacetab+;+  $field_layout' $field_layout*  { toki TokFieldLine }+  @nl             { \_ _ _ -> adjustPos retPos >> setStartCode bol_field_layout >> lexToken }+}++<bol_field_braces> {+   ()                { \_ _ _ -> setStartCode in_field_braces >> lexToken }+}++<in_field_braces> {+  $spacetab+;+  $field_braces' $field_braces*    { toki TokFieldLine }+  \{                { tok  OpenBrace  }+  \}                { tok  CloseBrace }+  @nl               { \_ _ _ -> adjustPos retPos >> setStartCode bol_field_braces >> lexToken }+}++{++-- | Tokens of outer cabal file structure. Field values are treated opaquely.+data Token = TokSym   !ByteString       -- ^ Haskell-like identifier, number or operator+           | TokStr   !ByteString       -- ^ String in quotes+           | TokOther !ByteString       -- ^ Operators and parens+           | Indent   !Int              -- ^ Indentation token+           | TokFieldLine !ByteString   -- ^ Lines after @:@+           | Colon+           | OpenBrace+           | CloseBrace+           | EOF+           | LexicalError InputStream --TODO: add separate string lexical error+  deriving Show++data LToken = L !Position !Token+  deriving Show++toki :: (ByteString -> Token) -> Position -> Int -> ByteString -> Lex LToken+toki t pos  len  input = return $! L pos (t (B.take len input))++tok :: Token -> Position -> Int -> ByteString -> Lex LToken+tok  t pos _len _input = return $! L pos t++checkLeadingWhitespace :: Position -> Int -> ByteString -> Lex Int+checkLeadingWhitespace pos len bs+    | B.any (== 9) (B.take len bs) = do+        addWarningAt pos LexWarningTab+        checkWhitespace pos len bs+    | otherwise = checkWhitespace pos len bs++checkWhitespace :: Position -> Int -> ByteString -> Lex Int+checkWhitespace pos len bs+    -- UTF8 NBSP is 194 160. This function is called on whitespace bytestrings,+    -- therefore counting 194 bytes is enough to count non-breaking spaces.+    -- We subtract the amount of 194 bytes to convert bytes length into char length+    | B.any (== 194) (B.take len bs) = do+        addWarningAt pos LexWarningNBSP+        return $ len - B.count 194 (B.take len bs)+    | otherwise = return len++-- -----------------------------------------------------------------------------+-- The input type++type AlexInput = InputStream++alexInputPrevChar :: AlexInput -> Char+alexInputPrevChar _ = error "alexInputPrevChar not used"++alexGetByte :: AlexInput -> Maybe (Word.Word8,AlexInput)+alexGetByte = B.uncons++lexicalError :: Position -> InputStream -> Lex LToken+lexicalError pos inp = do+  setInput B.empty+  return $! L pos (LexicalError inp)++lexToken :: Lex LToken+lexToken = do+  pos <- getPos+  inp <- getInput+  st  <- getStartCode+  case alexScan inp st of+    AlexEOF -> return (L pos EOF)+    AlexError inp' ->+        let !len_bytes = B.length inp - B.length inp' in+            --FIXME: we want len_chars here really+            -- need to decode utf8 up to this point+        lexicalError (incPos len_bytes pos) inp'+    AlexSkip  inp' len_chars -> do+        checkPosition pos inp inp' len_chars+        adjustPos (incPos len_chars)+        setInput inp'+        lexToken+    AlexToken inp' len_chars action -> do+        checkPosition pos inp inp' len_chars+        adjustPos (incPos len_chars)+        setInput inp'+        let !len_bytes = B.length inp - B.length inp'+        t <- action pos len_bytes inp+        --traceShow t $ return tok+        return t+++checkPosition :: Position -> ByteString -> ByteString -> Int -> Lex ()+#ifdef CABAL_PARSEC_DEBUG+checkPosition pos@(Position lineno colno) inp inp' len_chars = do+    text_lines <- getDbgText+    let len_bytes = B.length inp - B.length inp'+        pos_txt   | lineno-1 < V.length text_lines = T.take len_chars (T.drop (colno-1) (text_lines V.! (lineno-1)))+                  | otherwise = T.empty+        real_txt  = B.take len_bytes inp+    when (pos_txt /= T.decodeUtf8 real_txt) $+      traceShow (pos, pos_txt, T.decodeUtf8 real_txt) $+      traceShow (take 3 (V.toList text_lines)) $ return ()+  where+    getDbgText = Lex $ \s@LexState{ dbgText = txt } -> LexResult s txt+#else+checkPosition _ _ _ _ = return ()+#endif++lexAll :: Lex [LToken]+lexAll = do+  t <- lexToken+  case t of+    L _ EOF -> return [t]+    _       -> do ts <- lexAll+                  return (t : ts)++ltest :: Int -> String -> Prelude.IO ()+ltest code s =+  let (ws, xs) = execLexer (setStartCode code >> lexAll) (B.Char8.pack s)+   in traverse_ print ws >> traverse_ print xs+++mkLexState :: ByteString -> LexState+mkLexState input = LexState+  { curPos   = Position 1 1+  , curInput = input+  , curCode  = 0+  , warnings = []+#ifdef CABAL_PARSEC_DEBUG+  , dbgText  = V.fromList . lines' . T.decodeUtf8With T.lenientDecode $ input+#endif+  }++#ifdef CABAL_PARSEC_DEBUG+lines' :: T.Text -> [T.Text]+lines' s1+  | T.null s1 = []+  | otherwise = case T.break (\c -> c == '\r' || c == '\n') s1 of+                  (l, s2) | Just (c,s3) <- T.uncons s2+                         -> case T.uncons s3 of+                              Just ('\n', s4) | c == '\r' -> l `T.snoc` '\r' `T.snoc` '\n' : lines' s4+                              _                           -> l `T.snoc` c : lines' s3++                          | otherwise+                         -> [l]+#endif+}

@@ -1,43 +1,39 @@ {-# LANGUAGE CPP #-}+ -----------------------------------------------------------------------------+ -- | -- Module      :  Distribution.Fields.LexerMonad -- License     :  BSD3 -- -- Maintainer  :  cabal-devel@haskell.org -- Portability :  portable-module Distribution.Fields.LexerMonad (-    InputStream,-    LexState(..),-    LexResult(..),--    Lex(..),-    execLexer,--    getPos,-    setPos,-    adjustPos,--    getInput,-    setInput,--    getStartCode,-    setStartCode,--    LexWarning(..),-    LexWarningType(..),-    addWarning,-    addWarningAt,-    toPWarnings,-+module Distribution.Fields.LexerMonad+  ( InputStream+  , LexState (..)+  , LexResult (..)+  , Lex (..)+  , execLexer+  , getPos+  , setPos+  , adjustPos+  , getInput+  , setInput+  , getStartCode+  , setStartCode+  , LexWarning (..)+  , LexWarningType (..)+  , addWarning+  , addWarningAt+  , toPWarnings   ) where -import qualified Data.ByteString              as B-import qualified Data.List.NonEmpty           as NE-import           Distribution.Compat.Prelude-import           Distribution.Parsec.Position (Position (..), showPos)-import           Distribution.Parsec.Warning  (PWarnType (..), PWarning (..))-import           Prelude ()+import qualified Data.ByteString as B+import qualified Data.List.NonEmpty as NE+import Distribution.Compat.Prelude+import Distribution.Parsec.Position (Position (..), positionRow, showPos)+import Distribution.Parsec.Warning (PWarnType (..), PWarning (..))+import Prelude ()  import qualified Data.Map.Strict as Map @@ -49,7 +45,7 @@ #endif  -- simple state monad-newtype Lex a = Lex { unLex :: LexState -> LexResult a }+newtype Lex a = Lex {unLex :: LexState -> LexResult a}  instance Functor Lex where   fmap = liftM@@ -60,66 +56,92 @@  instance Monad Lex where   return = pure-  (>>=)  = thenLex+  (>>=) = thenLex  data LexResult a = LexResult {-# UNPACK #-} !LexState a  data LexWarningType-    = LexWarningNBSP  -- ^ Encountered non breaking space-    | LexWarningBOM   -- ^ BOM at the start of the cabal file-    | LexWarningTab   -- ^ Leading tags+  = -- | Encountered non breaking space+    LexWarningNBSP+  | -- | BOM at the start of the cabal file+    LexWarningBOM+  | -- | Leading tags+    LexWarningTab+  | -- | indentation decreases+    LexInconsistentIndentation+  | -- | Brace syntax used+    LexBraces   deriving (Eq, Ord, Show) -data LexWarning = LexWarning                !LexWarningType-                             {-# UNPACK #-} !Position+data LexWarning+  = LexWarning+      !LexWarningType+      {-# UNPACK #-} !Position   deriving (Show)  toPWarnings :: [LexWarning] -> [PWarning]-toPWarnings-    = map (uncurry toWarning)+toPWarnings =+  mapMaybe (uncurry toWarning)     . Map.toList-    . Map.fromListWith (<>)+    . Map.fromListWith (flip (<>)) -- fromListWith gives existing element first.     . map (\(LexWarning t p) -> (t, pure p))   where     toWarning LexWarningBOM poss =-        PWarning PWTLexBOM (NE.head poss) "Byte-order mark found at the beginning of the file"+      Just $ PWarning PWTLexBOM (NE.head poss) "Byte-order mark found at the beginning of the file"     toWarning LexWarningNBSP poss =-        PWarning PWTLexNBSP (NE.head poss) $ "Non breaking spaces at " ++ intercalate ", " (NE.toList $ fmap showPos poss)+      Just $ PWarning PWTLexNBSP (NE.head poss) $ "Non breaking spaces at " ++ intercalate ", " (NE.toList $ fmap showPos poss)     toWarning LexWarningTab poss =-        PWarning PWTLexTab (NE.head poss) $ "Tabs used as indentation at " ++ intercalate ", " (NE.toList $ fmap showPos poss)+      Just $ PWarning PWTLexTab (NE.head poss) $ "Tabs used as indentation at " ++ intercalate ", " (NE.toList $ fmap showPos poss)+    toWarning LexInconsistentIndentation poss =+      Just $ PWarning PWTInconsistentIndentation (NE.head poss) $ "Inconsistent indentation. Indentation jumps at lines " ++ intercalate ", " (NE.toList $ fmap (show . positionRow) poss)+    -- LexBraces warning about using { } delimeters is not reported as parser warning.+    toWarning LexBraces _ =+      Nothing -data LexState = LexState {-        curPos   :: {-# UNPACK #-} !Position,        -- ^ position at current input location-        curInput :: {-# UNPACK #-} !InputStream,     -- ^ the current input-        curCode  :: {-# UNPACK #-} !StartCode,       -- ^ lexer code-        warnings :: [LexWarning]+{- FOURMOLU_DISABLE -}+data LexState = LexState+  { curPos :: {-# UNPACK #-} !Position+  -- ^ position at current input location+  , curInput :: {-# UNPACK #-} !InputStream+  -- ^ the current input+  , curCode :: {-# UNPACK #-} !StartCode+  -- ^ lexer code+  , warnings :: [LexWarning] #ifdef CABAL_PARSEC_DEBUG-        , dbgText  :: V.Vector T.Text                -- ^ input lines, to print pretty debug info+  ,  dbgText :: V.Vector T.Text+  -- ^ input lines, to print pretty debug info #endif-     } --TODO: check if we should cache the first token-       -- since it looks like parsec's uncons can be called many times on the same input+  }+{- FOURMOLU_ENABLE -} -type StartCode   = Int    -- ^ An @alex@ lexer start code-type InputStream = B.ByteString+-- TODO: check if we should cache the first token+-- since it looks like parsec's uncons can be called many times on the same input +type StartCode =+  Int+  -- ^ An @alex@ lexer start code +type InputStream = B.ByteString  -- | Execute the given lexer on the supplied input stream.+{- FOURMOLU_DISABLE -} execLexer :: Lex a -> InputStream -> ([LexWarning], a) execLexer (Lex lexer) input =-    case lexer initialState of-      LexResult LexState{ warnings = ws } result -> (ws, result)+  case lexer initialState of+    LexResult LexState{warnings = ws} result -> (ws, result)   where-    initialState = LexState-      -- TODO: add 'startPosition'-      { curPos   = Position 1 1-      , curInput = input-      , curCode  = 0-      , warnings = []+    initialState =+      LexState+        { -- TODO: add 'startPosition'+          curPos = Position 1 1+        , curInput = input+        , curCode = 0+        , warnings = [] #ifdef CABAL_PARSEC_DEBUG-      , dbgText  = V.fromList . T.lines . T.decodeUtf8 $ input+        ,  dbgText = V.fromList . T.lines . T.decodeUtf8 $ input #endif-      }+        }+{- FOURMOLU_ENABLE -}  {-# INLINE returnLex #-} returnLex :: a -> Lex a@@ -130,32 +152,32 @@ (Lex m) `thenLex` k = Lex $ \s -> case m s of LexResult s' a -> (unLex (k a)) s'  setPos :: Position -> Lex ()-setPos pos = Lex $ \s -> LexResult s{ curPos = pos } ()+setPos pos = Lex $ \s -> LexResult s{curPos = pos} ()  getPos :: Lex Position-getPos = Lex $ \s@LexState{ curPos = pos } -> LexResult s pos+getPos = Lex $ \s@LexState{curPos = pos} -> LexResult s pos  adjustPos :: (Position -> Position) -> Lex ()-adjustPos f = Lex $ \s@LexState{ curPos = pos } -> LexResult s{ curPos = f pos } ()+adjustPos f = Lex $ \s@LexState{curPos = pos} -> LexResult s{curPos = f pos} ()  getInput :: Lex InputStream-getInput = Lex $ \s@LexState{ curInput = i } -> LexResult s i+getInput = Lex $ \s@LexState{curInput = i} -> LexResult s i  setInput :: InputStream -> Lex ()-setInput i = Lex $ \s -> LexResult s{ curInput = i } ()+setInput i = Lex $ \s -> LexResult s{curInput = i} ()  getStartCode :: Lex Int-getStartCode = Lex $ \s@LexState{ curCode = c } -> LexResult s c+getStartCode = Lex $ \s@LexState{curCode = c} -> LexResult s c  setStartCode :: Int -> Lex ()-setStartCode c = Lex $ \s -> LexResult s{ curCode = c } ()+setStartCode c = Lex $ \s -> LexResult s{curCode = c} ()  -- | Add warning at the current position addWarning :: LexWarningType -> Lex ()-addWarning wt = Lex $ \s@LexState{ curPos = pos, warnings = ws  } ->-    LexResult s{ warnings = LexWarning wt pos : ws } ()+addWarning wt = Lex $ \s@LexState{curPos = pos, warnings = ws} ->+  LexResult s{warnings = LexWarning wt pos : ws} ()  -- | Add warning at specific position addWarningAt :: Position -> LexWarningType -> Lex ()-addWarningAt pos wt = Lex $ \s@LexState{ warnings = ws  } ->-    LexResult s{ warnings = LexWarning wt pos : ws } ()+addWarningAt pos wt = Lex $ \s@LexState{warnings = ws} ->+  LexResult s{warnings = LexWarning wt pos : ws} ()

@@ -1,27 +1,28 @@-{-# LANGUAGE BangPatterns     #-}-{-# LANGUAGE CPP              #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE RankNTypes       #-}+{-# LANGUAGE RankNTypes #-}+ -- | A parse result type for parsers from AST to Haskell types.-module Distribution.Fields.ParseResult (-    ParseResult,-    runParseResult,-    recoverWith,-    parseWarning,-    parseWarnings,-    parseFailure,-    parseFatalFailure,-    parseFatalFailure',-    getCabalSpecVersion,-    setCabalSpecVersion,-    withoutWarnings,-    ) where+module Distribution.Fields.ParseResult+  ( ParseResult+  , runParseResult+  , recoverWith+  , parseWarning+  , parseWarnings+  , parseFailure+  , parseFatalFailure+  , parseFatalFailure'+  , getCabalSpecVersion+  , setCabalSpecVersion+  , withoutWarnings+  ) where -import           Distribution.Parsec.Error    (PError (..))-import           Distribution.Parsec.Position (Position (..), zeroPos)-import           Distribution.Parsec.Warning  (PWarnType (..), PWarning (..))-import           Distribution.Version         (Version)-import           Prelude ()+import Distribution.Parsec.Error (PError (..))+import Distribution.Parsec.Position (Position (..), zeroPos)+import Distribution.Parsec.Warning (PWarnType (..), PWarning (..))+import Distribution.Version (Version)+import Prelude ()  -- liftA2 is not in base <4.10, hence we need to only import it explicitly when we're on >=4.10 --@@ -36,12 +37,13 @@  -- | A monad with failure and accumulating errors and warnings. newtype ParseResult a = PR-    { unPR-        :: forall r. PRState-        -> (PRState -> r) -- failure, but we were able to recover a new-style spec-version declaration-        -> (PRState -> a -> r)             -- success-        -> r-    }+  { unPR+      :: forall r+       . PRState+      -> (PRState -> r) -- failure, but we were able to recover a new-style spec-version declaration+      -> (PRState -> a -> r) -- success+      -> r+  }  -- Note: we have version here, as we could get any version. data PRState = PRState ![PWarning] ![PError] !(Maybe Version)@@ -54,7 +56,7 @@ -- @since 3.4.0.0 withoutWarnings :: ParseResult a -> ParseResult a withoutWarnings m = PR $ \s failure success ->-    unPR m s failure $ \ !s1 -> success (s1 `withWarningsOf` s)+  unPR m s failure $ \ !s1 -> success (s1 `withWarningsOf` s)   where     withWarningsOf (PRState _ e v) (PRState w _ _) = PRState w e v @@ -64,99 +66,100 @@ runParseResult :: ParseResult a -> ([PWarning], Either (Maybe Version, NonEmpty PError) a) runParseResult pr = unPR pr emptyPRState failure success   where-    failure (PRState warns []         v)   = (warns, Left (v, PError zeroPos "panic" :| []))-    failure (PRState warns (err:errs) v)   = (warns, Left (v, err :| errs)) where-    success (PRState warns []         _)   x = (warns, Right x)+    failure (PRState warns [] v) = (warns, Left (v, PError zeroPos "panic" :| []))+    failure (PRState warns (err : errs) v) = (warns, Left (v, err :| errs))++    success (PRState warns [] _) x = (warns, Right x)     -- If there are any errors, don't return the result-    success (PRState warns (err:errs) v) _ = (warns, Left (v, err :| errs))+    success (PRState warns (err : errs) v) _ = (warns, Left (v, err :| errs))  instance Functor ParseResult where-    fmap f (PR pr) = PR $ \ !s failure success ->-        pr s failure $ \ !s' a ->-        success s' (f a)-    {-# INLINE fmap #-}+  fmap f (PR pr) = PR $ \ !s failure success ->+    pr s failure $ \ !s' a ->+      success s' (f a)+  {-# INLINE fmap #-}  instance Applicative ParseResult where-    pure x = PR $ \ !s _ success -> success s x-    {-# INLINE pure #-}+  pure x = PR $ \ !s _ success -> success s x+  {-# INLINE pure #-} -    f <*> x = PR $ \ !s0 failure success ->-        unPR f s0 failure $ \ !s1 f' ->-        unPR x s1 failure $ \ !s2 x' ->+  f <*> x = PR $ \ !s0 failure success ->+    unPR f s0 failure $ \ !s1 f' ->+      unPR x s1 failure $ \ !s2 x' ->         success s2 (f' x')-    {-# INLINE (<*>) #-}+  {-# INLINE (<*>) #-} -    x  *> y = PR $ \ !s0 failure success ->-        unPR x s0 failure $ \ !s1 _ ->-        unPR y s1 failure success-    {-# INLINE (*>) #-}+  x *> y = PR $ \ !s0 failure success ->+    unPR x s0 failure $ \ !s1 _ ->+      unPR y s1 failure success+  {-# INLINE (*>) #-} -    x  <* y = PR $ \ !s0 failure success ->-        unPR x s0 failure $ \ !s1 x' ->-        unPR y s1 failure $ \ !s2 _  ->+  x <* y = PR $ \ !s0 failure success ->+    unPR x s0 failure $ \ !s1 x' ->+      unPR y s1 failure $ \ !s2 _ ->         success s2 x'-    {-# INLINE (<*) #-}+  {-# INLINE (<*) #-}  #if MIN_VERSION_base(4,10,0)-    liftA2 f x y = PR $ \ !s0 failure success ->-        unPR x s0 failure $ \ !s1 x' ->-        unPR y s1 failure $ \ !s2 y' ->-        success s2 (f x' y')-    {-# INLINE liftA2 #-}+  liftA2 f x y = PR $ \ !s0 failure success ->+      unPR x s0 failure $ \ !s1 x' ->+      unPR y s1 failure $ \ !s2 y' ->+      success s2 (f x' y')+  {-# INLINE liftA2 #-} #endif  instance Monad ParseResult where-    return = pure-    (>>) = (*>)+  return = pure+  (>>) = (*>) -    m >>= k = PR $ \ !s failure success ->-        unPR m s failure $ \ !s' a ->-        unPR (k a) s' failure success-    {-# INLINE (>>=) #-}+  m >>= k = PR $ \ !s failure success ->+    unPR m s failure $ \ !s' a ->+      unPR (k a) s' failure success+  {-# INLINE (>>=) #-}  -- | "Recover" the parse result, so we can proceed parsing. -- 'runParseResult' will still result in 'Nothing', if there are recorded errors. recoverWith :: ParseResult a -> a -> ParseResult a recoverWith (PR pr) x = PR $ \ !s _failure success ->-    pr s (\ !s' -> success s' x) success+  pr s (\ !s' -> success s' x) success  -- | Set cabal spec version. setCabalSpecVersion :: Maybe Version -> ParseResult () setCabalSpecVersion v = PR $ \(PRState warns errs _) _failure success ->-    success (PRState warns errs v) ()+  success (PRState warns errs v) ()  -- | Get cabal spec version. getCabalSpecVersion :: ParseResult (Maybe Version) getCabalSpecVersion = PR $ \s@(PRState _ _ v) _failure success ->-    success s v+  success s v  -- | Add a warning. This doesn't fail the parsing process. parseWarning :: Position -> PWarnType -> String -> ParseResult () parseWarning pos t msg = PR $ \(PRState warns errs v) _failure success ->-    success (PRState (PWarning t pos msg : warns) errs v) ()+  success (PRState (PWarning t pos msg : warns) errs v) ()  -- | Add multiple warnings at once. parseWarnings :: [PWarning] -> ParseResult () parseWarnings newWarns = PR $ \(PRState warns errs v) _failure success ->-    success (PRState (newWarns ++ warns) errs v) ()+  success (PRState (newWarns ++ warns) errs v) ()  -- | Add an error, but not fail the parser yet. -- -- For fatal failure use 'parseFatalFailure' parseFailure :: Position -> String -> ParseResult () parseFailure pos msg = PR $ \(PRState warns errs v) _failure success ->-    success (PRState warns (PError pos msg : errs) v) ()+  success (PRState warns (PError pos msg : errs) v) ()  -- | Add an fatal error. parseFatalFailure :: Position -> String -> ParseResult a parseFatalFailure pos msg = PR $ \(PRState warns errs v) failure _success ->-    failure (PRState warns (PError pos msg : errs) v)+  failure (PRState warns (PError pos msg : errs) v)  -- | A 'mzero'. parseFatalFailure' :: ParseResult a parseFatalFailure' = PR pr   where     pr (PRState warns [] v) failure _success = failure (PRState warns [err] v)-    pr s                    failure _success = failure s+    pr s failure _success = failure s      err = PError zeroPos "Unknown fatal error"

@@ -1,45 +1,56 @@-{-# LANGUAGE CPP                   #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings     #-}-{-# LANGUAGE PatternGuards         #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternGuards #-}+ -----------------------------------------------------------------------------+ -- | -- Module      :  Distribution.Fields.Parser -- License     :  BSD3 -- -- Maintainer  :  cabal-devel@haskell.org -- Portability :  portable-module Distribution.Fields.Parser (-    -- * Types-    Field(..),-    Name(..),-    FieldLine(..),-    SectionArg(..),+{- FOURMOLU_DISABLE -}+module Distribution.Fields.Parser+  ( -- * Types+    Field (..)+  , Name (..)+  , FieldLine (..)+  , SectionArg (..)+     -- * Grammar and parsing     -- $grammar-    readFields,-    readFields',+  , readFields+  , readFields' #ifdef CABAL_PARSEC_DEBUG+     -- * Internal-    parseFile,-    parseStr,-    parseBS,+  , parseFile+  , parseStr+  , parseBS #endif-    ) where+  ) where+{- FOURMOLU_ENABLE -} -import qualified Data.ByteString.Char8          as B8-import           Data.Functor.Identity-import           Distribution.Compat.Prelude-import           Distribution.Fields.Field-import           Distribution.Fields.Lexer-import           Distribution.Fields.LexerMonad-                 (LexResult (..), LexState (..), LexWarning (..), unLex)-import           Distribution.Parsec.Position   (Position (..))-import           Prelude ()-import           Text.Parsec.Combinator         hiding (eof, notFollowedBy)-import           Text.Parsec.Error-import           Text.Parsec.Pos-import           Text.Parsec.Prim               hiding (many, (<|>))+import qualified Data.ByteString.Char8 as B8+import Data.Functor.Identity+import Distribution.Compat.Prelude+import Distribution.Fields.Field+import Distribution.Fields.Lexer+import Distribution.Fields.LexerMonad+  ( LexResult (..)+  , LexState (..)+  , LexWarning (..)+  , LexWarningType (..)+  , unLex+  )+import Distribution.Parsec.Position (Position (..), positionCol)+import Text.Parsec.Combinator hiding (eof, notFollowedBy)+import Text.Parsec.Error+import Text.Parsec.Pos+import Text.Parsec.Prim hiding (many, (<|>))+import Prelude ()  #ifdef CABAL_PARSEC_DEBUG import qualified Data.Text                as T@@ -55,8 +66,10 @@ data LexState' = LexState' !LexState (LToken, LexState')  mkLexState' :: LexState -> LexState'-mkLexState' st = LexState' st-                   (case unLex lexToken st of LexResult st' tok -> (tok, mkLexState' st'))+mkLexState' st =+  LexState'+    st+    (case unLex lexToken st of LexResult st' tok -> (tok, mkLexState' st'))  type Parser a = ParsecT LexState' () Identity a @@ -64,19 +77,24 @@   uncons (LexState' _ (tok, st')) =     case tok of       L _ EOF -> return Nothing-      _       -> return (Just (tok, st'))+      _ -> return (Just (tok, st'))  -- | Get lexer warnings accumulated so far getLexerWarnings :: Parser [LexWarning] getLexerWarnings = do-  LexState' (LexState { warnings = ws }) _ <- getInput+  LexState' (LexState{warnings = ws}) _ <- getInput   return ws +addLexerWarning :: LexWarning -> Parser ()+addLexerWarning w = do+  LexState' ls@LexState{warnings = ws} _ <- getInput+  setInput $! mkLexState' ls{warnings = w : ws}+ -- | Set Alex code i.e. the mode "state" lexer is in. setLexerMode :: Int -> Parser () setLexerMode code = do   LexState' ls _ <- getInput-  setInput $! mkLexState' ls { curCode = code }+  setInput $! mkLexState' ls{curCode = code}  getToken :: (Token -> Maybe a) -> Parser a getToken getTok = getTokenWithPos (\(L _ t) -> getTok t)@@ -89,45 +107,46 @@  describeToken :: Token -> String describeToken t = case t of-  TokSym   s      -> "symbol "   ++ show s-  TokStr   s      -> "string "   ++ show s-  TokOther s      -> "operator " ++ show s-  Indent _        -> "new line"-  TokFieldLine _  -> "field content"-  Colon           -> "\":\""-  OpenBrace       -> "\"{\""-  CloseBrace      -> "\"}\""---  SemiColon       -> "\";\""-  EOF             -> "end of file"+  TokSym s -> "symbol " ++ show s+  TokStr s -> "string " ++ show s+  TokOther s -> "operator " ++ show s+  Indent _ -> "new line"+  TokFieldLine _ -> "field content"+  Colon -> "\":\""+  OpenBrace -> "\"{\""+  CloseBrace -> "\"}\""+  --  SemiColon       -> "\";\""+  EOF -> "end of file"   LexicalError is -> "character in input " ++ show (B8.head is)  tokSym :: Parser (Name Position) tokSym', tokStr, tokOther :: Parser (SectionArg Position) tokIndent :: Parser Int-tokColon, tokOpenBrace, tokCloseBrace :: Parser ()+tokColon, tokCloseBrace :: Parser ()+tokOpenBrace :: Parser Position tokFieldLine :: Parser (FieldLine Position)--tokSym        = getTokenWithPos $ \t -> case t of L pos (TokSym   x) -> Just (mkName pos x);  _ -> Nothing-tokSym'       = getTokenWithPos $ \t -> case t of L pos (TokSym   x) -> Just (SecArgName pos x);  _ -> Nothing-tokStr        = getTokenWithPos $ \t -> case t of L pos (TokStr   x) -> Just (SecArgStr pos x);  _ -> Nothing-tokOther      = getTokenWithPos $ \t -> case t of L pos (TokOther x) -> Just (SecArgOther pos x);  _ -> Nothing-tokIndent     = getToken $ \t -> case t of Indent   x -> Just x;  _ -> Nothing-tokColon      = getToken $ \t -> case t of Colon      -> Just (); _ -> Nothing-tokOpenBrace  = getToken $ \t -> case t of OpenBrace  -> Just (); _ -> Nothing+tokSym = getTokenWithPos $ \t -> case t of L pos (TokSym x) -> Just (mkName pos x); _ -> Nothing+tokSym' = getTokenWithPos $ \t -> case t of L pos (TokSym x) -> Just (SecArgName pos x); _ -> Nothing+tokStr = getTokenWithPos $ \t -> case t of L pos (TokStr x) -> Just (SecArgStr pos x); _ -> Nothing+tokOther = getTokenWithPos $ \t -> case t of L pos (TokOther x) -> Just (SecArgOther pos x); _ -> Nothing+tokIndent = getToken $ \t -> case t of Indent x -> Just x; _ -> Nothing+tokColon = getToken $ \t -> case t of Colon -> Just (); _ -> Nothing+tokOpenBrace = getTokenWithPos $ \t -> case t of L pos OpenBrace -> Just pos; _ -> Nothing tokCloseBrace = getToken $ \t -> case t of CloseBrace -> Just (); _ -> Nothing-tokFieldLine  = getTokenWithPos $ \t -> case t of L pos (TokFieldLine s) -> Just (FieldLine pos s); _ -> Nothing+tokFieldLine = getTokenWithPos $ \t -> case t of L pos (TokFieldLine s) -> Just (FieldLine pos s); _ -> Nothing  colon, openBrace, closeBrace :: Parser ()- sectionArg :: Parser (SectionArg Position)-sectionArg   = tokSym' <|> tokStr <|> tokOther <?> "section parameter"+sectionArg = tokSym' <|> tokStr <|> tokOther <?> "section parameter"  fieldSecName :: Parser (Name Position)-fieldSecName = tokSym              <?> "field or section name"+fieldSecName = tokSym <?> "field or section name" -colon        = tokColon      <?> "\":\""-openBrace    = tokOpenBrace  <?> "\"{\""-closeBrace   = tokCloseBrace <?> "\"}\""+colon = tokColon <?> "\":\""+openBrace = do+  pos <- tokOpenBrace <?> "\"{\""+  addLexerWarning (LexWarning LexBraces pos)+closeBrace = tokCloseBrace <?> "\"}\""  fieldContent :: Parser (FieldLine Position) fieldContent = tokFieldLine <?> "field contents"@@ -146,14 +165,12 @@   guard (j >= i) <?> "indentation of at least " ++ show i   return (IndentLevel j) - newtype LexerMode = LexerMode Int  inLexerMode :: LexerMode -> Parser p -> Parser p inLexerMode (LexerMode mode) p =   do setLexerMode mode; x <- p; setLexerMode in_section; return x - ----------------------- -- Cabal file grammar --@@ -210,9 +227,10 @@ -- Top level of a file using cabal syntax -- cabalStyleFile :: Parser [Field Position]-cabalStyleFile = do es <- elements zeroIndentLevel-                    eof-                    return es+cabalStyleFile = do+  es <- elements zeroIndentLevel+  eof+  return es  -- Elements that live at the top level or inside a section, i.e. fields -- and sections content@@ -229,11 +247,15 @@ --           |      name elementInNonLayoutContext element :: IndentLevel -> Parser (Field Position) element ilevel =-      (do ilevel' <- indentOfAtLeast ilevel-          name    <- fieldSecName-          elementInLayoutContext (incIndentLevel ilevel') name)-  <|> (do name    <- fieldSecName-          elementInNonLayoutContext name)+  ( do+      ilevel' <- indentOfAtLeast ilevel+      name <- fieldSecName+      elementInLayoutContext (incIndentLevel ilevel') name+  )+    <|> ( do+            name <- fieldSecName+            elementInNonLayoutContext name+        )  -- An element (field or section) that is valid in a layout context. -- In a layout context we can have fields and sections that themselves@@ -243,10 +265,12 @@ --                          | arg* sectionLayoutOrBraces elementInLayoutContext :: IndentLevel -> Name Position -> Parser (Field Position) elementInLayoutContext ilevel name =-      (do colon; fieldLayoutOrBraces ilevel name)-  <|> (do args  <- many sectionArg-          elems <- sectionLayoutOrBraces ilevel-          return (Section name args elems))+  (do colon; fieldLayoutOrBraces ilevel name)+    <|> ( do+            args <- many sectionArg+            elems <- sectionLayoutOrBraces ilevel+            return (Section name args elems)+        )  -- An element (field or section) that is valid in a non-layout context. -- In a non-layout context we can have only have fields and sections that@@ -256,13 +280,15 @@ --                             | arg* '\\n'? '{' elements '\\n'? '}' elementInNonLayoutContext :: Name Position -> Parser (Field Position) elementInNonLayoutContext name =-      (do colon; fieldInlineOrBraces name)-  <|> (do args <- many sectionArg-          openBrace-          elems <- elements zeroIndentLevel-          optional tokIndent-          closeBrace-          return (Section name args elems))+  (do colon; fieldInlineOrBraces name)+    <|> ( do+            args <- many sectionArg+            openBrace+            elems <- elements zeroIndentLevel+            optional tokIndent+            closeBrace+            return (Section name args elems)+        )  -- The body of a field, using either layout style or braces style. --@@ -272,16 +298,16 @@ fieldLayoutOrBraces ilevel name = braces <|> fieldLayout   where     braces = do-          openBrace-          ls <- inLexerMode (LexerMode in_field_braces) (many fieldContent)-          closeBrace-          return (Field name ls)+      openBrace+      ls <- inLexerMode (LexerMode in_field_braces) (many fieldContent)+      closeBrace+      return (Field name ls)     fieldLayout = inLexerMode (LexerMode in_field_layout) $ do-          l  <- optionMaybe fieldContent-          ls <- many (do _ <- indentOfAtLeast ilevel; fieldContent)-          return $ case l of-              Nothing -> Field name ls-              Just l' -> Field name (l' : ls)+      l <- optionMaybe fieldContent+      ls <- many (do _ <- indentOfAtLeast ilevel; fieldContent)+      return $ case l of+        Nothing -> Field name ls+        Just l' -> Field name (l' : ls)  -- The body of a section, using either layout style or braces style. --@@ -289,12 +315,14 @@ --                         | elements sectionLayoutOrBraces :: IndentLevel -> Parser [Field Position] sectionLayoutOrBraces ilevel =-      (do openBrace-          elems <- elements zeroIndentLevel-          optional tokIndent-          closeBrace-          return elems)-  <|> (elements ilevel)+  ( do+      openBrace+      elems <- elements zeroIndentLevel+      optional tokIndent+      closeBrace+      return elems+  )+    <|> (elements ilevel)  -- The body of a field, using either inline style or braces. --@@ -302,30 +330,83 @@ --                         | content fieldInlineOrBraces :: Name Position -> Parser (Field Position) fieldInlineOrBraces name =-      (do openBrace-          ls <- inLexerMode (LexerMode in_field_braces) (many fieldContent)-          closeBrace-          return (Field name ls))-  <|> (do ls <- inLexerMode (LexerMode in_field_braces) (option [] (fmap (\l -> [l]) fieldContent))-          return (Field name ls))-+  ( do+      openBrace+      ls <- inLexerMode (LexerMode in_field_braces) (many fieldContent)+      closeBrace+      return (Field name ls)+  )+    <|> ( do+            ls <- inLexerMode (LexerMode in_field_braces) (option [] (fmap (\l -> [l]) fieldContent))+            return (Field name ls)+        )  -- | Parse cabal style 'B8.ByteString' into list of 'Field's, i.e. the cabal AST.+--+-- 'readFields' assumes that input 'B8.ByteString' is valid UTF8, specifically it doesn't validate that file is valid UTF8.+-- Therefore bytestrings inside returned 'Field' will be invalid as UTF8 if the input were.+--+-- >>> readFields "foo: \223"+-- Right [Field (Name (Position 1 1) "foo") [FieldLine (Position 1 6) "\223"]]+--+-- 'readFields' won't (necessarily) fail on invalid UTF8 data, but the reported positions may be off.+--+-- __You may get weird errors on non-UTF8 input__, for example 'readFields' will fail on latin1 encoded non-breaking space:+--+-- >>> isLeft (readFields "\xa0 foo: bar")+-- True+--+-- That is rejected because parser thinks @\\xa0@ is a section name,+-- and section arguments may not contain colon.+-- If there are just latin1 non-breaking spaces, they become part of the name:+--+-- >>> readFields "\xa0\&foo: bar"+-- Right [Field (Name (Position 1 1) "\160foo") [FieldLine (Position 1 7) "bar"]]+--+-- The UTF8 non-breaking space is accepted as an indentation character (but warned about by 'readFields'').+--+-- >>> readFields' "\xc2\xa0 foo: bar"+-- Right ([Field (Name (Position 1 3) "foo") [FieldLine (Position 1 8) "bar"]],[LexWarning LexWarningNBSP (Position 1 1)]) readFields :: B8.ByteString -> Either ParseError [Field Position] readFields s = fmap fst (readFields' s) --- | Like 'readFields' but also return lexer warnings+-- | Like 'readFields' but also return lexer warnings. readFields' :: B8.ByteString -> Either ParseError ([Field Position], [LexWarning]) readFields' s = do-    parse parser "the input" lexSt+  parse parser "the input" lexSt   where     parser = do-        fields <- cabalStyleFile-        ws     <- getLexerWarnings-        pure (fields, ws)+      fields <- cabalStyleFile+      ws <- getLexerWarnings -- lexer accumulates warnings in reverse (consing them to the list)+      pure (fields, reverse ws ++ checkIndentation fields [])      lexSt = mkLexState' (mkLexState s) +-- | Check (recursively) that all fields inside a block are indented the same.+--+-- We have to do this as a post-processing check.+-- As the parser uses indentOfAtLeast approach, we don't know what is the "correct"+-- indentation for following fields.+--+-- To catch during parsing we would need to parse first field/section of a section+-- and then parse the following ones (softly) requiring the exactly the same indentation.+checkIndentation :: [Field Position] -> [LexWarning] -> [LexWarning]+checkIndentation [] = id+checkIndentation (Field name _ : fs') = checkIndentation' (nameAnn name) fs'+checkIndentation (Section name _ fs : fs') = checkIndentation fs . checkIndentation' (nameAnn name) fs'++-- | We compare adjacent fields to reduce the amount of reported indentation warnings.+checkIndentation' :: Position -> [Field Position] -> [LexWarning] -> [LexWarning]+checkIndentation' _ [] = id+checkIndentation' pos (Field name _ : fs') = checkIndentation'' pos (nameAnn name) . checkIndentation' (nameAnn name) fs'+checkIndentation' pos (Section name _ fs : fs') = checkIndentation'' pos (nameAnn name) . checkIndentation fs . checkIndentation' (nameAnn name) fs'++-- | Check that positions' columns are the same.+checkIndentation'' :: Position -> Position -> [LexWarning] -> [LexWarning]+checkIndentation'' a b+  | positionCol a == positionCol b = id+  | otherwise = (LexWarning LexInconsistentIndentation b :)+ #ifdef CABAL_PARSEC_DEBUG parseTest' :: Show a => Parsec LexState' () a -> SourceName -> B8.ByteString -> IO () parseTest' p fname s =@@ -376,5 +457,8 @@ eof = notFollowedBy anyToken <?> "end of file"   where     notFollowedBy :: Parser LToken -> Parser ()-    notFollowedBy p = try (    (do L _ t <- try p; unexpected (describeToken t))-                           <|> return ())+    notFollowedBy p =+      try+        ( (do L _ t <- try p; unexpected (describeToken t))+            <|> return ()+        )