Allow discovering more fields (#86)

tfausak · Jun 19, 2024 · 99b2c6c · 99b2c6c
1 parent cd1d839
commit 99b2c6c
Show file tree

Hide file tree

Showing 5 changed files with 142 additions and 30 deletions.
diff --git a/README.md b/README.md
@@ -183,10 +183,9 @@ before a field.
 -- cabal-gild: discover [DIRECTORY ...] [--include=PATTERN ...] [--exclude=PATTERN ...]
 ```
 
-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 directory of the package description). For example,
-given this input:
+This pragma will discover files in any of the given directories. If no
+directories are given, defaults to `.` (the directory of the package
+description). For example, given this input:
 
 ``` cabal
 library
@@ -203,16 +202,43 @@ library
   exposed-modules: Example
 ```
 
-This pragma only works with the `exposed-modules`, `other-modules`, and
-`signatures` fields. It will be ignored on all other fields.
-
-Any existing modules or signatures in the list will be ignored. The entire
-field 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`,
+This pragma works with the following fields:
+
+- `asm-sources`
+- `c-sources`
+- `cxx-sources`
+- `data-files`
+- `exposed-modules`
+- `extra-doc-files`
+- `extra-source-files`
+- `includes`
+- `install-includes`
+- `js-sources`
+- `license-files`
+- `other-modules`
+- `signatures`
+
+It will be ignored on all other fields. For the `exposed-modules`,
+`other-modules`, and `signatures` fields, only files with the following
+extensions will be discovered:
+
+- `*.chs`
+- `*.cpphs`
+- `*.gc`
+- `*.hs`
+- `*.hsc`
+- `*.hsig`
+- `*.lhs`
+- `*.lhsig`
+- `*.ly`
+- `*.x`
+- `*.y`
+
+For all other fields, files with any extension will be discovered.
+
+Any existing files, modules, or signatures in the field will be ignored. The
+entire field will be replaced. This means adding, removing, and renaming files
+should be handled automatically.
 
 Directories can be quoted if they contain spaces. For example:
 

diff --git a/cabal-gild.cabal b/cabal-gild.cabal
@@ -108,6 +108,7 @@ library
     CabalGild.Unstable.Type.Config
     CabalGild.Unstable.Type.Context
     CabalGild.Unstable.Type.Dependency
+    CabalGild.Unstable.Type.DiscoverTarget
     CabalGild.Unstable.Type.ExeDependency
     CabalGild.Unstable.Type.Extension
     CabalGild.Unstable.Type.Flag

diff --git a/source/library/CabalGild/Unstable/Action/EvaluatePragmas.hs b/source/library/CabalGild/Unstable/Action/EvaluatePragmas.hs
@@ -8,13 +8,15 @@ import qualified CabalGild.Unstable.Extra.ModuleName as ModuleName
 import qualified CabalGild.Unstable.Extra.Name as Name
 import qualified CabalGild.Unstable.Extra.String as String
 import qualified CabalGild.Unstable.Type.Comment as Comment
+import qualified CabalGild.Unstable.Type.DiscoverTarget as DiscoverTarget
 import qualified CabalGild.Unstable.Type.Pragma as Pragma
-import qualified Control.Monad as Monad
+import qualified Control.Applicative as Applicative
 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.Containers.ListUtils as List
 import qualified Data.Either as Either
+import qualified Data.Map as Map
 import qualified Data.Maybe as Maybe
 import qualified Data.Set as Set
 import qualified Distribution.Compat.Lens as Lens
@@ -44,11 +46,13 @@ field ::
   m (Fields.Field (p, [Comment.Comment q]))
 field p f = case f of
   Fields.Field n fls -> fmap (Maybe.fromMaybe f) . MaybeT.runMaybeT $ do
-    Monad.guard $ Set.member (Name.value n) relevantFieldNames
+    dt <-
+      maybe Applicative.empty pure $
+        Map.lookup (Name.value n) relevantFieldNames
     comment <- hoistMaybe . Utils.safeLast . snd $ Name.annotation n
     pragma <- hoistMaybe . Parsec.simpleParsecBS $ Comment.value comment
     case pragma of
-      Pragma.Discover ds -> discover p n fls ds
+      Pragma.Discover ds -> discover p n fls dt 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
@@ -58,9 +62,10 @@ discover ::
   FilePath ->
   Fields.Name (p, [c]) ->
   [Fields.FieldLine (p, [c])] ->
+  DiscoverTarget.DiscoverTarget ->
   [String] ->
   MaybeT.MaybeT m (Fields.Field (p, [c]))
-discover p n fls ds = do
+discover p n fls dt ds = do
   let (flgs, args, opts, errs) =
         GetOpt.getOpt'
           GetOpt.Permute
@@ -90,10 +95,16 @@ discover p n fls ds = do
       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 . normalize) files
