cabal-gild 1.0.1.0 → 1.0.2.0

raw patch · 8 files changed

+159/−49 lines, 8 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• README.md +12/−8
• cabal-gild.cabal +1/−1
• source/library/CabalGild/Action/EvaluatePragmas.hs +58/−23
• source/library/CabalGild/Class/MonadWalk.hs +1/−1
• source/library/CabalGild/Type/Flag.hs +4/−3
• source/library/CabalGild/Type/Pragma.hs +5/−2
• source/library/CabalGild/Type/SomeParsecParser.hs +2/−1
• source/test-suite/Main.hs +76/−10

@@ -161,9 +161,9 @@ Each pragma starts with `-- cabal-gild:`. Pragmas must be the last comment before a field. -- `-- cabal-gild: discover DIRECTORY`: This pragma will discover any Haskell-  files (`*.hs` or `*.lhs`) in the given directory and use those to populate-  the list of modules. For example, given this input:+- `-- 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   library@@ -180,9 +180,13 @@     exposed-modules: M   ``` -  This pragma only works with the `exposed-modules` and `other-modules` fields.-  It will be ignored on all other fields.+  This pragma only works with the `exposed-modules`, `other-modules`, and+  `signatures` fields. It will be ignored on all other fields. -  Any existing modules in the list will be ignored. The entire field will be-  replaced. This means adding, removing, and renaming modules should be handled-  automatically.+  Any existing modules or signatures in the list will be ignored. The entire+  field (including comments) will be replaced. This means adding, removing, and+  renaming modules or signatures should be handled automatically.++  This pragma searches for files with any of the following extensions: `*.chs`,+  `*.cpphs`, `*.gc`, `*.hs`, `*.hsc`, `*.hsig`, `*.lhs`, `*.lhsig`, `*.ly`,+  `*.x`, or `*.y`,

@@ -11,7 +11,7 @@ maintainer: Taylor Fausak name: cabal-gild synopsis: Formats package descriptions.-version: 1.0.1.0+version: 1.0.2.0  source-repository head   type: git

@@ -6,12 +6,14 @@ import qualified CabalGild.Extra.String as String import qualified CabalGild.Type.Comment as Comment import qualified CabalGild.Type.Pragma as Pragma+import qualified Control.Monad as Monad import qualified Control.Monad.Trans.Class as Trans import qualified Control.Monad.Trans.Maybe as MaybeT-import qualified Data.Map as Map+import qualified Data.List.NonEmpty as NonEmpty import qualified Data.Maybe as Maybe import qualified Data.Set as Set import qualified Distribution.Fields as Fields+import qualified Distribution.ModuleName as ModuleName import qualified Distribution.Parsec as Parsec import qualified Distribution.Utils.Generic as Utils import qualified System.FilePath as FilePath@@ -31,7 +33,7 @@   FilePath ->   [Fields.Field [Comment.Comment a]] ->   m [Fields.Field [Comment.Comment a]]-fields = mapM . field+fields = traverse . field  -- | Evaluates pragmas within the given field. Or, if the field is a section, -- evaluates pragmas recursively within the fields of the section.@@ -46,20 +48,37 @@   m (Fields.Field [Comment.Comment a]) field p f = case f of   Fields.Field n _ -> fmap (Maybe.fromMaybe f) . MaybeT.runMaybeT $ do-    es <- hoistMaybe . Map.lookup (Name.value n) $ extensions-    c <- hoistMaybe . Utils.safeLast $ Name.annotation n-    x <- hoistMaybe . Parsec.simpleParsecBS $ Comment.value c-    y <- case x of-      Pragma.Discover y -> pure y-    let d = FilePath.combine (FilePath.takeDirectory p) y-    fs <- Trans.lift $ MonadWalk.walk d-    pure-      . Fields.Field n-      . fmap (ModuleName.toFieldLine [])-      . Maybe.mapMaybe (ModuleName.fromFilePath . FilePath.makeRelative d)-      $ Maybe.mapMaybe (stripAnyExtension es) fs+    Monad.guard $ Set.member (Name.value n) relevantFieldNames+    comment <- hoistMaybe . Utils.safeLast $ 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+        pure+          . Fields.Field n+          . fmap (ModuleName.toFieldLine [])+          . Maybe.mapMaybe (toModuleName directories)+          $ Maybe.mapMaybe (stripAnyExtension extensions) files   Fields.Section n sas fs -> Fields.Section n sas <$> fields p fs +-- | These are the names of the fields that can have this action applied to+-- them.+relevantFieldNames :: Set.Set Fields.FieldName+relevantFieldNames =+  Set.fromList $+    fmap+      String.toUtf8+      [ "exposed-modules",+        "other-modules",+        "signatures"+      ]+ -- | Attempts to strip any of the given extensions from the file path. If any -- of them succeed, the result is returned. Otherwise 'Nothing' is returned. stripAnyExtension :: Set.Set String -> FilePath -> Maybe String@@ -68,16 +87,32 @@     . Maybe.mapMaybe (`FilePath.stripExtension` p)     $ Set.toList es --- | A map from field names to the set of extensions that should be discovered--- for that field.-extensions :: Map.Map Fields.FieldName (Set.Set String)+-- | The set of extensions that should be discovered by this pragma. Any file+-- with one of these extensions will be discovered.+--+-- <https://cabal.readthedocs.io/en/3.10/cabal-package.html#modules-and-preprocessors>+extensions :: Set.Set String extensions =-  let (=:) :: String -> [String] -> (Fields.FieldName, Set.Set String)-      k =: v = (String.toUtf8 k, Set.fromList v)-   in Map.fromList-        [ "exposed-modules" =: ["hs", "lhs"],-          "other-modules" =: ["hs", "lhs"]-        ]+  Set.fromList+    [ "chs",+      "cpphs",+      "gc",+      "hs",+      "hsc",+      "hsig",+      "lhs",+      "lhsig",+      "ly",+      "x",+      "y"+    ]++-- | Attempts to convert a file path (without an extension) into a module name+-- by making it relative to one of the given directories.+toModuleName :: [FilePath] -> FilePath -> Maybe ModuleName.ModuleName+toModuleName ds f =+  Maybe.listToMaybe $+    Maybe.mapMaybe (ModuleName.fromFilePath . flip FilePath.makeRelative f) ds  -- | This was added in @transformers-0.6.0.0@. See -- <https://hub.darcs.net/ross/transformers/issue/49>.

