1{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE OverloadedLists #-}
3module Hpack.RenderSpec (spec) where
4
5import           Helper
6import           Data.List
7
8import           Hpack.Syntax.DependencyVersion
9import           Hpack.ConfigSpec hiding (spec)
10import           Hpack.Config hiding (package)
11import           Hpack.Render.Dsl
12import           Hpack.Render
13
14library :: Library
15library = Library Nothing Nothing [] [] [] [] []
16
17executable :: Section Executable
18executable = section (Executable (Just "Main.hs") [] [])
19
20renderEmptySection :: Empty -> [Element]
21renderEmptySection Empty = []
22
23spec :: Spec
24spec = do
25  describe "renderPackageWith" $ do
26    let renderPackage_ = renderPackageWith defaultRenderSettings 0 [] []
27    it "renders a package" $ do
28      renderPackage_ package `shouldBe` unlines [
29          "name: foo"
30        , "version: 0.0.0"
31        , "build-type: Simple"
32        ]
33
34    it "aligns fields" $ do
35      renderPackageWith defaultRenderSettings 16 [] [] package `shouldBe` unlines [
36          "name:           foo"
37        , "version:        0.0.0"
38        , "build-type:     Simple"
39        ]
40
41    it "includes description" $ do
42      renderPackage_ package {packageDescription = Just "foo\n\nbar\n"} `shouldBe` unlines [
43          "name: foo"
44        , "version: 0.0.0"
45        , "description: foo"
46        , "             ."
47        , "             bar"
48        , "build-type: Simple"
49        ]
50
51    it "aligns description" $ do
52      renderPackageWith defaultRenderSettings 16 [] [] package {packageDescription = Just "foo\n\nbar\n"} `shouldBe` unlines [
53          "name:           foo"
54        , "version:        0.0.0"
55        , "description:    foo"
56        , "                ."
57        , "                bar"
58        , "build-type:     Simple"
59        ]
60
61    it "includes stability" $ do
62      renderPackage_ package {packageStability = Just "experimental"} `shouldBe` unlines [
63          "name: foo"
64        , "version: 0.0.0"
65        , "stability: experimental"
66        , "build-type: Simple"
67        ]
68
69    it "includes license-file" $ do
70      renderPackage_ package {packageLicenseFile = ["FOO"]} `shouldBe` unlines [
71          "name: foo"
72        , "version: 0.0.0"
73        , "license-file: FOO"
74        , "build-type: Simple"
75        ]
76
77    it "aligns license-files" $ do
78      renderPackageWith defaultRenderSettings 16 [] [] package {packageLicenseFile = ["FOO", "BAR"]} `shouldBe` unlines [
79          "name:           foo"
80        , "version:        0.0.0"
81        , "license-files:  FOO,"
82        , "                BAR"
83        , "build-type:     Simple"
84        ]
85
86    it "includes copyright holder" $ do
87      renderPackage_ package {packageCopyright = ["(c) 2015 Simon Hengel"]} `shouldBe` unlines [
88          "name: foo"
89        , "version: 0.0.0"
90        , "copyright: (c) 2015 Simon Hengel"
91        , "build-type: Simple"
92        ]
93
94    it "aligns copyright holders" $ do
95      renderPackageWith defaultRenderSettings 16 [] [] package {packageCopyright = ["(c) 2015 Foo", "(c) 2015 Bar"]} `shouldBe` unlines [
96          "name:           foo"
97        , "version:        0.0.0"
98        , "copyright:      (c) 2015 Foo,"
99        , "                (c) 2015 Bar"
100        , "build-type:     Simple"
101        ]
102
103    it "includes extra-source-files" $ do
104      renderPackage_ package {packageExtraSourceFiles = ["foo", "bar"]} `shouldBe` unlines [
105          "name: foo"
106        , "version: 0.0.0"
107        , "build-type: Simple"
108        , "extra-source-files:"
109        , "    foo"
110        , "    bar"
111        ]
112
113    it "includes buildable" $ do
114      renderPackage_ package {packageLibrary = Just (section library){sectionBuildable = Just False}} `shouldBe` unlines [
115          "name: foo"
116        , "version: 0.0.0"
117        , "build-type: Simple"
118        , ""
119        , "library"
120        , "  buildable: False"
121        , "  default-language: Haskell2010"
122        ]
123
124    context "when rendering library section" $ do
125      it "renders library section" $ do
126        renderPackage_ package {packageLibrary = Just $ section library} `shouldBe` unlines [
127            "name: foo"
128          , "version: 0.0.0"
129          , "build-type: Simple"
130          , ""
131          , "library"
132          , "  default-language: Haskell2010"
133          ]
134
135    context "when given list of existing fields" $ do
136      it "retains field order" $ do
137        renderPackageWith defaultRenderSettings 16 ["version", "build-type", "name"] [] package `shouldBe` unlines [
138            "version:        0.0.0"
139          , "build-type:     Simple"
140          , "name:           foo"
141          ]
142
143      it "uses default field order for new fields" $ do
144        renderPackageWith defaultRenderSettings 16 [] [] package `shouldBe` unlines [
145            "name:           foo"
146          , "version:        0.0.0"
147          , "build-type:     Simple"
148          ]
149
150      it "retains section field order" $ do
151        renderPackageWith defaultRenderSettings 0 [] [("executable foo", ["default-language", "main-is", "ghc-options"])] package {packageExecutables = [("foo", executable {sectionGhcOptions = ["-Wall", "-Werror"]})]} `shouldBe` unlines [
152            "name: foo"
153          , "version: 0.0.0"
154          , "build-type: Simple"
155          , ""
156          , "executable foo"
157          , "  default-language: Haskell2010"
158          , "  main-is: Main.hs"
159          , "  ghc-options: -Wall -Werror"
160          ]
161
162    context "when rendering executable section" $ do
163      it "includes dependencies" $ do
164        let dependencies = Dependencies
165              [ ("foo", defaultInfo { dependencyInfoVersion = versionRange "== 0.1.0" })
166              , ("bar", defaultInfo)
167              ]
168        renderPackage_ package {packageExecutables = [("foo", executable {sectionDependencies = dependencies})]} `shouldBe` unlines [
169            "name: foo"
170          , "version: 0.0.0"
171          , "build-type: Simple"
172          , ""
173          , "executable foo"
174          , "  main-is: Main.hs"
175          , "  build-depends:"
176          , "      bar"
177          , "    , foo == 0.1.0"
178          , "  default-language: Haskell2010"
179          ]
180
181      it "includes GHC options" $ do
182        renderPackage_ package {packageExecutables = [("foo", executable {sectionGhcOptions = ["-Wall", "-Werror"]})]} `shouldBe` unlines [
183            "name: foo"
184          , "version: 0.0.0"
185          , "build-type: Simple"
186          , ""
187          , "executable foo"
188          , "  main-is: Main.hs"
189          , "  ghc-options: -Wall -Werror"
190          , "  default-language: Haskell2010"
191          ]
192
193      it "includes frameworks" $ do
194        renderPackage_ package {packageExecutables = [("foo", executable {sectionFrameworks = ["foo", "bar"]})]} `shouldBe` unlines [
195            "name: foo"
196          , "version: 0.0.0"
197          , "build-type: Simple"
198          , ""
199          , "executable foo"
200          , "  main-is: Main.hs"
201          , "  frameworks:"
202          , "      foo"
203          , "      bar"
204          , "  default-language: Haskell2010"
205          ]
206
207      it "includes extra-framework-dirs" $ do
208        renderPackage_ package {packageExecutables = [("foo", executable {sectionExtraFrameworksDirs = ["foo", "bar"]})]} `shouldBe` unlines [
209            "name: foo"
210          , "version: 0.0.0"
211          , "build-type: Simple"
212          , ""
213          , "executable foo"
214          , "  main-is: Main.hs"
215          , "  extra-frameworks-dirs:"
216          , "      foo"
217          , "      bar"
218          , "  default-language: Haskell2010"
219          ]
220
221      it "includes GHC profiling options" $ do
222        renderPackage_ package {packageExecutables = [("foo", executable {sectionGhcProfOptions = ["-fprof-auto", "-rtsopts"]})]} `shouldBe` unlines [
223            "name: foo"
224          , "version: 0.0.0"
225          , "build-type: Simple"
226          , ""
227          , "executable foo"
228          , "  main-is: Main.hs"
229          , "  ghc-prof-options: -fprof-auto -rtsopts"
230          , "  default-language: Haskell2010"
231          ]
232
233  describe "renderConditional" $ do
234    it "renders conditionals" $ do
235      let conditional = Conditional "os(windows)" (section Empty) {sectionDependencies = deps ["Win32"]} Nothing
236      render defaultRenderSettings 0 (renderConditional renderEmptySection conditional) `shouldBe` [
237          "if os(windows)"
238        , "  build-depends:"
239        , "      Win32"
240        ]
241
242    it "renders conditionals with else-branch" $ do
243      let conditional = Conditional "os(windows)" (section Empty) {sectionDependencies = deps ["Win32"]} (Just $ (section Empty) {sectionDependencies = deps ["unix"]})
244      render defaultRenderSettings 0 (renderConditional renderEmptySection conditional) `shouldBe` [
245          "if os(windows)"
246        , "  build-depends:"
247        , "      Win32"
248        , "else"
249        , "  build-depends:"
250        , "      unix"
251        ]
252
253    it "renders nested conditionals" $ do
254      let conditional = Conditional "arch(i386)" (section Empty) {sectionGhcOptions = ["-threaded"], sectionConditionals = [innerConditional]} Nothing
255          innerConditional = Conditional "os(windows)" (section Empty) {sectionDependencies = deps ["Win32"]} Nothing
256      render defaultRenderSettings 0 (renderConditional renderEmptySection conditional) `shouldBe` [
257          "if arch(i386)"
258        , "  ghc-options: -threaded"
259        , "  if os(windows)"
260        , "    build-depends:"
261        , "        Win32"
262        ]
263
264    it "conditionalises both build-depends and mixins" $ do
265      let conditional = Conditional "os(windows)" (section Empty) {sectionDependencies = [("Win32", depInfo)]} Nothing
266          depInfo = defaultInfo { dependencyInfoMixins = ["hiding (Blah)"] }
267      render defaultRenderSettings 0 (renderConditional renderEmptySection conditional) `shouldBe` [
268          "if os(windows)"
269        , "  build-depends:"
270        , "      Win32"
271        , "  mixins:"
272        , "      Win32 hiding (Blah)"
273        ]
274
275  describe "renderFlag" $ do
276    it "renders flags" $ do
277      let flag = (Flag "foo" (Just "some flag") True False)
278      render defaultRenderSettings 0 (renderFlag flag) `shouldBe` [
279          "flag foo"
280        , "  description: some flag"
281        , "  manual: True"
282        , "  default: False"
283        ]
284
285  describe "formatDescription" $ do
286    it "formats description" $ do
287      let description = unlines [
288              "foo"
289            , "bar"
290            ]
291      "description: " ++ formatDescription 0 description `shouldBe` intercalate "\n" [
292          "description: foo"
293        , "             bar"
294        ]
295
296    it "takes specified alignment into account" $ do
297      let description = unlines [
298              "foo"
299            , "bar"
300            , "baz"
301            ]
302      "description:   " ++ formatDescription 15 description `shouldBe` intercalate "\n" [
303          "description:   foo"
304        , "               bar"
305        , "               baz"
306        ]
307
308    it "formats empty lines" $ do
309      let description = unlines [
310              "foo"
311            , "   "
312            , "bar"
313            ]
314      "description: " ++ formatDescription 0 description `shouldBe` intercalate "\n" [
315          "description: foo"
316        , "             ."
317        , "             bar"
318        ]
319
320  describe "renderSourceRepository" $ do
321    it "renders source-repository without subdir correctly" $ do
322      let repository = SourceRepository "https://github.com/hspec/hspec" Nothing
323      (render defaultRenderSettings 0 $ renderSourceRepository repository)
324        `shouldBe` [
325            "source-repository head"
326          , "  type: git"
327          , "  location: https://github.com/hspec/hspec"
328          ]
329
330    it "renders source-repository with subdir" $ do
331      let repository = SourceRepository "https://github.com/hspec/hspec" (Just "hspec-core")
332      (render defaultRenderSettings 0 $ renderSourceRepository repository)
333        `shouldBe` [
334            "source-repository head"
335          , "  type: git"
336          , "  location: https://github.com/hspec/hspec"
337          , "  subdir: hspec-core"
338          ]
339
340  describe "renderDirectories" $ do
341    it "replaces . with ./. (for compatibility with cabal syntax)" $ do
342      (render defaultRenderSettings 0 $ renderDirectories "name" ["."])
343        `shouldBe` [
344            "name:"
345          , "    ./"
346          ]
347
348  describe "renderDependencies" $ do
349    it "renders build-depends" $ do
350      let deps_ =
351            [ ("foo", DependencyInfo [] anyVersion)
352            ]
353      renderDependencies "build-depends" deps_ `shouldBe`
354        [ Field "build-depends" $ CommaSeparatedList
355            [ "foo"
356            ]
357        , Field "mixins" $ CommaSeparatedList []
358        ]
359
360    it "renders build-depends with versions" $ do
361      let deps_ =
362            [ ("foo", DependencyInfo [] (versionRange ">= 2 && < 3"))
363            ]
364      renderDependencies "build-depends" deps_ `shouldBe`
365        [ Field "build-depends" $ CommaSeparatedList
366            [ "foo >= 2 && < 3"
367            ]
368        , Field "mixins" $ CommaSeparatedList []
369        ]
370
371    it "renders mixins and build-depends for multiple modules" $ do
372      let deps_ =
373            [ ("foo", DependencyInfo ["(Foo as Foo1)"] anyVersion)
374            , ("bar", DependencyInfo ["hiding (Spam)", "(Spam as Spam1) requires (Mod as Sig)"] anyVersion)
375            ]
376      renderDependencies "build-depends" deps_ `shouldBe`
377        [ Field "build-depends" $ CommaSeparatedList
378           [ "bar"
379           , "foo"
380           ]
381        , Field "mixins" $ CommaSeparatedList
382            [ "bar hiding (Spam)"
383            , "bar (Spam as Spam1) requires (Mod as Sig)"
384            , "foo (Foo as Foo1)"
385            ]
386        ]
387