cabal-gild 1.8.2.0 → 1.8.2.1

raw patch · 6 files changed

+134/−12 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• cabal-gild.cabal +3/−1
• source/library/CabalGild/Unstable/Action/EvaluatePragmas.hs +5/−2
• source/library/CabalGild/Unstable/Action/EvaluatePragmas/WarnUnknown.hs +71/−0
• source/library/CabalGild/Unstable/Class/MonadWarn.hs +12/−0
• source/library/CabalGild/Unstable/Main.hs +3/−1
• source/test-suite/Main.hs +40/−8

@@ -11,7 +11,7 @@ maintainer: Taylor Fausak name: cabal-gild synopsis: Formats package descriptions.-version: 1.8.2.0+version: 1.8.2.1  source-repository head   type: git@@ -72,6 +72,7 @@     CabalGild.Unstable.Action.EvaluatePragmas.Discover     CabalGild.Unstable.Action.EvaluatePragmas.Require     CabalGild.Unstable.Action.EvaluatePragmas.Version+    CabalGild.Unstable.Action.EvaluatePragmas.WarnUnknown     CabalGild.Unstable.Action.ExtractComments     CabalGild.Unstable.Action.FormatFields     CabalGild.Unstable.Action.GetCabalVersion@@ -82,6 +83,7 @@     CabalGild.Unstable.Class.MonadLog     CabalGild.Unstable.Class.MonadRead     CabalGild.Unstable.Class.MonadWalk+    CabalGild.Unstable.Class.MonadWarn     CabalGild.Unstable.Class.MonadWrite     CabalGild.Unstable.Exception.CheckFailure     CabalGild.Unstable.Exception.DuplicateOption

@@ -3,7 +3,9 @@ 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.Action.EvaluatePragmas.WarnUnknown as WarnUnknown import qualified CabalGild.Unstable.Class.MonadWalk as MonadWalk+import qualified CabalGild.Unstable.Class.MonadWarn as MonadWarn import qualified CabalGild.Unstable.Type.Comment as Comment import qualified CabalGild.Unstable.Type.Comments as Comments import qualified Control.Monad as Monad@@ -13,11 +15,12 @@ -- | High level wrapper around 'field' that makes this action easier to compose -- with other actions. run ::-  (Exception.MonadThrow m, MonadWalk.MonadWalk m) =>+  (Exception.MonadThrow m, MonadWalk.MonadWalk m, MonadWarn.MonadWarn m) =>   FilePath ->   ([Fields.Field (p, Comments.Comments q)], [Comment.Comment q]) ->   m ([Fields.Field (p, Comments.Comments q)], [Comment.Comment q]) run p =-  EvaluateRequire.run+  WarnUnknown.run+    Monad.>=> EvaluateRequire.run     Monad.>=> EvaluateVersion.run     Monad.>=> EvaluateDiscover.run p

@@ -0,0 +1,71 @@+module CabalGild.Unstable.Action.EvaluatePragmas.WarnUnknown where++import qualified CabalGild.Unstable.Action.EvaluatePragmas.Discover as Discover+import qualified CabalGild.Unstable.Action.EvaluatePragmas.Require as Require+import qualified CabalGild.Unstable.Action.EvaluatePragmas.Version as Version+import qualified CabalGild.Unstable.Class.MonadWarn as MonadWarn+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 Data.ByteString as ByteString+import qualified Data.Maybe as Maybe+import qualified Distribution.Compat.CharParsing as CharParsing+import qualified Distribution.Fields as Fields+import qualified Distribution.Parsec as Parsec++run ::+  (MonadWarn.MonadWarn m) =>+  ([Fields.Field (p, Comments.Comments q)], [Comment.Comment q]) ->+  m ([Fields.Field (p, Comments.Comments q)], [Comment.Comment q])+run (fs, cs) = do+  mapM_ field fs+  mapM_ warnComment cs+  pure (fs, cs)++field ::+  (MonadWarn.MonadWarn m) =>+  Fields.Field (p, Comments.Comments q) ->+  m ()+field f = case f of+  Fields.Field n fls -> do+    warnComments . snd $ Name.annotation n+    mapM_ (warnComments . snd . FieldLine.annotation) fls+  Fields.Section n _ fs -> do+    warnComments . snd $ Name.annotation n+    mapM_ field fs++warnComments ::+  (MonadWarn.MonadWarn m) =>+  Comments.Comments q ->+  m ()+warnComments cs = do+  mapM_ warnComment (Comments.before cs)+  mapM_ warnComment (Comments.after cs)++warnComment ::+  (MonadWarn.MonadWarn m) =>+  Comment.Comment q ->+  m ()+warnComment c =+  let bs = Comment.value c+   in case Parsec.simpleParsecBS bs :: Maybe (Pragma.Pragma PragmaBody) of+        Nothing -> pure ()+        Just (Pragma.Pragma (PragmaBody body))+          | isKnownPragma bs -> pure ()+          | otherwise ->+              MonadWarn.warnLn $ "warning: unknown pragma \"" <> body <> "\""++-- | Checks whether a comment parses as any known pragma type.+isKnownPragma :: ByteString.ByteString -> Bool+isKnownPragma bs =+  Maybe.isJust (Parsec.simpleParsecBS bs :: Maybe (Pragma.Pragma Discover.Discover))+    || Maybe.isJust (Parsec.simpleParsecBS bs :: Maybe (Pragma.Pragma Require.Require))+    || Maybe.isJust (Parsec.simpleParsecBS bs :: Maybe (Pragma.Pragma Version.Version))++-- | Captures all text after the "cabal-gild:" prefix.+newtype PragmaBody = PragmaBody String++instance Parsec.Parsec PragmaBody where+  parsec = PragmaBody <$> CharParsing.many CharParsing.anyChar