@@ -25,4 +25,4 @@         if b           then listDirectoryRecursively p           else pure [p]-  concat <$> mapM f es+  mconcat <$> traverse f es

@@ -4,6 +4,7 @@ import qualified CabalGild.Exception.UnexpectedArgument as UnexpectedArgument import qualified CabalGild.Exception.UnknownOption as UnknownOption import qualified Control.Monad.Catch as Exception+import qualified Data.Foldable as Foldable import qualified System.Console.GetOpt as GetOpt  -- | A flag, which represents a command line option. The values associated with@@ -69,7 +70,7 @@ fromArguments :: (Exception.MonadThrow m) => [String] -> m [Flag] fromArguments arguments = do   let (flgs, args, opts, errs) = GetOpt.getOpt' GetOpt.Permute options arguments-  mapM_ (Exception.throwM . UnexpectedArgument.fromString) args-  mapM_ (Exception.throwM . InvalidOption.fromString) errs-  mapM_ (Exception.throwM . UnknownOption.fromString) opts+  Foldable.traverse_ (Exception.throwM . UnexpectedArgument.fromString) args+  Foldable.traverse_ (Exception.throwM . InvalidOption.fromString) errs+  Foldable.traverse_ (Exception.throwM . UnknownOption.fromString) opts   pure flgs

@@ -1,6 +1,7 @@ module CabalGild.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@@ -8,7 +9,7 @@ -- | A pragma, which is a special comment used to customize behavior. newtype Pragma   = -- | Discover modules within the given directory.-    Discover FilePath+    Discover (NonEmpty.NonEmpty FilePath)   deriving (Eq, Show)  instance Parsec.Parsec Pragma where@@ -18,4 +19,6 @@     CharParsing.spaces     Monad.void $ CharParsing.string "discover"     CharParsing.skipSpaces1-    Discover . Newtypes.getFilePathNT <$> Parsec.parsec+    Discover+      . fmap Newtypes.getFilePathNT+      <$> CharParsing.sepByNonEmpty Parsec.parsec CharParsing.skipSpaces1

