cabal-gild 1.8.1.0 → 1.8.2.0

raw patch · 15 files changed

+521/−167 lines, 15 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• cabal-gild.cabal +9/−1
• source/library/CabalGild/Unstable/Action/EvaluatePragmas.hs +6/−1
• source/library/CabalGild/Unstable/Action/EvaluatePragmas/Discover.hs +7/−1
• source/library/CabalGild/Unstable/Action/EvaluatePragmas/Require.hs +74/−0
• source/library/CabalGild/Unstable/Action/EvaluatePragmas/Version.hs +6/−0
• source/library/CabalGild/Unstable/Exception/UnsatisfiedRequire.hs +19/−0
• source/library/CabalGild/Unstable/Type/Pragma.hs +3/−1
• source/library/CabalGild/Unstable/Type/VersionRange.hs +62/−163
• source/library/CabalGild/Unstable/Type/VersionRange/Complex.hs +54/−0
• source/library/CabalGild/Unstable/Type/VersionRange/Operator.hs +36/−0
• source/library/CabalGild/Unstable/Type/VersionRange/Part.hs +54/−0
• source/library/CabalGild/Unstable/Type/VersionRange/Simple.hs +29/−0
• source/library/CabalGild/Unstable/Type/VersionRange/Version.hs +33/−0
• source/library/CabalGild/Unstable/Type/VersionRange/Versions.hs +31/−0
• source/test-suite/Main.hs +98/−0

@@ -11,7 +11,7 @@ maintainer: Taylor Fausak name: cabal-gild synopsis: Formats package descriptions.-version: 1.8.1.0+version: 1.8.2.0  source-repository head   type: git@@ -70,6 +70,7 @@     CabalGild.Unstable.Action.AttachComments     CabalGild.Unstable.Action.EvaluatePragmas     CabalGild.Unstable.Action.EvaluatePragmas.Discover+    CabalGild.Unstable.Action.EvaluatePragmas.Require     CabalGild.Unstable.Action.EvaluatePragmas.Version     CabalGild.Unstable.Action.ExtractComments     CabalGild.Unstable.Action.FormatFields@@ -94,6 +95,7 @@     CabalGild.Unstable.Exception.SpecifiedStdinWithFileInput     CabalGild.Unstable.Exception.UnexpectedArgument     CabalGild.Unstable.Exception.UnknownOption+    CabalGild.Unstable.Exception.UnsatisfiedRequire     CabalGild.Unstable.Extra.ByteString     CabalGild.Unstable.Extra.CharParsing     CabalGild.Unstable.Extra.Either@@ -137,6 +139,12 @@     CabalGild.Unstable.Type.TestedWith     CabalGild.Unstable.Type.Variable     CabalGild.Unstable.Type.VersionRange+    CabalGild.Unstable.Type.VersionRange.Complex+    CabalGild.Unstable.Type.VersionRange.Operator+    CabalGild.Unstable.Type.VersionRange.Part+    CabalGild.Unstable.Type.VersionRange.Simple+    CabalGild.Unstable.Type.VersionRange.Version+    CabalGild.Unstable.Type.VersionRange.Versions    hs-source-dirs: source/library   other-modules: Paths_cabal_gild

@@ -1,10 +1,12 @@ module CabalGild.Unstable.Action.EvaluatePragmas where  import qualified CabalGild.Unstable.Action.EvaluatePragmas.Discover as EvaluateDiscover+import qualified CabalGild.Unstable.Action.EvaluatePragmas.Require as EvaluateRequire import qualified CabalGild.Unstable.Action.EvaluatePragmas.Version as EvaluateVersion import qualified CabalGild.Unstable.Class.MonadWalk as MonadWalk import qualified CabalGild.Unstable.Type.Comment as Comment import qualified CabalGild.Unstable.Type.Comments as Comments+import qualified Control.Monad as Monad import qualified Control.Monad.Catch as Exception import qualified Distribution.Fields as Fields @@ -15,4 +17,7 @@   FilePath ->   ([Fields.Field (p, Comments.Comments q)], [Comment.Comment q]) ->   m ([Fields.Field (p, Comments.Comments q)], [Comment.Comment q])-run p (fs, cs) = (,) <$> traverse (EvaluateDiscover.field p . EvaluateVersion.field) fs <*> pure (EvaluateVersion.expandVersion cs)+run p =+  EvaluateRequire.run+    Monad.>=> EvaluateVersion.run+    Monad.>=> EvaluateDiscover.run p

