hpack-0.22.0: test/EndToEndSpec.hs
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ConstraintKinds #-}
module EndToEndSpec (spec) where
import Prelude hiding (writeFile)
import qualified Prelude
import Helper
import System.Directory (canonicalizePath)
import Control.Exception
import Data.Maybe
import Data.List
import Data.String.Interpolate
import Data.String.Interpolate.Util
import qualified Hpack.Run as Hpack
import Hpack.Config (packageConfig, readPackageConfig)
import Hpack.FormattingHints (FormattingHints(..), sniffFormattingHints)
writeFile :: FilePath -> String -> IO ()
writeFile file c = touch file >> Prelude.writeFile file c
spec :: Spec
spec = around_ (inTempDirectoryNamed "foo") $ do
describe "hpack" $ do
context "with defaults" $ do
it "accepts global defaults" $ do
writeFile "defaults/sol/hpack-template/2017/defaults.yaml" [i|
default-extensions:
- RecordWildCards
- DeriveFunctor
|]
[i|
defaults:
github: sol/hpack-template
path: defaults.yaml
ref: "2017"
library: {}
|] `shouldRenderTo` library [i|
other-modules:
Paths_foo
default-extensions: RecordWildCards DeriveFunctor
|]
it "accepts library defaults" $ do
writeFile "defaults/sol/hpack-template/2017/defaults.yaml" [i|
exposed-modules: Foo
|]
[i|
library:
defaults:
github: sol/hpack-template
path: defaults.yaml
ref: "2017"
|] `shouldRenderTo` library [i|
exposed-modules:
Foo
other-modules:
Paths_foo
|]
it "accepts a list of defaults" $ do
writeFile "defaults/foo/bar/v1/.hpack/defaults.yaml" "default-extensions: RecordWildCards"
writeFile "defaults/foo/bar/v2/.hpack/defaults.yaml" "default-extensions: DeriveFunctor"
[i|
defaults:
- foo/bar@v1
- foo/bar@v2
library: {}
|] `shouldRenderTo` library [i|
other-modules:
Paths_foo
default-extensions: RecordWildCards DeriveFunctor
|]
it "accepts defaults recursively" $ do
writeFile "defaults/foo/bar/v1/.hpack/defaults.yaml" "defaults: foo/bar@v2"
writeFile "defaults/foo/bar/v2/.hpack/defaults.yaml" "default-extensions: DeriveFunctor"
[i|
defaults: foo/bar@v1
library: {}
|] `shouldRenderTo` library [i|
other-modules:
Paths_foo
default-extensions: DeriveFunctor
|]
it "fails on cyclic defaults" $ do
let
file1 = "defaults/foo/bar/v1/.hpack/defaults.yaml"
file2 = "defaults/foo/bar/v2/.hpack/defaults.yaml"
writeFile file1 "defaults: foo/bar@v2"
writeFile file2 "defaults: foo/bar@v1"
canonic1 <- canonicalizePath file1
canonic2 <- canonicalizePath file2
[i|
defaults: foo/bar@v1
library: {}
|] `shouldFailWith` [i|cycle in defaults (#{canonic1} -> #{canonic2} -> #{canonic1})|]
it "fails if defaults don't exist" $ do
pending
[i|
defaults:
github: sol/foo
ref: bar
library: {}
|] `shouldFailWith` "Invalid value for \"defaults\"! File https://raw.githubusercontent.com/sol/foo/bar/.hpack/defaults.yaml does not exist!"
it "fails on parse error" $ do
let file = joinPath ["defaults", "sol", "hpack-template", "2017", "defaults.yaml"]
writeFile file "[]"
[i|
defaults:
github: sol/hpack-template
path: defaults.yaml
ref: "2017"
library: {}
|] `shouldFailWith` (file ++ ": Error in $: expected record (:*:), encountered Array")
it "warns on unknown fields" $ do
let file = joinPath ["defaults", "sol", "hpack-template", "2017", "defaults.yaml"]
writeFile file "foo: bar"
[i|
defaults:
github: sol/hpack-template
path: defaults.yaml
ref: "2017"
bar: baz
name: foo
library: {}
|] `shouldWarn` [
"Ignoring unknown field \"bar\" in defaults section"
, "Ignoring unknown field \"foo\" in " ++ file
]
describe "extra-doc-files" $ do
it "accepts a list of files" $ do
touch "CHANGES.markdown"
touch "README.markdown"
[i|
extra-doc-files:
- CHANGES.markdown
- README.markdown
|] `shouldRenderTo` (package [i|
extra-doc-files:
CHANGES.markdown
README.markdown
|]) {packageCabalVersion = ">= 1.18"}
it "accepts glob patterns" $ do
touch "CHANGES.markdown"
touch "README.markdown"
[i|
extra-doc-files:
- "*.markdown"
|] `shouldRenderTo` (package [i|
extra-doc-files:
CHANGES.markdown
README.markdown
|]) {packageCabalVersion = ">= 1.18"}
it "warns if a glob pattern does not match anything" $ do
[i|
name: foo
extra-doc-files:
- "*.markdown"
|] `shouldWarn` ["Specified pattern \"*.markdown\" for extra-doc-files does not match any files"]
describe "dependencies" $ do
it "accepts single dependency" $ do
[i|
executable:
dependencies: base
|] `shouldRenderTo` executable_ "foo" [i|
build-depends:
base
|]
it "accepts list of dependencies" $ do
[i|
executable:
dependencies:
- base
- transformers
|] `shouldRenderTo` executable_ "foo" [i|
build-depends:
base
, transformers
|]
context "with both global and section specific dependencies" $ do
it "combines dependencies" $ do
[i|
dependencies:
- base
executable:
dependencies: hspec
|] `shouldRenderTo` executable_ "foo" [i|
build-depends:
base
, hspec
|]
it "gives section specific dependencies precedence" $ do
[i|
dependencies:
- base
executable:
dependencies: base >= 2
|] `shouldRenderTo` executable_ "foo" [i|
build-depends:
base >=2
|]
describe "pkg-config-dependencies" $ do
it "accepts pkg-config-dependencies" $ do
[i|
pkg-config-dependencies:
- QtWebKit
- weston
executable: {}
|] `shouldRenderTo` executable_ "foo" [i|
pkgconfig-depends:
QtWebKit
, weston
|]
describe "include-dirs" $ do
it "accepts include-dirs" $ do
[i|
include-dirs:
- foo
- bar
executable: {}
|] `shouldRenderTo` executable_ "foo" [i|
include-dirs:
foo
bar
|]
describe "install-includes" $ do
it "accepts install-includes" $ do
[i|
install-includes:
- foo.h
- bar.h
executable: {}
|] `shouldRenderTo` executable_ "foo" [i|
install-includes:
foo.h
bar.h
|]
describe "js-sources" $ before_ (touch "foo.js" >> touch "jsbits/bar.js") $ do
it "accepts js-sources" $ do
[i|
executable:
js-sources:
- foo.js
- jsbits/*.js
|] `shouldRenderTo` executable_ "foo" [i|
js-sources:
foo.js
jsbits/bar.js
|]
it "accepts global js-sources" $ do
[i|
js-sources:
- foo.js
- jsbits/*.js
executable: {}
|] `shouldRenderTo` executable_ "foo" [i|
js-sources:
foo.js
jsbits/bar.js
|]
describe "extra-lib-dirs" $ do
it "accepts extra-lib-dirs" $ do
[i|
extra-lib-dirs:
- foo
- bar
executable: {}
|] `shouldRenderTo` executable_ "foo" [i|
extra-lib-dirs:
foo
bar
|]
describe "extra-libraries" $ do
it "accepts extra-libraries" $ do
[i|
extra-libraries:
- foo
- bar
executable: {}
|] `shouldRenderTo` executable_ "foo" [i|
extra-libraries:
foo
bar
|]
describe "extra-frameworks-dirs" $ do
it "accepts extra-frameworks-dirs" $ do
[i|
extra-frameworks-dirs:
- foo
- bar
executable: {}
|] `shouldRenderTo` executable_ "foo" [i|
extra-frameworks-dirs:
foo
bar
|]
describe "frameworks" $ do
it "accepts frameworks" $ do
[i|
frameworks:
- foo
- bar
executable: {}
|] `shouldRenderTo` executable_ "foo" [i|
frameworks:
foo
bar
|]
describe "c-sources" $ before_ (touch "cbits/foo.c" >> touch "cbits/bar.c") $ do
context "with internal-libraries" $ do
it "warns when a glob pattern does not match any files" $ do
[i|
name: foo
internal-libraries:
bar:
c-sources: foo/*.c
|] `shouldWarn` pure "Specified pattern \"foo/*.c\" for c-sources does not match any files"
context "with library" $ do
it "accepts signatures" $ do
[i|
library:
signatures: Foo
|] `shouldRenderTo` (library [i|
other-modules:
Paths_foo
signatures:
Foo
|]) {packageCabalVersion = ">= 2.0"}
it "accepts global c-sources" $ do
[i|
c-sources: cbits/*.c
library: {}
|] `shouldRenderTo` library [i|
other-modules:
Paths_foo
c-sources:
cbits/bar.c
cbits/foo.c
|]
it "accepts c-sources" $ do
[i|
library:
c-sources: cbits/*.c
|] `shouldRenderTo` library [i|
other-modules:
Paths_foo
c-sources:
cbits/bar.c
cbits/foo.c
|]
it "accepts c-sources in conditional" $ do
[i|
library:
when:
condition: os(windows)
c-sources: cbits/*.c
|] `shouldRenderTo` library [i|
other-modules:
Paths_foo
if os(windows)
c-sources:
cbits/bar.c
cbits/foo.c
|]
context "with executables" $ do
it "accepts global c-sources" $ do
[i|
c-sources: cbits/*.c
executables:
foo: {}
|] `shouldRenderTo` executable_ "foo" [i|
c-sources:
cbits/bar.c
cbits/foo.c
|]
it "accepts c-sources" $ do
[i|
executables:
foo:
c-sources: cbits/*.c
|] `shouldRenderTo` executable_ "foo" [i|
c-sources:
cbits/bar.c
cbits/foo.c
|]
context "with custom-setup" $ do
it "warns on unknown fields" $ do
[i|
name: foo
custom-setup:
foo: 1
bar: 2
|] `shouldWarn` [
"Ignoring unknown field \"bar\" in custom-setup section"
, "Ignoring unknown field \"foo\" in custom-setup section"
]
it "accepts dependencies" $ do
[i|
custom-setup:
dependencies:
- base
|] `shouldRenderTo` customSetup [i|
setup-depends:
base
|]
it "leaves build-type alone, if it exists" $ do
[i|
build-type: Make
custom-setup:
dependencies:
- base
|] `shouldRenderTo` (customSetup [i|
setup-depends:
base
|]) {packageBuildType = "Make"}
context "with library" $ do
it "accepts reexported-modules" $ do
[i|
library:
reexported-modules: Baz
|] `shouldRenderTo` (library [i|
reexported-modules:
Baz
other-modules:
Paths_foo
|]) {packageCabalVersion = ">= 1.22"}
context "when inferring modules" $ do
context "with exposed-modules" $ do
it "infers other-modules" $ do
touch "src/Foo.hs"
touch "src/Bar.hs"
[i|
library:
source-dirs: src
exposed-modules: Foo
|] `shouldRenderTo` library [i|
hs-source-dirs:
src
exposed-modules:
Foo
other-modules:
Bar
Paths_foo
|]
context "with other-modules" $ do
it "infers exposed-modules" $ do
touch "src/Foo.hs"
touch "src/Bar.hs"
[i|
library:
source-dirs: src
other-modules: Bar
|] `shouldRenderTo` library [i|
hs-source-dirs:
src
exposed-modules:
Foo
other-modules:
Bar
|]
context "with both exposed-modules and other-modules" $ do
it "doesn't infer any modules" $ do
touch "src/Foo.hs"
touch "src/Bar.hs"
[i|
library:
source-dirs: src
exposed-modules: Foo
other-modules: Bar
|] `shouldRenderTo` library [i|
hs-source-dirs:
src
exposed-modules:
Foo
other-modules:
Bar
|]
context "with neither exposed-modules nor other-modules" $ do
it "infers exposed-modules" $ do
touch "src/Foo.hs"
touch "src/Bar.hs"
[i|
library:
source-dirs: src
|] `shouldRenderTo` library [i|
hs-source-dirs:
src
exposed-modules:
Bar
Foo
other-modules:
Paths_foo
|]
context "with a conditional" $ do
it "doesn't infer any modules mentioned in that conditional" $ do
touch "src/Foo.hs"
touch "src/Bar.hs"
[i|
library:
source-dirs: src
when:
condition: os(windows)
exposed-modules:
- Foo
- Paths_foo
|] `shouldRenderTo` library [i|
hs-source-dirs:
src
if os(windows)
exposed-modules:
Foo
Paths_foo
exposed-modules:
Bar
|]
context "with a source-dir inside the conditional" $ do
it "infers other-modules" $ do
touch "windows/Foo.hs"
[i|
library:
when:
condition: os(windows)
source-dirs: windows
|] `shouldRenderTo` library [i|
other-modules:
Paths_foo
if os(windows)
other-modules:
Foo
hs-source-dirs:
windows
|]
it "does not infer outer modules" $ do
touch "windows/Foo.hs"
touch "unix/Foo.hs"
[i|
library:
exposed-modules: Foo
when:
condition: os(windows)
then:
source-dirs: windows/
else:
source-dirs: unix/
|] `shouldRenderTo` library [i|
exposed-modules:
Foo
other-modules:
Paths_foo
if os(windows)
hs-source-dirs:
windows/
else
hs-source-dirs:
unix/
|]
context "with internal-libraries" $ do
it "accepts internal-libraries" $ do
touch "src/Foo.hs"
[i|
internal-libraries:
bar:
source-dirs: src
|] `shouldRenderTo` internalLibrary "bar" [i|
exposed-modules:
Foo
other-modules:
Paths_foo
hs-source-dirs:
src
|]
it "warns on unknown fields" $ do
[i|
name: foo
internal-libraries:
bar:
baz: 42
|] `shouldWarn` pure "Ignoring unknown field \"baz\" in internal-libraries section \"bar\""
it "warns on missing source-dirs" $ do
[i|
name: foo
internal-libraries:
bar:
source-dirs: src
|] `shouldWarn` pure "Specified source-dir \"src\" does not exist"
context "with executables" $ do
it "accepts arbitrary entry points as main" $ do
touch "src/Foo.hs"
touch "src/Bar.hs"
[i|
executables:
foo:
source-dirs: src
main: Foo
|] `shouldRenderTo` executable "foo" [i|
main-is: Foo.hs
ghc-options: -main-is Foo
hs-source-dirs:
src
other-modules:
Bar
Paths_foo
|]
context "when inferring modules" $ do
it "infers other-modules" $ do
touch "src/Main.hs"
touch "src/Foo.hs"
[i|
executables:
foo:
main: Main.hs
source-dirs: src
|] `shouldRenderTo` executable "foo" [i|
main-is: Main.hs
hs-source-dirs:
src
other-modules:
Foo
Paths_foo
|]
it "allows to specify other-modules" $ do
touch "src/Foo.hs"
touch "src/Bar.hs"
[i|
executables:
foo:
main: Main.hs
source-dirs: src
other-modules: Baz
|] `shouldRenderTo` executable "foo" [i|
main-is: Main.hs
hs-source-dirs:
src
other-modules:
Baz
|]
context "with conditional" $ do
it "doesn't infer any modules mentioned in that conditional" $ do
touch "src/Foo.hs"
touch "src/Bar.hs"
[i|
executables:
foo:
source-dirs: src
when:
condition: os(windows)
other-modules: Foo
|] `shouldRenderTo` executable "foo" [i|
other-modules:
Bar
Paths_foo
hs-source-dirs:
src
if os(windows)
other-modules:
Foo
|]
it "infers other-modules" $ do
touch "src/Foo.hs"
touch "windows/Bar.hs"
[i|
executables:
foo:
source-dirs: src
when:
condition: os(windows)
source-dirs: windows
|] `shouldRenderTo` executable "foo" [i|
other-modules:
Foo
Paths_foo
hs-source-dirs:
src
if os(windows)
other-modules:
Bar
hs-source-dirs:
windows
|]
context "with conditional" $ do
it "does not apply global options" $ do
-- related bug: https://github.com/sol/hpack/issues/214
[i|
ghc-options: -Wall
executables:
foo:
when:
condition: os(windows)
main: Foo.hs
|] `shouldRenderTo` executable_ "foo" [i|
ghc-options: -Wall
if os(windows)
main-is: Foo.hs
|]
it "accepts executable-specific fields" $ do
[i|
executables:
foo:
when:
condition: os(windows)
main: Foo
|] `shouldRenderTo` executable_ "foo" [i|
if os(windows)
main-is: Foo.hs
ghc-options: -main-is Foo
|]
describe "when" $ do
it "accepts conditionals" $ do
[i|
when:
condition: os(windows)
dependencies: Win32
executable: {}
|] `shouldRenderTo` executable_ "foo" [i|
if os(windows)
build-depends:
Win32
|]
it "warns on unknown fields" $ do
[i|
name: foo
foo: 23
when:
- condition: os(windows)
bar: 23
when:
condition: os(windows)
bar2: 23
- condition: os(windows)
baz: 23
|] `shouldWarn` [
"Ignoring unknown field \"foo\" in package description"
, "Ignoring unknown field \"bar\" in package description"
, "Ignoring unknown field \"bar2\" in package description"
, "Ignoring unknown field \"baz\" in package description"
]
context "when parsing conditionals with else-branch" $ do
it "accepts conditionals with else-branch" $ do
[i|
when:
condition: os(windows)
then:
dependencies: Win32
else:
dependencies: unix
executable: {}
|] `shouldRenderTo` executable_ "foo" [i|
if os(windows)
build-depends:
Win32
else
build-depends:
unix
|]
it "rejects invalid conditionals" $ do
[i|
when:
condition: os(windows)
then:
dependencies: Win32
else: null
|] `shouldFailWith` "package.yaml: Error in $.when.else: expected record (:*:), encountered Null"
it "warns on unknown fields" $ do
[i|
name: foo
when:
condition: os(windows)
foo: null
then:
bar: null
else:
when:
condition: os(windows)
then: {}
else:
baz: null
|] `shouldWarn` [
"Ignoring unknown field \"foo\" in package description"
, "Ignoring unknown field \"bar\" in package description"
, "Ignoring unknown field \"baz\" in package description"
]
run :: FilePath -> String -> IO ([String], String)
run c old = run_ c old >>= either (throwIO . ErrorCall) return
run_ :: FilePath -> String -> IO (Either String ([String], String))
run_ c old = do
mPackage <- readPackageConfig "" c
return $ case mPackage of
Right (pkg, warnings) ->
let
FormattingHints{..} = sniffFormattingHints old
alignment = fromMaybe 0 formattingHintsAlignment
settings = formattingHintsRenderSettings
output = Hpack.renderPackage settings alignment formattingHintsFieldOrder formattingHintsSectionsFieldOrder pkg
in
Right (warnings, output)
Left err -> Left err
newtype PlainString = PlainString String
deriving Eq
instance Show PlainString where
show (PlainString xs) = xs
shouldRenderTo :: HasCallStack => String -> Package -> Expectation
shouldRenderTo input p = do
writeFile packageConfig input
(_ , output) <- run packageConfig expected
PlainString (dropEmptyLines output) `shouldBe` PlainString expected
where
expected = dropEmptyLines (renderPackage p)
dropEmptyLines = unlines . filter (not . null) . lines
shouldWarn :: HasCallStack => String -> [String] -> Expectation
shouldWarn input expected = do
writeFile packageConfig input
(warnings, _) <- run packageConfig ""
sort warnings `shouldBe` sort expected
shouldFailWith :: HasCallStack => String -> String -> Expectation
shouldFailWith input expected = do
writeFile packageConfig input
run_ packageConfig "" `shouldReturn` Left expected
customSetup :: String -> Package
customSetup a = (package content) {packageCabalVersion = ">= 1.24", packageBuildType = "Custom"}
where
content = [i|
custom-setup
#{indentBy 2 $ unindent a}
|]
library :: String -> Package
library l = package content
where
content = [i|
library
#{indentBy 2 $ unindent l}
default-language: Haskell2010
|]
internalLibrary :: String -> String -> Package
internalLibrary name e = (package content) {packageCabalVersion = ">= 2.0"}
where
content = [i|
library #{name}
#{indentBy 2 $ unindent e}
default-language: Haskell2010
|]
executable_ :: String -> String -> Package
executable_ name e = package content
where
content = [i|
executable #{name}
other-modules:
Paths_#{name}
#{indentBy 2 $ unindent e}
default-language: Haskell2010
|]
executable :: String -> String -> Package
executable name e = package content
where
content = [i|
executable #{name}
#{indentBy 2 $ unindent e}
default-language: Haskell2010
|]
package :: String -> Package
package = Package "foo" "Simple" ">= 1.10"
data Package = Package {
packageName :: String
, packageBuildType :: String
, packageCabalVersion :: String
, packageContent :: String
}
renderPackage :: Package -> String
renderPackage Package{..} = unindent [i|
name: #{packageName}
version: 0.0.0
build-type: #{packageBuildType}
cabal-version: #{packageCabalVersion}
#{unindent packageContent}
|]
indentBy :: Int -> String -> String
indentBy n = unlines . map (replicate n ' ' ++) . lines