@@ -17,7 +17,8 @@ -- | This type bundles up a parser and a pretty printer for some type. -- Typically they will just be monomorphic versions of 'Parsec.parsec' and -- 'Pretty.prettyVersioned'.-data SomeParsecParser = forall a.+data SomeParsecParser+  = forall a.   SomeParsecParser   { parsec :: Parsec.ParsecParser a,     pretty :: CabalSpecVersion.CabalSpecVersion -> a -> PrettyPrint.Doc

@@ -752,34 +752,94 @@    Hspec.it "discovers an exposed module" $ do     expectDiscover-      ["M.hs"]+      [(".", ["M.hs"])]       "library\n -- cabal-gild: discover .\n exposed-modules:"       "library\n  -- cabal-gild: discover .\n  exposed-modules: M\n"    Hspec.it "discovers an other module" $ do     expectDiscover-      ["M.hs"]+      [(".", ["M.hs"])]       "library\n -- cabal-gild: discover .\n other-modules:"       "library\n  -- cabal-gild: discover .\n  other-modules: M\n"    Hspec.it "discovers a nested module" $ do     expectDiscover-      [FilePath.combine "N" "O.hs"]+      [(".", [FilePath.combine "N" "O.hs"])]       "library\n -- cabal-gild: discover .\n exposed-modules:"       "library\n  -- cabal-gild: discover .\n  exposed-modules: N.O\n"    Hspec.it "discovers multiple modules" $ do     expectDiscover-      ["M.hs", "N.hs"]+      [(".", ["M.hs", "N.hs"])]       "library\n -- cabal-gild: discover .\n exposed-modules:"       "library\n  -- cabal-gild: discover .\n  exposed-modules:\n    M\n    N\n" -  Hspec.it "discovers a literate haskell module" $ do+  Hspec.it "discovers a .lhs file" $ do     expectDiscover-      ["M.lhs"]+      [(".", ["M.lhs"])]       "library\n -- cabal-gild: discover .\n exposed-modules:"       "library\n  -- cabal-gild: discover .\n  exposed-modules: M\n" +  Hspec.it "discovers a .gc file" $ do+    expectDiscover+      [(".", ["M.gc"])]+      "library\n -- cabal-gild: discover .\n exposed-modules:"+      "library\n  -- cabal-gild: discover .\n  exposed-modules: M\n"++  Hspec.it "discovers a .chs file" $ do+    expectDiscover+      [(".", ["M.chs"])]+      "library\n -- cabal-gild: discover .\n exposed-modules:"+      "library\n  -- cabal-gild: discover .\n  exposed-modules: M\n"++  Hspec.it "discovers a .hsc file" $ do+    expectDiscover+      [(".", ["M.hsc"])]+      "library\n -- cabal-gild: discover .\n exposed-modules:"+      "library\n  -- cabal-gild: discover .\n  exposed-modules: M\n"++  Hspec.it "discovers a .y file" $ do+    expectDiscover+      [(".", ["M.y"])]+      "library\n -- cabal-gild: discover .\n exposed-modules:"+      "library\n  -- cabal-gild: discover .\n  exposed-modules: M\n"++  Hspec.it "discovers a .ly file" $ do+    expectDiscover+      [(".", ["M.ly"])]+      "library\n -- cabal-gild: discover .\n exposed-modules:"+      "library\n  -- cabal-gild: discover .\n  exposed-modules: M\n"++  Hspec.it "discovers a .x file" $ do+    expectDiscover+      [(".", ["M.x"])]+      "library\n -- cabal-gild: discover .\n exposed-modules:"+      "library\n  -- cabal-gild: discover .\n  exposed-modules: M\n"++  Hspec.it "discovers a .cpphs file" $ do+    expectDiscover+      [(".", ["M.cpphs"])]+      "library\n -- cabal-gild: discover .\n exposed-modules:"+      "library\n  -- cabal-gild: discover .\n  exposed-modules: M\n"++  Hspec.it "discovers a .hsig file" $ do+    expectDiscover+      [(".", ["M.hsig"])]+      "library\n -- cabal-gild: discover .\n exposed-modules:"+      "library\n  -- cabal-gild: discover .\n  exposed-modules: M\n"++  Hspec.it "discovers a .lhsig file" $ do+    expectDiscover+      [(".", ["M.lhsig"])]+      "library\n -- cabal-gild: discover .\n exposed-modules:"+      "library\n  -- cabal-gild: discover .\n  exposed-modules: M\n"++  Hspec.it "discovers a signature" $ do+    expectDiscover+      [(".", ["S.hsig"])]+      "library\n -- cabal-gild: discover .\n signatures:"+      "library\n  -- cabal-gild: discover .\n  signatures: S\n"+   Hspec.it "ignores discover pragma separated by comment" $ do     expectGilded       "library\n -- cabal-gild: discover .\n -- foo\n exposed-modules: M"@@ -795,12 +855,18 @@       "-- cabal-gild: unknown"       "-- cabal-gild: unknown\n" +  Hspec.it "discovers from multiple directories" $ do+    expectDiscover+      [("d", ["M.hs"]), ("e", ["N.hs"])]+      "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"+ expectGilded :: (Stack.HasCallStack) => String -> String -> Hspec.Expectation expectGilded input expected = do   let (a, s, w) =         runTest           (Gild.mainWith "" [])-          (Map.singleton Nothing (String.toUtf8 input), Map.empty)+          (Map.singleton Nothing $ String.toUtf8 input, Map.empty)           Map.empty   a `Hspec.shouldBe` Right ()   w `Hspec.shouldBe` []@@ -825,13 +891,13 @@     _ -> fail $ "impossible: " <> show s   output `Hspec.shouldBe` input -expectDiscover :: [FilePath] -> String -> String -> Hspec.Expectation+expectDiscover :: [(FilePath, [FilePath])] -> String -> String -> Hspec.Expectation expectDiscover files input expected = do   let (a, s, w) =         runTest           (Gild.mainWith "" [])-          ( Map.singleton Nothing (String.toUtf8 input),-            Map.singleton (FilePath.combine "." ".") files+          ( Map.singleton Nothing $ String.toUtf8 input,+            Map.fromList $ fmap (\(d, fs) -> (d, FilePath.combine d <$> fs)) files           )           Map.empty   a `Hspec.shouldBe` Right ()