@@ -32,6 +32,13 @@ import qualified System.Console.GetOpt as GetOpt import qualified System.FilePath as FilePath +run ::+  (Exception.MonadThrow m, MonadWalk.MonadWalk m) =>+  FilePath ->+  ([Fields.Field (p, Comments.Comments q)], [Comment.Comment q]) ->+  m ([Fields.Field (p, Comments.Comments q)], [Comment.Comment q])+run p (fs, cs) = (,) <$> traverse (field p) fs <*> pure cs+ -- | Evaluates pragmas within the given field. Or, if the field is a section, -- evaluates pragmas recursively within the fields of the section. field ::@@ -58,7 +65,6 @@       Monad.mplus         (CharParsing.skipSpaces1 *> CharParsing.sepBy Parsec.parsec CharParsing.skipSpaces1)         ([] <$ CharParsing.spaces)-    CharParsing.eof     pure . Discover $ fmap Newtypes.getToken' arguments  -- | If modules are discovered for a field, that fields lines are completely

@@ -0,0 +1,74 @@+module CabalGild.Unstable.Action.EvaluatePragmas.Require where++import qualified CabalGild.Unstable.Exception.UnsatisfiedRequire as UnsatisfiedRequire+import qualified CabalGild.Unstable.Extra.FieldLine as FieldLine+import qualified CabalGild.Unstable.Extra.Name as Name+import qualified CabalGild.Unstable.Type.Comment as Comment+import qualified CabalGild.Unstable.Type.Comments as Comments+import qualified CabalGild.Unstable.Type.Pragma as Pragma+import qualified CabalGild.Unstable.Type.VersionRange as VR+import qualified Control.Monad as Monad+import qualified Control.Monad.Catch as Exception+import qualified Data.Version as Version+import qualified Distribution.Compat.CharParsing as CharParsing+import qualified Distribution.Fields as Fields+import qualified Distribution.Parsec as Parsec+import qualified Distribution.Types.Version as CabalVersion+import qualified Distribution.Types.VersionRange as CabalVR+import qualified Paths_cabal_gild as This++run ::+  (Exception.MonadThrow m) =>+  ([Fields.Field (p, Comments.Comments q)], [Comment.Comment q]) ->+  m ([Fields.Field (p, Comments.Comments q)], [Comment.Comment q])+run (fs, cs) = (,) <$> traverse field fs <*> checkRequire cs++field ::+  (Exception.MonadThrow m) =>+  Fields.Field (p, Comments.Comments q) ->+  m (Fields.Field (p, Comments.Comments q))+field f = case f of+  Fields.Field n fls -> do+    requireComments . snd $ Name.annotation n+    mapM_ (requireComments . snd . FieldLine.annotation) fls+    pure f+  Fields.Section n sas fs -> do+    requireComments . snd $ Name.annotation n+    Fields.Section n sas <$> traverse field fs++requireComments ::+  (Exception.MonadThrow m) =>+  Comments.Comments q ->+  m ()+requireComments cs = do+  Monad.void $ checkRequire (Comments.before cs)+  Monad.void $ checkRequire (Comments.after cs)++-- | Walks a list of comments. When a require pragma is found, validates that+-- the current cabal-gild version satisfies the specified range.+checkRequire ::+  (Exception.MonadThrow m) =>+  [Comment.Comment q] ->+  m [Comment.Comment q]+checkRequire [] = pure []+checkRequire (c : cs) = case Parsec.simpleParsecBS $ Comment.value c of+  Just (Pragma.Pragma (Require vr)) -> do+    let cabalVR = VR.toCabalVersionRange vr+        currentVersion = CabalVersion.mkVersion $ Version.versionBranch This.version+    Monad.unless (CabalVR.withinRange currentVersion cabalVR) $+      Exception.throwM+        UnsatisfiedRequire.UnsatisfiedRequire+          { UnsatisfiedRequire.actual = This.version,+            UnsatisfiedRequire.range = vr+          }+    (c :) <$> checkRequire cs+  Nothing -> (c :) <$> checkRequire cs++newtype Require = Require VR.VersionRange+  deriving (Eq, Show)++instance Parsec.Parsec Require where+  parsec = do+    Monad.void $ CharParsing.string "require"+    CharParsing.skipSpaces1+    Require <$> Parsec.parsec