@@ -0,0 +1,12 @@+module CabalGild.Unstable.Class.MonadWarn where++import qualified System.IO as IO++-- | A 'Monad' that can also emit warnings.+class (Monad m) => MonadWarn m where+  -- | Emits the given warning message followed by a newline.+  warnLn :: String -> m ()++-- | Uses 'hPutStrLn' on 'stderr'.+instance MonadWarn IO where+  warnLn = IO.hPutStrLn IO.stderr

@@ -13,6 +13,7 @@ import qualified CabalGild.Unstable.Class.MonadLog as MonadLog import qualified CabalGild.Unstable.Class.MonadRead as MonadRead import qualified CabalGild.Unstable.Class.MonadWalk as MonadWalk+import qualified CabalGild.Unstable.Class.MonadWarn as MonadWarn import qualified CabalGild.Unstable.Class.MonadWrite as MonadWrite import qualified CabalGild.Unstable.Exception.CheckFailure as CheckFailure import qualified CabalGild.Unstable.Exception.ParseError as ParseError@@ -60,6 +61,7 @@     MonadRead.MonadRead m,     Exception.MonadThrow m,     MonadWalk.MonadWalk m,+    MonadWarn.MonadWarn m,     MonadWrite.MonadWrite m   ) =>   [String] ->@@ -84,7 +86,7 @@ -- is invalid. The 'MonadWalk.MonadWalk' constraint is used to discover modules -- on the file system. Typically @m@ will be 'IO'. format ::-  (Exception.MonadThrow m, MonadWalk.MonadWalk m) =>+  (Exception.MonadThrow m, MonadWalk.MonadWalk m, MonadWarn.MonadWarn m) =>   FilePath ->   ByteString.ByteString ->   m ByteString.ByteString

@@ -5,6 +5,7 @@ import qualified CabalGild.Unstable.Class.MonadLog as MonadLog import qualified CabalGild.Unstable.Class.MonadRead as MonadRead import qualified CabalGild.Unstable.Class.MonadWalk as MonadWalk+import qualified CabalGild.Unstable.Class.MonadWarn as MonadWarn import qualified CabalGild.Unstable.Class.MonadWrite as MonadWrite import qualified CabalGild.Unstable.Exception.CheckFailure as CheckFailure import qualified CabalGild.Unstable.Exception.DuplicateOption as DuplicateOption@@ -1405,11 +1406,35 @@       "-- cabal-gild: discover\nname: p"       "-- cabal-gild: discover\nname: p\n" -  Hspec.it "ignores unknown pragma" $ do-    expectGilded-      "-- cabal-gild: unknown"-      "-- cabal-gild: unknown\n"+  Hspec.it "warns on unknown pragma" $ do+    let (a, s, w) = runGild [] [(Input.Stdin, String.toUtf8 "-- cabal-gild: unknown")] (".", []) False+    a `Hspec.shouldSatisfy` Either.isRight+    w `Hspec.shouldBe` ["warning: unknown pragma \"unknown\""]+    actual <- case Map.toList s of+      [(Output.Stdout, x)] -> pure x+      _ -> fail $ "impossible: " <> show s+    actual `Hspec.shouldBe` String.toUtf8 "-- cabal-gild: unknown\n" +  Hspec.it "does not warn on valid pragmas" $ do+    let (a, _s, w) = runGild [] [(Input.Stdin, String.toUtf8 "-- cabal-gild: version\nname: p")] (".", []) False+    a `Hspec.shouldSatisfy` Either.isRight+    w `Hspec.shouldBe` []++  Hspec.it "does not warn on regular comments" $ do+    let (a, _s, w) = runGild [] [(Input.Stdin, String.toUtf8 "-- just a comment\nname: p")] (".", []) False+    a `Hspec.shouldSatisfy` Either.isRight+    w `Hspec.shouldBe` []++  Hspec.it "warns on empty pragma" $ do+    let (a, _s, w) = runGild [] [(Input.Stdin, String.toUtf8 "-- cabal-gild:\nname: p")] (".", []) False+    a `Hspec.shouldSatisfy` Either.isRight+    w `Hspec.shouldBe` ["warning: unknown pragma \"\""]++  Hspec.it "warns on known pragma with invalid arguments" $ do+    let (a, _s, w) = runGild [] [(Input.Stdin, String.toUtf8 "-- cabal-gild: require broken\nname: p")] (".", []) False+    a `Hspec.shouldSatisfy` Either.isRight+    w `Hspec.shouldBe` ["warning: unknown pragma \"require broken\""]+   Hspec.it "discovers from the currently directory explicitly" $ do     expectDiscover       (".", [["M.hs"]])@@ -1695,10 +1720,14 @@               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 "warns on require pragma with trailing garbage" $ do+      let (a, s, w) = runGild [] [(Input.Stdin, String.toUtf8 "-- cabal-gild: require < 0 trailing-garbage")] (".", []) False+      a `Hspec.shouldSatisfy` Either.isRight+      w `Hspec.shouldBe` ["warning: unknown pragma \"require < 0 trailing-garbage\""]+      actual <- case Map.toList s of+        [(Output.Stdout, x)] -> pure x+        _ -> fail $ "impossible: " <> show s+      actual `Hspec.shouldBe` String.toUtf8 "-- cabal-gild: require < 0 trailing-garbage\n"    Hspec.it "parses an empty brace section" $ do     expectGilded@@ -2180,6 +2209,9 @@  instance (Monad m) => MonadLog.MonadLog (TestT m) where   logLn = TestT . Trans.lift . RWST.tell . pure++instance (Monad m) => MonadWarn.MonadWarn (TestT m) where+  warnLn = TestT . Trans.lift . RWST.tell . pure  instance (Monad m) => MonadRead.MonadRead (TestT m) where   read k = do