cabal-gild 1.3.0.1 → 1.3.1.0

raw patch · 5 files changed

+219/−40 lines, 5 filesdep +temporarydep ~directoryPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: temporary

Dependency ranges changed: directory

API changes (from Hackage documentation)

Files

• README.md +15/−3
• cabal-gild.cabal +3/−1
• source/library/CabalGild/Unstable/Action/EvaluatePragmas.hs +57/−29
• source/library/CabalGild/Unstable/Type/Pragma.hs +8/−7
• source/test-suite/Main.hs +136/−0

@@ -178,9 +178,10 @@ Each pragma starts with `-- cabal-gild:`. Pragmas must be the last comment before a field. -- `-- cabal-gild: discover DIRECTORY [DIRECTORY ...]`: This pragma will-  discover any Haskell files in any of the given directories and use those to-  populate the list of modules or signatures. For example, given this input:+- `-- cabal-gild: discover [DIRECTORY ...]`: This pragma will discover any+  Haskell files in any of the given directories and use those to populate the+  list of modules or signatures. If no directories are given, defaults to `.`+  (the current directory). For example, given this input:    ``` cabal   library@@ -207,3 +208,14 @@   This pragma searches for files with any of the following extensions: `*.chs`,   `*.cpphs`, `*.gc`, `*.hs`, `*.hsc`, `*.hsig`, `*.lhs`, `*.lhsig`, `*.ly`,   `*.x`, or `*.y`,++  Directories can be quoted if they contain spaces.++  Discovered modules can be ignored by using the `--exclude=FILE` option. For+  example:++  ``` cabal+  library+    -- cabal-gild: discover source/library --exclude=source/library/Foo/Bar.hs+    exposed-modules: ...+  ```

@@ -11,7 +11,7 @@ maintainer: Taylor Fausak name: cabal-gild synopsis: Formats package descriptions.-version: 1.3.0.1+version: 1.3.1.0  source-repository head   type: git@@ -146,9 +146,11 @@   build-depends:     bytestring,     containers,+    directory,     exceptions,     filepath,     hspec ^>=2.11.7,+    temporary ^>=1.3,     transformers,    hs-source-dirs: source/test-suite

@@ -1,6 +1,8 @@ module CabalGild.Unstable.Action.EvaluatePragmas where  import qualified CabalGild.Unstable.Class.MonadWalk as MonadWalk+import qualified CabalGild.Unstable.Exception.InvalidOption as InvalidOption+import qualified CabalGild.Unstable.Exception.UnknownOption as UnknownOption import qualified CabalGild.Unstable.Extra.FieldLine as FieldLine import qualified CabalGild.Unstable.Extra.ModuleName as ModuleName import qualified CabalGild.Unstable.Extra.Name as Name@@ -8,9 +10,9 @@ import qualified CabalGild.Unstable.Type.Comment as Comment import qualified CabalGild.Unstable.Type.Pragma as Pragma import qualified Control.Monad as Monad+import qualified Control.Monad.Catch as Exception import qualified Control.Monad.Trans.Class as Trans import qualified Control.Monad.Trans.Maybe as MaybeT-import qualified Data.List.NonEmpty as NonEmpty import qualified Data.Maybe as Maybe import qualified Data.Set as Set import qualified Distribution.Compat.Lens as Lens@@ -18,12 +20,14 @@ import qualified Distribution.ModuleName as ModuleName import qualified Distribution.Parsec as Parsec import qualified Distribution.Utils.Generic as Utils+import qualified System.Console.GetOpt as GetOpt import qualified System.FilePath as FilePath+import qualified System.FilePath.Windows as FilePath.Windows  -- | High level wrapper around 'field' that makes this action easier to compose -- with other actions. run ::-  (MonadWalk.MonadWalk m) =>+  (Exception.MonadThrow m, MonadWalk.MonadWalk m) =>   FilePath ->   ([Fields.Field (p, [Comment.Comment q])], cs) ->   m ([Fields.Field (p, [Comment.Comment q])], cs)@@ -31,12 +35,8 @@  -- | Evaluates pragmas within the given field. Or, if the field is a section, -- evaluates pragmas recursively within the fields of the section.------ If modules are discovered for a field, that fields lines are completely--- replaced. If anything goes wrong while discovering modules, the original--- field is returned. field ::-  (MonadWalk.MonadWalk m) =>+  (Exception.MonadThrow m, MonadWalk.MonadWalk m) =>   FilePath ->   Fields.Field (p, [Comment.Comment q]) ->   m (Fields.Field (p, [Comment.Comment q]))@@ -46,29 +46,57 @@     comment <- hoistMaybe . Utils.safeLast . snd $ Name.annotation n     pragma <- hoistMaybe . Parsec.simpleParsecBS $ Comment.value comment     case pragma of-      Pragma.Discover ds -> do-        let root = FilePath.takeDirectory p-            directories =-              FilePath.dropTrailingPathSeparator-                . FilePath.normalise-                . FilePath.combine root-                <$> NonEmpty.toList ds-        files <- Trans.lift . fmap mconcat $ traverse MonadWalk.walk directories-        let comments = concatMap (snd . FieldLine.annotation) fls-            position =-              maybe (fst $ Name.annotation n) (fst . FieldLine.annotation) $-                Maybe.listToMaybe fls-            fieldLines =-              zipWith ModuleName.toFieldLine ((,) position <$> comments : repeat [])-                . Maybe.mapMaybe (toModuleName directories)-                $ Maybe.mapMaybe (stripAnyExtension extensions) files-            -- This isn't great, but the comments have to go /somewhere/.-            name =-              if null fieldLines-                then Lens.over (Name.annotationLens . Lens._2) (comments <>) n-                else n-        pure $ Fields.Field name fieldLines+      Pragma.Discover ds -> discover p n fls ds   Fields.Section n sas fs -> Fields.Section n sas <$> traverse (field p) fs++-- | If modules are discovered for a field, that fields lines are completely+-- replaced.+discover ::+  (Exception.MonadThrow m, MonadWalk.MonadWalk m) =>+  FilePath ->+  Fields.Name (p, [c]) ->+  [Fields.FieldLine (p, [c])] ->+  [String] ->+  MaybeT.MaybeT m (Fields.Field (p, [c]))+discover p n fls ds = do+  let (strs, args, opts, errs) =+        GetOpt.getOpt'+          GetOpt.Permute+          [ GetOpt.Option [] ["exclude"] (GetOpt.ReqArg id "FILE") ""+          ]+          ds+  mapM_ (Exception.throwM . UnknownOption.fromString) opts+  mapM_ (Exception.throwM . InvalidOption.fromString) errs+  let root = FilePath.takeDirectory p+      directories =+        FilePath.dropTrailingPathSeparator+          . normalize+          . FilePath.combine root+          <$> if null args then ["."] else args+  files <- Trans.lift . fmap mconcat $ traverse MonadWalk.walk directories+  let comments = concatMap (snd . FieldLine.annotation) fls+      position =+        maybe (fst $ Name.annotation n) (fst . FieldLine.annotation) $+          Maybe.listToMaybe fls+      excludedFiles = Set.fromList $ fmap normalize strs+      fieldLines =+        zipWith ModuleName.toFieldLine ((,) position <$> comments : repeat [])+          . Maybe.mapMaybe (toModuleName directories)+          . Maybe.mapMaybe (stripAnyExtension extensions)+          . filter (`Set.notMember` excludedFiles)+          $ fmap normalize files+      -- This isn't great, but the comments have to go /somewhere/.+      name =+        if null fieldLines+          then Lens.over (Name.annotationLens . Lens._2) (comments <>) n+          else n+  pure $ Fields.Field name fieldLines++normalize :: FilePath -> FilePath+normalize =+  FilePath.normalise+    . FilePath.joinPath+    . FilePath.Windows.splitDirectories  -- | These are the names of the fields that can have this action applied to -- them.

@@ -1,15 +1,14 @@ module CabalGild.Unstable.Type.Pragma where  import qualified Control.Monad as Monad-import qualified Data.List.NonEmpty as NonEmpty import qualified Distribution.Compat.CharParsing as CharParsing import qualified Distribution.FieldGrammar.Newtypes as Newtypes import qualified Distribution.Parsec as Parsec  -- | A pragma, which is a special comment used to customize behavior. newtype Pragma-  = -- | Discover modules within the given directory.-    Discover (NonEmpty.NonEmpty FilePath)+  = -- | Discover modules using the given arguments.+    Discover [String]   deriving (Eq, Show)  instance Parsec.Parsec Pragma where@@ -18,7 +17,9 @@     Monad.void $ CharParsing.string "cabal-gild:"     CharParsing.spaces     Monad.void $ CharParsing.string "discover"-    CharParsing.skipSpaces1-    Discover-      . fmap Newtypes.getFilePathNT-      <$> CharParsing.sepByNonEmpty Parsec.parsec CharParsing.skipSpaces1+    arguments <-+      Monad.mplus+        (CharParsing.skipSpaces1 *> CharParsing.sepBy Parsec.parsec CharParsing.skipSpaces1)+        ([] <$ CharParsing.spaces)+    CharParsing.eof+    pure . Discover $ fmap Newtypes.getToken' arguments

@@ -1,3 +1,4 @@+{- hlint ignore "Redundant bracket" -} {-# LANGUAGE GeneralizedNewtypeDeriving #-}  import qualified CabalGild.Unstable.Class.MonadLog as MonadLog@@ -5,8 +6,11 @@ import qualified CabalGild.Unstable.Class.MonadWalk as MonadWalk import qualified CabalGild.Unstable.Class.MonadWrite as MonadWrite import qualified CabalGild.Unstable.Exception.CheckFailure as CheckFailure+import qualified CabalGild.Unstable.Exception.InvalidOption as InvalidOption import qualified CabalGild.Unstable.Exception.SpecifiedOutputWithCheckMode as SpecifiedOutputWithCheckMode import qualified CabalGild.Unstable.Exception.SpecifiedStdinWithFileInput as SpecifiedStdinWithFileInput+import qualified CabalGild.Unstable.Exception.UnexpectedArgument as UnexpectedArgument+import qualified CabalGild.Unstable.Exception.UnknownOption as UnknownOption import qualified CabalGild.Unstable.Extra.String as String import qualified CabalGild.Unstable.Main as Gild import qualified CabalGild.Unstable.Type.Input as Input@@ -21,8 +25,10 @@ import qualified Data.Map as Map import qualified Data.Maybe as Maybe import qualified GHC.Stack as Stack+import qualified System.Directory as Directory import qualified System.Exit as Exit import qualified System.FilePath as FilePath+import qualified System.IO.Temp as Temp import qualified Test.Hspec as Hspec  main :: IO ()@@ -39,6 +45,24 @@     w `Hspec.shouldNotBe` []     s `Hspec.shouldBe` Map.empty +  Hspec.it "fails with an unknown option" $ do+    let (a, s, w) = runGild ["--unknown"] [] []+    a `shouldBeFailure` UnknownOption.UnknownOption "--unknown"+    w `Hspec.shouldBe` []+    s `Hspec.shouldBe` Map.empty++  Hspec.it "fails with an invalid option" $ do+    let (a, s, w) = runGild ["--help=invalid"] [] []+    a `shouldBeFailure` InvalidOption.InvalidOption "option `--help' doesn't allow an argument"+    w `Hspec.shouldBe` []+    s `Hspec.shouldBe` Map.empty++  Hspec.it "fails with an unexpected argument" $ do+    let (a, s, w) = runGild ["unexpected"] [] []+    a `shouldBeFailure` UnexpectedArgument.UnexpectedArgument "unexpected"+    w `Hspec.shouldBe` []+    s `Hspec.shouldBe` Map.empty+   Hspec.it "reads from an input file" $ do     let (a, s, w) =           runGild@@ -1030,6 +1054,86 @@       "library\n -- cabal-gild: discover d e\n exposed-modules:"       "library\n  -- cabal-gild: discover d e\n  exposed-modules:\n    M\n    N\n" +  Hspec.it "discovers from a quoted directory" $ do+    expectDiscover+      [("d", ["M.hs"])]+      "library\n -- cabal-gild: discover \"d\"\n exposed-modules:"+      "library\n  -- cabal-gild: discover \"d\"\n  exposed-modules: M\n"++  Hspec.it "discovers from a directory with a space" $ do+    expectDiscover+      [("s p", ["M.hs"])]+      "library\n -- cabal-gild: discover \"s p\"\n exposed-modules:"+      "library\n  -- cabal-gild: discover \"s p\"\n  exposed-modules: M\n"++  Hspec.it "discovers from the current directory by default" $ do+    expectDiscover+      [(".", ["M.hs"])]+      "library\n -- cabal-gild: discover\n exposed-modules:"+      "library\n  -- cabal-gild: discover\n  exposed-modules: M\n"++  Hspec.it "allows excluding a path when discovering" $ do+    expectDiscover+      [(".", ["M.hs", "N.hs"])]+      "library\n -- cabal-gild: discover --exclude M.hs\n exposed-modules:"+      "library\n  -- cabal-gild: discover --exclude M.hs\n  exposed-modules: N\n"++  Hspec.it "allows excluding a nested POSIX path" $ do+    expectDiscover+      [(".", [FilePath.combine "A" "M.hs", FilePath.combine "B" "M.hs"])]+      "library\n -- cabal-gild: discover --exclude B/M.hs\n exposed-modules:"+      "library\n  -- cabal-gild: discover --exclude B/M.hs\n  exposed-modules: A.M\n"++  Hspec.it "allows excluding a nested Windows path" $ do+    expectDiscover+      [(".", [FilePath.combine "A" "M.hs", FilePath.combine "B" "M.hs"])]+      "library\n -- cabal-gild: discover --exclude B\\M.hs\n exposed-modules:"+      "library\n  -- cabal-gild: discover --exclude B\\M.hs\n  exposed-modules: A.M\n"++  Hspec.it "allows excluding a relative POSIX path" $ do+    expectDiscover+      [(".", ["M.hs", "N.hs"])]+      "library\n -- cabal-gild: discover --exclude ./M.hs\n exposed-modules:"+      "library\n  -- cabal-gild: discover --exclude ./M.hs\n  exposed-modules: N\n"++  Hspec.it "allows excluding a relative Windows path" $ do+    expectDiscover+      [(".", ["M.hs", "N.hs"])]+      "library\n -- cabal-gild: discover --exclude .\\M.hs\n exposed-modules:"+      "library\n  -- cabal-gild: discover --exclude .\\M.hs\n  exposed-modules: N\n"++  Hspec.it "allows excluding multiple paths" $ do+    expectDiscover+      [(".", ["M.hs", "N.hs", "O.hs"])]+      "library\n -- cabal-gild: discover --exclude M.hs --exclude O.hs\n exposed-modules:"+      "library\n  -- cabal-gild: discover --exclude M.hs --exclude O.hs\n  exposed-modules: N\n"++  Hspec.it "allows excluding paths that don't match anything" $ do+    expectDiscover+      [(".", ["M.hs"])]+      "library\n -- cabal-gild: discover --exclude N.hs\n exposed-modules:"+      "library\n  -- cabal-gild: discover --exclude N.hs\n  exposed-modules: M\n"++  Hspec.it "fails when discovering with an unknown option" $ do+    let (a, s, w) =+          runGild+            []+            [(Input.Stdin, String.toUtf8 "-- cabal-gild: discover --unknown\nsignatures:")]+            []+    a `shouldBeFailure` UnknownOption.UnknownOption "--unknown"+    w `Hspec.shouldBe` []+    s `Hspec.shouldBe` Map.empty++  Hspec.it "fails when discovering with an invalid option" $ do+    let (a, s, w) =+          runGild+            []+            [(Input.Stdin, String.toUtf8 "-- cabal-gild: discover --exclude\nsignatures:")]+            []+    a `shouldBeFailure` InvalidOption.InvalidOption "option `--exclude' requires an argument FILE"+    w `Hspec.shouldBe` []+    s `Hspec.shouldBe` Map.empty+   Hspec.it "retains comments when discovering" $ do     expectDiscover       [(".", ["M.hs"])]@@ -1128,6 +1232,38 @@     expectGilded       "f:\ng: a"       "f:\ng: a\n"++  Hspec.around_ withTemporaryDirectory+    . Hspec.it "discovers modules on the file system"+    $ do+      -- Although we already have pure tests for this behavior, it's important+      -- to ensure that both POSIX and Windows paths are supported on the real+      -- file system.+      writeFile "i.cabal" $+        unlines+          [ "library",+            "  -- cabal-gild: discover --exclude=.\\M2.hs --exclude=N/M1.hs",+            "  exposed-modules:"+          ]+      writeFile "M1.hs" ""+      writeFile "M2.hs" ""+      Directory.createDirectory "N"+      writeFile (FilePath.combine "N" "M1.hs") ""+      writeFile (FilePath.combine "N" "M2.hs") ""+      Gild.mainWith ["--input=i.cabal", "--output=o.cabal"]+      readFile "o.cabal"+        `Hspec.shouldReturn` unlines+          [ "library",+            "  -- cabal-gild: discover --exclude=.\\M2.hs --exclude=N/M1.hs",+            "  exposed-modules:",+            "    M1",+            "    N.M2"+          ]++withTemporaryDirectory :: IO () -> IO ()+withTemporaryDirectory =+  Temp.withSystemTempDirectory "cabal-gild"+    . flip Directory.withCurrentDirectory  shouldBeFailure ::   (Stack.HasCallStack, Eq e, Exception.Exception e, Show a) =>