@@ -11,6 +11,12 @@ import qualified Distribution.Parsec as Parsec import qualified Paths_cabal_gild as This +run ::+  (Applicative m) =>+  ([Fields.Field (p, Comments.Comments q)], [Comment.Comment q]) ->+  m ([Fields.Field (p, Comments.Comments q)], [Comment.Comment q])+run (fs, cs) = pure (fmap field fs, expandVersion cs)+ field ::   Fields.Field (p, Comments.Comments q) ->   Fields.Field (p, Comments.Comments q)

@@ -0,0 +1,19 @@+module CabalGild.Unstable.Exception.UnsatisfiedRequire where++import qualified CabalGild.Unstable.Type.VersionRange as VersionRange+import qualified Control.Monad.Catch as Exception+import qualified Data.Version as Version+import qualified Distribution.Pretty as Pretty++data UnsatisfiedRequire = UnsatisfiedRequire+  { actual :: Version.Version,+    range :: VersionRange.VersionRange+  }+  deriving (Eq, Show)++instance Exception.Exception UnsatisfiedRequire where+  displayException (UnsatisfiedRequire v r) =+    "cabal-gild version "+      <> Version.showVersion v+      <> " does not satisfy the required range "+      <> Pretty.prettyShow r

@@ -13,7 +13,9 @@     CharParsing.spaces     Monad.void $ CharParsing.string cabalGildPragmaPrefix     CharParsing.spaces-    Pragma <$> Parsec.parsec+    x <- Parsec.parsec+    CharParsing.eof+    pure $ Pragma x  cabalGildPragmaPrefix :: String cabalGildPragmaPrefix = "cabal-gild:"

