Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Allow discovering more fields #86

Merged
merged 1 commit into from
Jun 19, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
54 changes: 40 additions & 14 deletions README.md
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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:

Expand Down
1 change: 1 addition & 0 deletions cabal-gild.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
51 changes: 35 additions & 16 deletions source/library/CabalGild/Unstable/Action/EvaluatePragmas.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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.
Expand Down
6 changes: 6 additions & 0 deletions source/library/CabalGild/Unstable/Type/DiscoverTarget.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,6 @@
module CabalGild.Unstable.Type.DiscoverTarget where

data DiscoverTarget
= Files
| Modules
deriving (Eq, Show)
60 changes: 60 additions & 0 deletions source/test-suite/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down