+      fieldLines = case dt of
+        DiscoverTarget.Modules ->
+          zipWith ModuleName.toFieldLine ((,) position <$> comments : repeat [])
+            . Maybe.mapMaybe (toModuleName directories)
+            $ Maybe.mapMaybe (stripAnyExtension extensions . normalize) files
+        DiscoverTarget.Files ->
+          zipWith
+            (\a -> Fields.FieldLine a . String.toUtf8)
+            ((,) position <$> comments : repeat [])
+            files
       -- This isn't great, but the comments have to go /somewhere/.
       name =
         if null fieldLines
@@ -109,15 +120,23 @@ normalize =
 
 -- | These are the names of the fields that can have this action applied to
 -- them.
-relevantFieldNames :: Set.Set Fields.FieldName
+relevantFieldNames :: Map.Map Fields.FieldName DiscoverTarget.DiscoverTarget
 relevantFieldNames =
-  Set.fromList $
-    fmap
-      String.toUtf8
-      [ "exposed-modules",
-        "other-modules",
-        "signatures"
-      ]
+  Map.mapKeys String.toUtf8 . Map.fromList $
+    [ ("asm-sources", DiscoverTarget.Files),
+      ("c-sources", DiscoverTarget.Files),
+      ("cxx-sources", DiscoverTarget.Files),
+      ("data-files", DiscoverTarget.Files),
+      ("exposed-modules", DiscoverTarget.Modules),
+      ("extra-doc-files", DiscoverTarget.Files),
+      ("extra-source-files", DiscoverTarget.Files),
+      ("includes", DiscoverTarget.Files),
+      ("install-includes", DiscoverTarget.Files),
+      ("js-sources", DiscoverTarget.Files),
+      ("license-files", DiscoverTarget.Files),
+      ("other-modules", DiscoverTarget.Modules),
+      ("signatures", DiscoverTarget.Modules)
+    ]
 
 -- | 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.

diff --git a/source/library/CabalGild/Unstable/Type/DiscoverTarget.hs b/source/library/CabalGild/Unstable/Type/DiscoverTarget.hs
@@ -0,0 +1,6 @@
+module CabalGild.Unstable.Type.DiscoverTarget where
+
+data DiscoverTarget
+  = Files
+  | Modules
+  deriving (Eq, Show)
diff --git a/source/test-suite/Main.hs b/source/test-suite/Main.hs
@@ -1457,6 +1457,66 @@ main = Hspec.hspec . Hspec.parallel . Hspec.describe "cabal-gild" $ do
     w `Hspec.shouldBe` []
     s `Hspec.shouldBe` Map.singleton Output.Stdout (String.toUtf8 "library\n  -- cabal-gild: discover src --include src/M.hs\n  exposed-modules: M\n")
 
+  Hspec.it "discovers asm-sources" $ do
+    expectDiscover
+      [["example.txt"]]
+      "-- cabal-gild: discover\nasm-sources:"
+      "-- cabal-gild: discover\nasm-sources: example.txt\n"
+
+  Hspec.it "discovers c-sources" $ do
+    expectDiscover
+      [["example.txt"]]
+      "-- cabal-gild: discover\nc-sources:"
+      "-- cabal-gild: discover\nc-sources: example.txt\n"
+
+  Hspec.it "discovers cxx-sources" $ do
+    expectDiscover
+      [["example.txt"]]
+      "-- cabal-gild: discover\ncxx-sources:"
+      "-- cabal-gild: discover\ncxx-sources: example.txt\n"
+
+  Hspec.it "discovers data-files" $ do
+    expectDiscover
+      [["example.txt"]]
+      "-- cabal-gild: discover\ndata-files:"
+      "-- cabal-gild: discover\ndata-files: example.txt\n"
+
+  Hspec.it "discovers extra-doc-files" $ do
+    expectDiscover
+      [["example.txt"]]
+      "-- cabal-gild: discover\nextra-doc-files:"
+      "-- cabal-gild: discover\nextra-doc-files: example.txt\n"
+
+  Hspec.it "discovers extra-source-files" $ do
+    expectDiscover
+      [["example.txt"]]
+      "-- cabal-gild: discover\nextra-source-files:"
+      "-- cabal-gild: discover\nextra-source-files: example.txt\n"
+
+  Hspec.it "discovers includes" $ do
+    expectDiscover
+      [["example.txt"]]
+      "-- cabal-gild: discover\nincludes:"
+      "-- cabal-gild: discover\nincludes: example.txt\n"
+
+  Hspec.it "discovers install-includes" $ do
+    expectDiscover
+      [["example.txt"]]
+      "-- cabal-gild: discover\ninstall-includes:"
+      "-- cabal-gild: discover\ninstall-includes: example.txt\n"
+
+  Hspec.it "discovers js-sources" $ do
+    expectDiscover
+      [["example.txt"]]
+      "-- cabal-gild: discover\njs-sources:"
+      "-- cabal-gild: discover\njs-sources: example.txt\n"
+
+  Hspec.it "discovers license-files" $ do
+    expectDiscover
+      [["example.txt"]]
+      "-- cabal-gild: discover\nlicense-files:"
+      "-- cabal-gild: discover\nlicense-files: example.txt\n"
+
   Hspec.around_ withTemporaryDirectory
     . Hspec.it "discovers modules on the file system"
     $ do