@@ -1,182 +1,81 @@-{-# LANGUAGE FlexibleInstances #-}- module CabalGild.Unstable.Type.VersionRange where -import qualified CabalGild.Unstable.Extra.CharParsing as Parse+import qualified CabalGild.Unstable.Type.VersionRange.Complex as Complex+import qualified CabalGild.Unstable.Type.VersionRange.Operator as Operator+import qualified CabalGild.Unstable.Type.VersionRange.Part as Part+import qualified CabalGild.Unstable.Type.VersionRange.Simple as Simple+import qualified CabalGild.Unstable.Type.VersionRange.Version as Version+import qualified CabalGild.Unstable.Type.VersionRange.Versions as Versions import qualified Data.List.NonEmpty as NonEmpty import qualified Data.Set as Set-import qualified Distribution.Compat.CharParsing as Parse import qualified Distribution.Parsec as Parsec import qualified Distribution.Pretty as Pretty+import qualified Distribution.Types.Version as CabalVersion+import qualified Distribution.Types.VersionRange as CabalRange import qualified Numeric.Natural as Natural-import qualified Text.PrettyPrint as PrettyPrint-import qualified Text.Read as Read -data Part-  = Numeric Natural.Natural-  | Wildcard+newtype VersionRange = VersionRange+  { unwrap :: Complex.Complex Simple.Simple+  }   deriving (Eq, Ord, Show) -parseNumeric :: (Parsec.CabalParsing m) => m Natural.Natural-parseNumeric =-  Parse.choice-    [ parseZero,-      parseNonZero-    ]--parseZero :: (Parsec.CabalParsing m) => m Natural.Natural-parseZero = 0 <$ Parse.token "0"--parseNonZero :: (Parsec.CabalParsing m) => m Natural.Natural-parseNonZero = do-  c <- Parse.satisfy $ \c -> '1' <= c && c <= '9'-  cs <- Parse.many Parse.digit-  let s = c : cs-  case Read.readMaybe s of-    Nothing -> fail $ "invalid Natural: " <> show s-    Just n -> n <$ Parse.spaces+instance Parsec.Parsec VersionRange where+  parsec = VersionRange <$> Complex.parse Simple.parse -renderNumeric :: Natural.Natural -> PrettyPrint.Doc-renderNumeric = PrettyPrint.text . show+instance Pretty.Pretty VersionRange where+  pretty = Complex.render Simple.render . unwrap -parseWildcard :: (Parsec.CabalParsing m) => m ()-parseWildcard = Parse.token "*"+-- | Converts a 'VersionRange' to Cabal-syntax's 'CabalRange.VersionRange' for+-- evaluation with 'CabalRange.withinRange'.+toCabalVersionRange :: VersionRange -> CabalRange.VersionRange+toCabalVersionRange = toCabalComplex . unwrap -renderWildcard :: PrettyPrint.Doc-renderWildcard = PrettyPrint.char '*'+toCabalComplex :: Complex.Complex Simple.Simple -> CabalRange.VersionRange+toCabalComplex x = case x of+  Complex.Par c -> toCabalComplex c+  Complex.And l r -> CabalRange.intersectVersionRanges (toCabalComplex l) (toCabalComplex r)+  Complex.Or l r -> CabalRange.unionVersionRanges (toCabalComplex l) (toCabalComplex r)+  Complex.Simple s -> toCabalSimple s -parsePart :: (Parsec.CabalParsing m) => m Part-parsePart =-  Parse.choice-    [ Numeric <$> parseNumeric,-      Wildcard <$ parseWildcard-    ]+toCabalSimple :: Simple.Simple -> CabalRange.VersionRange+toCabalSimple x = case x of+  Simple.Any -> CabalRange.anyVersion+  Simple.None -> CabalRange.noVersion+  Simple.Op op vs -> toCabalOp op vs -renderPart :: Part -> PrettyPrint.Doc-renderPart x =-  case x of-    Numeric n -> renderNumeric n-    Wildcard -> renderWildcard+toCabalOp :: Operator.Operator -> Versions.Versions -> CabalRange.VersionRange+toCabalOp op vs = case vs of+  Versions.One v -> toCabalOpOne op v+  Versions.Set s -> case Set.toList s of+    [] -> CabalRange.noVersion+    v : rest -> foldr (CabalRange.unionVersionRanges . toCabalOpOne op) (toCabalOpOne op v) rest -newtype Version-  = MkVersion (NonEmpty.NonEmpty Part)-  deriving (Eq, Ord, Show)+toCabalOpOne :: Operator.Operator -> Version.Version -> CabalRange.VersionRange+toCabalOpOne op v = case op of+  Operator.Caret -> CabalRange.majorBoundVersion cv+  Operator.Ge -> CabalRange.orLaterVersion cv+  Operator.Gt -> CabalRange.laterVersion cv+  Operator.Le -> CabalRange.orEarlierVersion cv+  Operator.Lt -> CabalRange.earlierVersion cv+  Operator.Eq+    | hasWildcard v -> CabalRange.withinVersion cv+    | otherwise -> CabalRange.thisVersion cv+  where+    cv = toCabalVersion v -parseVersion :: (Parsec.CabalParsing m) => m Version-parseVersion =-  MkVersion-    <$> Parse.sepByNonEmpty parsePart (Parse.char '.')-    <* Parse.spaces+hasWildcard :: Version.Version -> Bool+hasWildcard (Version.MkVersion parts) = any isWildcard $ NonEmpty.toList parts+  where+    isWildcard Part.Wildcard = True+    isWildcard _ = False -renderVersion :: Version -> PrettyPrint.Doc-renderVersion (MkVersion parts) =-  mconcat-    . PrettyPrint.punctuate (PrettyPrint.char '.')-    . fmap renderPart+toCabalVersion :: Version.Version -> CabalVersion.Version+toCabalVersion (Version.MkVersion parts) =+  CabalVersion.mkVersion+    . fmap fromIntegral+    . concatMap toNumbers     $ NonEmpty.toList parts--data Versions-  = One Version-  | Set (Set.Set Version)-  deriving (Eq, Ord, Show)--parseVersions :: (Parsec.CabalParsing m) => m Versions-parseVersions =-  Parse.choice-    [ One <$> parseVersion,-      Set . Set.fromList <$> Parse.braces (Parse.sepBy parseVersion $ Parse.token ",")-    ]--renderVersions :: Versions -> PrettyPrint.Doc-renderVersions x =-  case x of-    One v -> renderVersion v-    Set vs ->-      PrettyPrint.braces-        . PrettyPrint.hsep-        . PrettyPrint.punctuate PrettyPrint.comma-        . fmap renderVersion-        $ Set.toAscList vs--data Operator-  = Caret-  | Ge-  | Gt-  | Le-  | Lt-  | Eq-  deriving (Eq, Ord, Show)--parseOperator :: (Parsec.CabalParsing m) => m Operator-parseOperator =-  Parse.choice-    [ Caret <$ Parse.token "^>=",-      Parse.try $ Ge <$ Parse.token ">=",-      Gt <$ Parse.token ">",-      Parse.try $ Le <$ Parse.token "<=",-      Lt <$ Parse.token "<",-      Eq <$ Parse.token "=="-    ]--renderOperator :: Operator -> PrettyPrint.Doc-renderOperator x =-  case x of-    Caret -> PrettyPrint.text "^>="-    Ge -> PrettyPrint.text ">="-    Gt -> PrettyPrint.char '>'-    Le -> PrettyPrint.text "<="-    Lt -> PrettyPrint.char '<'-    Eq -> PrettyPrint.text "=="--data Simple-  = Any-  | None-  | Op Operator Versions-  deriving (Eq, Ord, Show)--parseSimple :: (Parsec.CabalParsing m) => m Simple-parseSimple =-  Parse.choice-    [ Parse.try $ Any <$ Parse.token "-any",-      None <$ Parse.token "-none",-      Op <$> parseOperator <*> parseVersions-    ]--renderSimple :: Simple -> PrettyPrint.Doc-renderSimple x =-  case x of-    Any -> PrettyPrint.text "-any"-    None -> PrettyPrint.text "-none"-    Op o vs -> renderOperator o <> renderVersions vs--data Complex a-  = Par (Complex a)-  | And a (Complex a)-  | Or a (Complex a)-  | Simple a-  deriving (Eq, Ord, Show)--parseComplex :: (Parsec.CabalParsing m) => m a -> m (Complex a)-parseComplex p =-  Parse.choice-    [ Par <$> Parse.parens (parseComplex p),-      Parse.try $ And <$> p <* Parse.token "&&" <*> parseComplex p,-      Parse.try $ Or <$> p <* Parse.token "||" <*> parseComplex p,-      Simple <$> p-    ]--renderComplex :: (a -> PrettyPrint.Doc) -> Complex a -> PrettyPrint.Doc-renderComplex f x =-  case x of-    Par y -> PrettyPrint.parens $ renderComplex f y-    And l r -> PrettyPrint.hsep [f l, PrettyPrint.text "&&", renderComplex f r]-    Or l r -> PrettyPrint.hsep [f l, PrettyPrint.text "||", renderComplex f r]-    Simple y -> f y--type VersionRange = Complex Simple--instance Parsec.Parsec VersionRange where-  parsec = parseComplex parseSimple--instance Pretty.Pretty VersionRange where-  pretty = renderComplex renderSimple+  where+    toNumbers :: Part.Part -> [Natural.Natural]+    toNumbers (Part.Numeric n) = [n]+    toNumbers Part.Wildcard = []

@@ -0,0 +1,54 @@+module CabalGild.Unstable.Type.VersionRange.Complex where++import qualified CabalGild.Unstable.Extra.CharParsing as Parse+import qualified Distribution.Compat.CharParsing as Parse+import qualified Distribution.Parsec as Parsec+import qualified Text.PrettyPrint as PrettyPrint++data Complex a+  = Par (Complex a)+  | And (Complex a) (Complex a)+  | Or (Complex a) (Complex a)+  | Simple a+  deriving (Eq, Ord, Show)++-- | Parses with @||@ at lower precedence than @&&@, matching Cabal.+parse :: (Parsec.CabalParsing m) => m a -> m (Complex a)+parse p = do+  lhs <- andExpr p+  orRest p lhs++-- | Parses a chain of @&&@-separated atoms.+andExpr :: (Parsec.CabalParsing m) => m a -> m (Complex a)+andExpr p = do+  lhs <- atom p+  andRest p lhs++atom :: (Parsec.CabalParsing m) => m a -> m (Complex a)+atom p =+  Parse.choice+    [ Par <$> Parse.parens (parse p),+      Simple <$> p+    ]++andRest :: (Parsec.CabalParsing m) => m a -> Complex a -> m (Complex a)+andRest p lhs =+  Parse.choice+    [ Parse.try $ do Parse.token "&&"; rhs <- atom p; andRest p (And lhs rhs),+      pure lhs+    ]++orRest :: (Parsec.CabalParsing m) => m a -> Complex a -> m (Complex a)+orRest p lhs =+  Parse.choice+    [ Parse.try $ do Parse.token "||"; rhs <- andExpr p; orRest p (Or lhs rhs),+      pure lhs+    ]++render :: (a -> PrettyPrint.Doc) -> Complex a -> PrettyPrint.Doc+render f x =+  case x of+    Par y -> PrettyPrint.parens $ render f y+    And l r -> PrettyPrint.hsep [render f l, PrettyPrint.text "&&", render f r]+    Or l r -> PrettyPrint.hsep [render f l, PrettyPrint.text "||", render f r]+    Simple y -> f y

@@ -0,0 +1,36 @@+module CabalGild.Unstable.Type.VersionRange.Operator where++import qualified CabalGild.Unstable.Extra.CharParsing as Parse+import qualified Distribution.Compat.CharParsing as Parse+import qualified Distribution.Parsec as Parsec+import qualified Text.PrettyPrint as PrettyPrint++data Operator+  = Caret+  | Ge+  | Gt+  | Le+  | Lt+  | Eq+  deriving (Eq, Ord, Show)++parse :: (Parsec.CabalParsing m) => m Operator+parse =+  Parse.choice+    [ Caret <$ Parse.token "^>=",+      Parse.try $ Ge <$ Parse.token ">=",+      Gt <$ Parse.token ">",+      Parse.try $ Le <$ Parse.token "<=",+      Lt <$ Parse.token "<",+      Eq <$ Parse.token "=="+    ]++render :: Operator -> PrettyPrint.Doc+render x =+  case x of+    Caret -> PrettyPrint.text "^>="+    Ge -> PrettyPrint.text ">="+    Gt -> PrettyPrint.char '>'+    Le -> PrettyPrint.text "<="+    Lt -> PrettyPrint.char '<'+    Eq -> PrettyPrint.text "=="

@@ -0,0 +1,54 @@+module CabalGild.Unstable.Type.VersionRange.Part where++import qualified CabalGild.Unstable.Extra.CharParsing as Parse+import qualified Distribution.Compat.CharParsing as Parse+import qualified Distribution.Parsec as Parsec+import qualified Numeric.Natural as Natural+import qualified Text.PrettyPrint as PrettyPrint+import qualified Text.Read as Read++data Part+  = Numeric Natural.Natural+  | Wildcard+  deriving (Eq, Ord, Show)++parse :: (Parsec.CabalParsing m) => m Part+parse =+  Parse.choice+    [ Numeric <$> parseNumeric,+      Wildcard <$ parseWildcard+    ]++parseNumeric :: (Parsec.CabalParsing m) => m Natural.Natural+parseNumeric =+  Parse.choice+    [ parseZero,+      parseNonZero+    ]++parseZero :: (Parsec.CabalParsing m) => m Natural.Natural+parseZero = 0 <$ Parse.token "0"++parseNonZero :: (Parsec.CabalParsing m) => m Natural.Natural+parseNonZero = do+  c <- Parse.satisfy $ \c -> '1' <= c && c <= '9'+  cs <- Parse.many Parse.digit+  let s = c : cs+  case Read.readMaybe s of+    Nothing -> fail $ "invalid Natural: " <> show s+    Just n -> n <$ Parse.spaces++parseWildcard :: (Parsec.CabalParsing m) => m ()+parseWildcard = Parse.token "*"++render :: Part -> PrettyPrint.Doc+render x =+  case x of+    Numeric n -> renderNumeric n+    Wildcard -> renderWildcard++renderNumeric :: Natural.Natural -> PrettyPrint.Doc+renderNumeric = PrettyPrint.text . show++renderWildcard :: PrettyPrint.Doc+renderWildcard = PrettyPrint.char '*'

@@ -0,0 +1,29 @@+module CabalGild.Unstable.Type.VersionRange.Simple where++import qualified CabalGild.Unstable.Extra.CharParsing as Parse+import qualified CabalGild.Unstable.Type.VersionRange.Operator as Operator+import qualified CabalGild.Unstable.Type.VersionRange.Versions as Versions+import qualified Distribution.Compat.CharParsing as Parse+import qualified Distribution.Parsec as Parsec+import qualified Text.PrettyPrint as PrettyPrint++data Simple+  = Any+  | None+  | Op Operator.Operator Versions.Versions+  deriving (Eq, Ord, Show)++parse :: (Parsec.CabalParsing m) => m Simple+parse =+  Parse.choice+    [ Parse.try $ Any <$ Parse.token "-any",+      None <$ Parse.token "-none",+      Op <$> Operator.parse <*> Versions.parse+    ]++render :: Simple -> PrettyPrint.Doc+render x =+  case x of+    Any -> PrettyPrint.text "-any"+    None -> PrettyPrint.text "-none"+    Op o vs -> Operator.render o <> Versions.render vs

@@ -0,0 +1,33 @@+module CabalGild.Unstable.Type.VersionRange.Version where++import qualified CabalGild.Unstable.Type.VersionRange.Part as Part+import qualified Control.Monad as Monad+import qualified Data.List.NonEmpty as NonEmpty+import qualified Distribution.Compat.CharParsing as Parse+import qualified Distribution.Parsec as Parsec+import qualified Text.PrettyPrint as PrettyPrint++newtype Version+  = MkVersion (NonEmpty.NonEmpty Part.Part)+  deriving (Eq, Ord, Show)++parse :: (Parsec.CabalParsing m) => m Version+parse = do+  parts <- Parse.sepByNonEmpty Part.parse (Parse.char '.')+  Monad.unless (validWildcards parts) $+    fail "wildcards are only allowed in the final position"+  MkVersion parts <$ Parse.spaces++-- | Wildcards are only valid in the final position of a version.+validWildcards :: NonEmpty.NonEmpty Part.Part -> Bool+validWildcards parts = all isNumeric (NonEmpty.init parts)+  where+    isNumeric (Part.Numeric _) = True+    isNumeric Part.Wildcard = False++render :: Version -> PrettyPrint.Doc+render (MkVersion parts) =+  mconcat+    . PrettyPrint.punctuate (PrettyPrint.char '.')+    . fmap Part.render+    $ NonEmpty.toList parts

@@ -0,0 +1,31 @@+module CabalGild.Unstable.Type.VersionRange.Versions where++import qualified CabalGild.Unstable.Extra.CharParsing as Parse+import qualified CabalGild.Unstable.Type.VersionRange.Version as Version+import qualified Data.Set as Set+import qualified Distribution.Compat.CharParsing as Parse+import qualified Distribution.Parsec as Parsec+import qualified Text.PrettyPrint as PrettyPrint++data Versions+  = One Version.Version+  | Set (Set.Set Version.Version)+  deriving (Eq, Ord, Show)++parse :: (Parsec.CabalParsing m) => m Versions+parse =+  Parse.choice+    [ One <$> Version.parse,+      Set . Set.fromList <$> Parse.braces (Parse.sepBy Version.parse $ Parse.token ",")+    ]++render :: Versions -> PrettyPrint.Doc+render x =+  case x of+    One v -> Version.render v+    Set vs ->+      PrettyPrint.braces+        . PrettyPrint.hsep+        . PrettyPrint.punctuate PrettyPrint.comma+        . fmap Version.render+        $ Set.toAscList vs

@@ -1617,6 +1617,89 @@           "-- cabal-gild: version\n-- Generated with cabal-gild version 0\n-- Generated with cabal-gild version 1"           ("-- cabal-gild: version\n" <> versionComment <> "\n-- Generated with cabal-gild version 1\n") +  Hspec.describe "require" $ do+    Hspec.it "passes with a permissive range" $ do+      expectGilded+        "-- cabal-gild: require >= 0"+        "-- cabal-gild: require >= 0\n"++    Hspec.it "fails with an impossible range" $ do+      let (a, _s, _w) =+            runGild+              []+              [(Input.Stdin, String.toUtf8 "-- cabal-gild: require < 0")]+              (".", [])+              False+      a `Hspec.shouldSatisfy` Either.isLeft++    Hspec.it "works before a field" $ do+      expectGilded+        "-- cabal-gild: require >= 0\nfld: val"+        "-- cabal-gild: require >= 0\nfld: val\n"++    Hspec.it "works within a field" $ do+      expectGilded+        "fld:\n a\n -- cabal-gild: require >= 0\n b"+        "fld:\n  -- cabal-gild: require >= 0\n  a\n  b\n"++    Hspec.it "works after a field" $ do+      expectGilded+        "fld: val\n-- cabal-gild: require >= 0"+        "fld: val\n-- cabal-gild: require >= 0\n"++    Hspec.it "works before a section" $ do+      expectGilded+        "-- cabal-gild: require >= 0\nsec"+        "-- cabal-gild: require >= 0\nsec\n"++    Hspec.it "works within a section" $ do+      expectGilded+        "sec\n -- cabal-gild: require >= 0"+        "sec\n  -- cabal-gild: require >= 0\n"++    Hspec.it "works after a section" $ do+      expectGilded+        "sec\n-- cabal-gild: require >= 0"+        "sec\n\n-- cabal-gild: require >= 0\n"++    Hspec.it "works with caret operator" $ do+      expectGilded+        "-- cabal-gild: require ^>= 1.8"+        "-- cabal-gild: require ^>= 1.8\n"++    Hspec.it "works with compound range" $ do+      expectGilded+        "-- cabal-gild: require >= 0 && < 99999"+        "-- cabal-gild: require >= 0 && < 99999\n"++    Hspec.it "multiple require pragmas all satisfied" $ do+      expectGilded+        "-- cabal-gild: require >= 0\n-- cabal-gild: require >= 0"+        "-- cabal-gild: require >= 0\n-- cabal-gild: require >= 0\n"++    Hspec.it "multiple require pragmas first fails" $ do+      let (a, _s, _w) =+            runGild+              []+              [(Input.Stdin, String.toUtf8 "-- cabal-gild: require < 0\n-- cabal-gild: require >= 0")]+              (".", [])+              False+      a `Hspec.shouldSatisfy` Either.isLeft++    Hspec.it "multiple require pragmas second fails" $ do+      let (a, _s, _w) =+            runGild+              []+              [(Input.Stdin, String.toUtf8 "-- cabal-gild: require >= 0\n-- cabal-gild: require < 0")]+              (".", [])+              False+      a `Hspec.shouldSatisfy` Either.isLeft++    Hspec.it "ignores require pragma with trailing garbage" $ do+      expectGilded+        "-- cabal-gild: require < 0 trailing-garbage"+        "-- cabal-gild: require < 0 trailing-garbage\n"+   Hspec.it "parses an empty brace section" $ do     expectGilded       "s{}"@@ -1915,6 +1998,21 @@       expectGilded         "build-depends: x ( == 1 )"         "build-depends: x (==1)\n"++    Hspec.it "paren on left of and" $ do+      expectGilded+        "build-depends: x (>= 1) && < 2"+        "build-depends: x (>=1) && <2\n"++    Hspec.it "paren on left of or" $ do+      expectGilded+        "build-depends: x (>= 1) || < 2"+        "build-depends: x (>=1) || <2\n"++    Hspec.it "parens on both sides" $ do+      expectGilded+        "build-depends: x (>= 1) && (< 2)"+        "build-depends: x (>=1) && (<2)\n"    Hspec.around_ withTemporaryDirectory     . Hspec.it "discovers modules on the file system"