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

Desugar local build tools to build-tool-depends (fixes #516) #567

Open
wants to merge 1 commit into
base: main
Choose a base branch
from
Open
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
12 changes: 4 additions & 8 deletions src/Hpack/Config.hs
Original file line number Diff line number Diff line change
Expand Up @@ -983,7 +983,7 @@ data Executable = Executable {
, executableGeneratedModules :: [Module]
} deriving (Eq, Show)

data BuildTool = BuildTool String String | LocalBuildTool String
data BuildTool = BuildTool String String
deriving (Show, Eq, Ord)

data Section a = Section {
Expand Down Expand Up @@ -1517,14 +1517,11 @@ toSection packageName_ executableNames = go

type SystemBuildTool = (String, VersionConstraint)

toBuildTool :: Monad m => String -> [String] -> (ParseBuildTool, DependencyVersion)
-> Warnings m (Either SystemBuildTool (BuildTool, DependencyVersion))
toBuildTool :: Monad m => String -> [String] -> (ParseBuildTool, DependencyVersion) -> Warnings m (Either SystemBuildTool (BuildTool, DependencyVersion))
toBuildTool packageName_ executableNames = \ case
(QualifiedBuildTool pkg executable, v)
| pkg == packageName_ && executable `elem` executableNames -> localBuildTool executable v
| otherwise -> buildTool pkg executable v
(QualifiedBuildTool pkg executable, v) -> buildTool pkg executable v
(UnqualifiedBuildTool executable, v)
| executable `elem` executableNames -> localBuildTool executable v
| executable `elem` executableNames -> buildTool packageName_ executable v
| Just pkg <- lookup executable legacyTools -> legacyBuildTool pkg executable v
| executable `elem` legacySystemTools, DependencyVersion Nothing c <- v -> legacySystemBuildTool executable c
| otherwise -> buildTool executable executable v
Expand All @@ -1533,7 +1530,6 @@ toBuildTool packageName_ executableNames = \ case

systemBuildTool = return . Left

localBuildTool executable v = return . Right $ (LocalBuildTool executable, v)
legacyBuildTool pkg executable v = warnLegacyTool pkg executable >> buildTool pkg executable v
legacySystemBuildTool executable c = warnLegacySystemTool executable >> systemBuildTool (executable, c)

Expand Down
1 change: 0 additions & 1 deletion src/Hpack/Render.hs
Original file line number Diff line number Diff line change
Expand Up @@ -351,7 +351,6 @@ data RenderBuildTool = BuildTools String | BuildToolDepends String

renderBuildTool :: (BuildTool, DependencyVersion) -> RenderBuildTool
renderBuildTool (buildTool, renderVersion -> version) = case buildTool of
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I assume it is a stylistic choice, but I noted the continued use of case even though type BuildTool has only one constructor.

LocalBuildTool executable -> BuildTools (executable ++ version)
BuildTool pkg executable
| pkg == executable && executable `elem` knownBuildTools -> BuildTools (executable ++ version)
| otherwise -> BuildToolDepends (pkg ++ ":" ++ executable ++ version)
Expand Down
14 changes: 7 additions & 7 deletions test/EndToEndSpec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -668,15 +668,15 @@ spec = around_ (inTempDirectoryNamed "my-package") $ do
}

context "when the name of a build tool matches an executable from the same package" $ do
it "adds it to build-tools" $ do
it "adds it to build-tool-depends" $ do
[i|
executables:
bar:
build-tools:
- bar
|] `shouldRenderTo` executable_ "bar" [i|
build-tools:
bar
build-tool-depends:
my-package:bar
|]

it "gives per-section unqualified names precedence over global qualified names" $ do
Expand All @@ -688,8 +688,8 @@ spec = around_ (inTempDirectoryNamed "my-package") $ do
build-tools:
- bar == 0.2.0
|] `shouldRenderTo` executable_ "bar" [i|
build-tools:
bar ==0.2.0
build-tool-depends:
my-package:bar ==0.2.0
|]

it "gives per-section qualified names precedence over global unqualified names" $ do
Expand All @@ -701,8 +701,8 @@ spec = around_ (inTempDirectoryNamed "my-package") $ do
build-tools:
- my-package:bar == 0.2.0
|] `shouldRenderTo` executable_ "bar" [i|
build-tools:
bar ==0.2.0
build-tool-depends:
my-package:bar ==0.2.0
|]

context "when the name of a build tool matches a legacy system build tool" $ do
Expand Down
8 changes: 2 additions & 6 deletions test/Hpack/ConfigSpec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -157,8 +157,8 @@ spec = do
toBuildTool_ (UnqualifiedBuildTool "bar") `shouldBe` (Right (BuildTool "bar" "bar", anyVersion), [])

context "when name matches a local executable" $ do
it "returns a LocalBuildTool" $ do
toBuildTool_ (UnqualifiedBuildTool "foo") `shouldBe` (Right (LocalBuildTool "foo", anyVersion), [])
it "uses the current package name" $ do
toBuildTool_ (UnqualifiedBuildTool "foo") `shouldBe` (Right (BuildTool "my-package" "foo", anyVersion), [])

context "when name matches a legacy executable" $ do
it "warns" $ do
Expand All @@ -177,10 +177,6 @@ spec = do
it "returns a BuildTool" $ do
toBuildTool_ (QualifiedBuildTool "other-package" "foo") `shouldBe` (Right (BuildTool "other-package" "foo", anyVersion), [])

context "when both package matches the current package and executable matches a local executable" $ do
it "returns a LocalBuildTool" $ do
toBuildTool_ (QualifiedBuildTool "my-package" "foo") `shouldBe` (Right (LocalBuildTool "foo", anyVersion), [])

describe "readPackageConfig" $ do
it "warns on missing name" $ do
withPackageWarnings_ [i|
Expand Down