never executed always true always false
1 {-# LANGUAGE OverloadedStrings #-}
2 -----------------------------------------------------------------------------
3 -- |
4 -- Module : Distribution.Client.Init.FileCreators
5 -- Copyright : (c) Brent Yorgey 2009
6 -- License : BSD-like
7 --
8 -- Maintainer : cabal-devel@haskell.org
9 -- Stability : provisional
10 -- Portability : portable
11 --
12 -- Functions to create files during 'cabal init'.
13 --
14 -----------------------------------------------------------------------------
15
16 module Distribution.Client.Init.FileCreators (
17
18 -- * Commands
19 writeLicense
20 , writeChangeLog
21 , createDirectories
22 , createLibHs
23 , createMainHs
24 , createTestSuiteIfEligible
25 , writeCabalFile
26
27 -- * For testing
28 , generateCabalFile
29 ) where
30
31 import Prelude ()
32 import Distribution.Client.Compat.Prelude hiding (empty)
33
34 import System.FilePath
35 ( (</>), (<.>), takeExtension )
36
37 import Distribution.Types.Dependency
38 import Distribution.Types.VersionRange
39
40 import Data.Time
41 ( getCurrentTime, utcToLocalTime, toGregorian, localDay, getCurrentTimeZone )
42 import System.Directory
43 ( getCurrentDirectory, doesFileExist, copyFile
44 , createDirectoryIfMissing )
45
46 import Text.PrettyPrint hiding ((<>), mode, cat)
47
48 import Distribution.Client.Init.Defaults
49 ( defaultCabalVersion, myLibModule )
50 import Distribution.Client.Init.Licenses
51 ( bsd2, bsd3, gplv2, gplv3, lgpl21, lgpl3, agplv3, apache20, mit, mpl20, isc )
52 import Distribution.Client.Init.Utils
53 ( eligibleForTestSuite, message )
54 import Distribution.Client.Init.Types
55 ( InitFlags(..), BuildType(..), PackageType(..) )
56
57 import Distribution.CabalSpecVersion
58 import Distribution.Compat.Newtype
59 ( Newtype )
60 import Distribution.Fields.Field
61 ( FieldName )
62 import Distribution.License
63 ( licenseFromSPDX )
64 import qualified Distribution.ModuleName as ModuleName
65 ( toFilePath )
66 import Distribution.FieldGrammar.Newtypes
67 ( SpecVersion(..) )
68 import Distribution.PackageDescription.FieldGrammar
69 ( formatDependencyList, formatExposedModules, formatHsSourceDirs,
70 formatOtherExtensions, formatOtherModules, formatExtraSourceFiles )
71 import Distribution.Simple.Flag
72 ( maybeToFlag )
73 import Distribution.Simple.Setup
74 ( Flag(..), flagToMaybe )
75 import Distribution.Simple.Utils
76 ( toUTF8BS )
77 import Distribution.Fields.Pretty
78 ( PrettyField(..), showFields' )
79
80 import qualified Distribution.SPDX as SPDX
81
82 import Distribution.Utils.Path -- TODO
83
84 ---------------------------------------------------------------------------
85 -- File generation ------------------------------------------------------
86 ---------------------------------------------------------------------------
87
88 -- | Write the LICENSE file, as specified in the InitFlags license field.
89 --
90 -- For licences that contain the author's name(s), the values are taken
91 -- from the 'authors' field of 'InitFlags', and if not specified will
92 -- be the string "???".
93 --
94 -- If the license type is unknown no license file will be created and
95 -- a warning will be raised.
96 writeLicense :: InitFlags -> IO ()
97 writeLicense flags = do
98 message flags "\nGenerating LICENSE..."
99 year <- show <$> getCurrentYear
100 let authors = fromMaybe "???" . flagToMaybe . author $ flags
101 let isSimpleLicense :: SPDX.License -> Maybe SPDX.LicenseId
102 isSimpleLicense (SPDX.License (SPDX.ELicense (SPDX.ELicenseId lid) Nothing)) = Just lid
103 isSimpleLicense _ = Nothing
104 let licenseFile =
105 case flagToMaybe (license flags) >>= isSimpleLicense of
106 Just SPDX.BSD_2_Clause -> Just $ bsd2 authors year
107 Just SPDX.BSD_3_Clause -> Just $ bsd3 authors year
108 Just SPDX.Apache_2_0 -> Just apache20
109 Just SPDX.MIT -> Just $ mit authors year
110 Just SPDX.MPL_2_0 -> Just mpl20
111 Just SPDX.ISC -> Just $ isc authors year
112
113 -- GNU license come in "only" and "or-later" flavours
114 -- license file used are the same.
115 Just SPDX.GPL_2_0_only -> Just gplv2
116 Just SPDX.GPL_3_0_only -> Just gplv3
117 Just SPDX.LGPL_2_1_only -> Just lgpl21
118 Just SPDX.LGPL_3_0_only -> Just lgpl3
119 Just SPDX.AGPL_3_0_only -> Just agplv3
120
121 Just SPDX.GPL_2_0_or_later -> Just gplv2
122 Just SPDX.GPL_3_0_or_later -> Just gplv3
123 Just SPDX.LGPL_2_1_or_later -> Just lgpl21
124 Just SPDX.LGPL_3_0_or_later -> Just lgpl3
125 Just SPDX.AGPL_3_0_or_later -> Just agplv3
126
127 _ -> Nothing
128
129 case licenseFile of
130 Just licenseText -> writeFileSafe flags "LICENSE" licenseText
131 Nothing -> message flags "Warning: unknown license type, you must put a copy in LICENSE yourself."
132
133 -- | Returns the current calendar year.
134 getCurrentYear :: IO Integer
135 getCurrentYear = do
136 u <- getCurrentTime
137 z <- getCurrentTimeZone
138 let l = utcToLocalTime z u
139 (y, _, _) = toGregorian $ localDay l
140 return y
141
142 defaultChangeLog :: FilePath
143 defaultChangeLog = "CHANGELOG.md"
144
145 -- | Writes the changelog to the current directory.
146 writeChangeLog :: InitFlags -> IO ()
147 writeChangeLog flags = when ((defaultChangeLog `elem`) $ fromMaybe [] (extraSrc flags)) $ do
148 message flags ("Generating "++ defaultChangeLog ++"...")
149 writeFileSafe flags defaultChangeLog changeLog
150 where
151 changeLog = unlines
152 [ "# Revision history for " ++ pname
153 , ""
154 , "## " ++ pver ++ " -- YYYY-mm-dd"
155 , ""
156 , "* First version. Released on an unsuspecting world."
157 ]
158 pname = maybe "" prettyShow $ flagToMaybe $ packageName flags
159 pver = maybe "" prettyShow $ flagToMaybe $ version flags
160
161 -- | Creates and writes the initialized .cabal file.
162 --
163 -- Returns @False@ if no package name is specified, @True@ otherwise.
164 writeCabalFile :: InitFlags -> IO Bool
165 writeCabalFile flags@(InitFlags{packageName = NoFlag}) = do
166 message flags "Error: no package name provided."
167 return False
168 writeCabalFile flags@(InitFlags{packageName = Flag p}) = do
169 let cabalFileName = prettyShow p ++ ".cabal"
170 message flags $ "Generating " ++ cabalFileName ++ "..."
171 writeFileSafe flags cabalFileName (generateCabalFile cabalFileName flags)
172 return True
173
174 -- | Write a file \"safely\", backing up any existing version (unless
175 -- the overwrite flag is set).
176 writeFileSafe :: InitFlags -> FilePath -> String -> IO ()
177 writeFileSafe flags fileName content = do
178 moveExistingFile flags fileName
179 writeFile fileName content
180
181 -- | Create directories, if they were given, and don't already exist.
182 createDirectories :: Maybe [String] -> IO ()
183 createDirectories mdirs = case mdirs of
184 Just dirs -> for_ dirs (createDirectoryIfMissing True)
185 Nothing -> return ()
186
187 -- | Create MyLib.hs file, if its the only module in the liste.
188 createLibHs :: InitFlags -> IO ()
189 createLibHs flags = when ((exposedModules flags) == Just [myLibModule]) $ do
190 let modFilePath = ModuleName.toFilePath myLibModule ++ ".hs"
191 case sourceDirs flags of
192 Just (srcPath:_) -> writeLibHs flags (srcPath </> modFilePath)
193 _ -> writeLibHs flags modFilePath
194
195 -- | Write a MyLib.hs file if it doesn't already exist.
196 writeLibHs :: InitFlags -> FilePath -> IO ()
197 writeLibHs flags libPath = do
198 dir <- maybe getCurrentDirectory return (flagToMaybe $ packageDir flags)
199 let libFullPath = dir </> libPath
200 exists <- doesFileExist libFullPath
201 unless exists $ do
202 message flags $ "Generating " ++ libPath ++ "..."
203 writeFileSafe flags libFullPath myLibHs
204
205 -- | Default MyLib.hs file. Used when no Lib.hs exists.
206 myLibHs :: String
207 myLibHs = unlines
208 [ "module MyLib (someFunc) where"
209 , ""
210 , "someFunc :: IO ()"
211 , "someFunc = putStrLn \"someFunc\""
212 ]
213
214 -- | Create Main.hs, but only if we are init'ing an executable and
215 -- the mainIs flag has been provided.
216 createMainHs :: InitFlags -> IO ()
217 createMainHs flags =
218 if hasMainHs flags then
219 case applicationDirs flags of
220 Just (appPath:_) -> writeMainHs flags (appPath </> mainFile)
221 _ -> writeMainHs flags mainFile
222 else return ()
223 where
224 mainFile = case mainIs flags of
225 Flag x -> x
226 NoFlag -> error "createMainHs: no mainIs"
227
228 -- | Write a main file if it doesn't already exist.
229 writeMainHs :: InitFlags -> FilePath -> IO ()
230 writeMainHs flags mainPath = do
231 dir <- maybe getCurrentDirectory return (flagToMaybe $ packageDir flags)
232 let mainFullPath = dir </> mainPath
233 exists <- doesFileExist mainFullPath
234 unless exists $ do
235 message flags $ "Generating " ++ mainPath ++ "..."
236 writeFileSafe flags mainFullPath (mainHs flags)
237
238 -- | Returns true if a main file exists.
239 hasMainHs :: InitFlags -> Bool
240 hasMainHs flags = case mainIs flags of
241 Flag _ -> (packageType flags == Flag Executable
242 || packageType flags == Flag LibraryAndExecutable)
243 _ -> False
244
245 -- | Default Main.(l)hs file. Used when no Main.(l)hs exists.
246 --
247 -- If we are initializing a new 'LibraryAndExecutable' then import 'MyLib'.
248 mainHs :: InitFlags -> String
249 mainHs flags = (unlines . map prependPrefix) $ case packageType flags of
250 Flag LibraryAndExecutable ->
251 [ "module Main where"
252 , ""
253 , "import qualified MyLib (someFunc)"
254 , ""
255 , "main :: IO ()"
256 , "main = do"
257 , " putStrLn \"Hello, Haskell!\""
258 , " MyLib.someFunc"
259 ]
260 _ ->
261 [ "module Main where"
262 , ""
263 , "main :: IO ()"
264 , "main = putStrLn \"Hello, Haskell!\""
265 ]
266 where
267 prependPrefix :: String -> String
268 prependPrefix "" = ""
269 prependPrefix line
270 | isLiterate = "> " ++ line
271 | otherwise = line
272 isLiterate = case mainIs flags of
273 Flag mainPath -> takeExtension mainPath == ".lhs"
274 _ -> False
275
276 -- | Create a test suite for the package if eligible.
277 createTestSuiteIfEligible :: InitFlags -> IO ()
278 createTestSuiteIfEligible flags =
279 when (eligibleForTestSuite flags) $ do
280 createDirectories (testDirs flags)
281 createTestHs flags
282
283 -- | The name of the test file to generate (if --tests is specified).
284 testFile :: String
285 testFile = "MyLibTest.hs"
286
287 -- | Create MyLibTest.hs, but only if we are init'ing a library and
288 -- the initializeTestSuite flag has been set.
289 --
290 -- It is up to the caller to verify that the package is eligible
291 -- for test suite initialization (see eligibleForTestSuite).
292 createTestHs :: InitFlags -> IO ()
293 createTestHs flags =
294 case testDirs flags of
295 Just (testPath:_) -> writeTestHs flags (testPath </> testFile)
296 _ -> writeMainHs flags testFile
297
298 -- | Write a test file.
299 writeTestHs :: InitFlags -> FilePath -> IO ()
300 writeTestHs flags testPath = do
301 dir <- maybe getCurrentDirectory return (flagToMaybe $ packageDir flags)
302 let testFullPath = dir </> testPath
303 exists <- doesFileExist testFullPath
304 unless exists $ do
305 message flags $ "Generating " ++ testPath ++ "..."
306 writeFileSafe flags testFullPath testHs
307
308 -- | Default MyLibTest.hs file.
309 testHs :: String
310 testHs = unlines
311 [ "module Main (main) where"
312 , ""
313 , "main :: IO ()"
314 , "main = putStrLn \"Test suite not yet implemented.\""
315 ]
316
317
318 -- | Move an existing file, if there is one, and the overwrite flag is
319 -- not set.
320 moveExistingFile :: InitFlags -> FilePath -> IO ()
321 moveExistingFile flags fileName =
322 unless (overwrite flags == Flag True) $ do
323 e <- doesFileExist fileName
324 when e $ do
325 newName <- findNewName fileName
326 message flags $ "Warning: " ++ fileName ++ " already exists, backing up old version in " ++ newName
327 copyFile fileName newName
328
329
330 -- | Given a file path find a new name for the file that does not
331 -- already exist.
332 findNewName :: FilePath -> IO FilePath
333 findNewName oldName = findNewName' 0
334 where
335 findNewName' :: Integer -> IO FilePath
336 findNewName' n = do
337 let newName = oldName <.> ("save" ++ show n)
338 e <- doesFileExist newName
339 if e then findNewName' (n+1) else return newName
340
341
342 -- | Generate a .cabal file from an InitFlags structure.
343 generateCabalFile :: String -> InitFlags -> String
344 generateCabalFile fileName c =
345 showFields' annCommentLines postProcessFieldLines 4 $ catMaybes
346 [ fieldP "cabal-version" (Flag . SpecVersion $ specVer)
347 []
348 False
349
350 , field "name" (packageName c)
351 ["Initial package description '" ++ fileName ++ "' generated by",
352 "'cabal init'. For further documentation, see:",
353 " http://haskell.org/cabal/users-guide/",
354 "",
355 "The name of the package."]
356 True
357
358 , field "version" (version c)
359 ["The package version.",
360 "See the Haskell package versioning policy (PVP) for standards",
361 "guiding when and how versions should be incremented.",
362 "https://pvp.haskell.org",
363 "PVP summary: +-+------- breaking API changes",
364 " | | +----- non-breaking API additions",
365 " | | | +--- code changes with no API change"]
366 True
367
368 , fieldS "synopsis" (synopsis c)
369 ["A short (one-line) description of the package."]
370 True
371
372 , fieldS "description" NoFlag
373 ["A longer description of the package."]
374 True
375
376 , fieldS "homepage" (homepage c)
377 ["URL for the project homepage or repository."]
378 False
379
380 , fieldS "bug-reports" NoFlag
381 ["A URL where users can report bugs."]
382 True
383
384 , fieldS "license" licenseStr
385 ["The license under which the package is released."]
386 True
387
388 , case license c of
389 NoFlag -> Nothing
390 Flag SPDX.NONE -> Nothing
391 _ -> fieldS "license-file" (Flag "LICENSE")
392 ["The file containing the license text."]
393 True
394
395 , fieldS "author" (author c)
396 ["The package author(s)."]
397 True
398
399 , fieldS "maintainer" (email c)
400 ["An email address to which users can send suggestions, bug reports, and patches."]
401 True
402
403 , fieldS "copyright" NoFlag
404 ["A copyright notice."]
405 True
406
407 , fieldS "category" (either id prettyShow `fmap` category c)
408 []
409 True
410
411 , fieldS "build-type" (if specVer >= CabalSpecV2_2 then NoFlag else Flag "Simple")
412 []
413 False
414
415 , fieldPAla "extra-source-files" formatExtraSourceFiles (maybeToFlag (extraSrc c))
416 ["Extra files to be distributed with the package, such as examples or a README."]
417 True
418 ]
419 ++
420 (case packageType c of
421 Flag Executable -> [executableStanza]
422 Flag Library -> [libraryStanza]
423 Flag LibraryAndExecutable -> [libraryStanza, executableStanza]
424 _ -> [])
425 ++
426 if eligibleForTestSuite c then [testSuiteStanza] else []
427
428 where
429 specVer :: CabalSpecVersion
430 specVer = fromMaybe defaultCabalVersion $ flagToMaybe (cabalVersion c)
431
432 licenseStr | specVer < CabalSpecV2_2 = prettyShow . licenseFromSPDX <$> license c
433 | otherwise = prettyShow <$> license c
434
435 generateBuildInfo :: BuildType -> InitFlags -> [PrettyField FieldAnnotation]
436 generateBuildInfo buildType c' = catMaybes
437 [ fieldPAla "other-modules" formatOtherModules (maybeToFlag otherMods)
438 [ case buildType of
439 LibBuild -> "Modules included in this library but not exported."
440 ExecBuild -> "Modules included in this executable, other than Main."]
441 True
442
443 , fieldPAla "other-extensions" formatOtherExtensions (maybeToFlag (otherExts c))
444 ["LANGUAGE extensions used by modules in this package."]
445 True
446
447 , fieldPAla "build-depends" formatDependencyList (maybeToFlag buildDependencies)
448 ["Other library packages from which modules are imported."]
449 True
450
451 , fieldPAla "hs-source-dirs" formatHsSourceDirs
452 (maybeToFlag $ fmap (fmap unsafeMakeSymbolicPath) $ case buildType of
453 LibBuild -> sourceDirs c
454 ExecBuild -> applicationDirs c)
455 ["Directories containing source files."]
456 True
457
458 , fieldS "build-tools" (listFieldS $ buildTools c)
459 ["Extra tools (e.g. alex, hsc2hs, ...) needed to build the source."]
460 False
461
462 , field "default-language" (language c)
463 ["Base language which the package is written in."]
464 True
465 ]
466 -- Hack: Can't construct a 'Dependency' which is just 'packageName'(?).
467 where
468 buildDependencies :: Maybe [Dependency]
469 buildDependencies = (++ myLibDep) <$> dependencies c'
470
471 myLibDep :: [Dependency]
472 myLibDep = if exposedModules c' == Just [myLibModule] && buildType == ExecBuild
473 then case packageName c' of
474 Flag pkgName ->
475 [mkDependency pkgName anyVersion mainLibSet]
476 _ -> []
477 else []
478
479 -- Only include 'MyLib' in 'other-modules' of the executable.
480 otherModsFromFlag = otherModules c'
481 otherMods = if buildType == LibBuild && otherModsFromFlag == Just [myLibModule]
482 then Nothing
483 else otherModsFromFlag
484
485 listFieldS :: Maybe [String] -> Flag String
486 listFieldS Nothing = NoFlag
487 listFieldS (Just []) = NoFlag
488 listFieldS (Just xs) = Flag . intercalate ", " $ xs
489
490 -- | Construct a 'PrettyField' from a field that can be automatically
491 -- converted to a 'Doc' via 'display'.
492 field :: Pretty t
493 => FieldName
494 -> Flag t
495 -> [String]
496 -> Bool
497 -> Maybe (PrettyField FieldAnnotation)
498 field fieldName fieldContentsFlag = fieldS fieldName (prettyShow <$> fieldContentsFlag)
499
500 -- | Construct a 'PrettyField' from a 'String' field.
501 fieldS :: FieldName -- ^ Name of the field
502 -> Flag String -- ^ Field contents
503 -> [String] -- ^ Comment to explain the field
504 -> Bool -- ^ Should the field be included (commented out) even if blank?
505 -> Maybe (PrettyField FieldAnnotation)
506 fieldS fieldName fieldContentsFlag = fieldD fieldName (text <$> fieldContentsFlag)
507
508 -- | Construct a 'PrettyField' from a Flag which can be 'pretty'-ied.
509 fieldP :: Pretty a
510 => FieldName
511 -> Flag a
512 -> [String]
513 -> Bool
514 -> Maybe (PrettyField FieldAnnotation)
515 fieldP fieldName fieldContentsFlag fieldComments includeField =
516 fieldPAla fieldName Identity fieldContentsFlag fieldComments includeField
517
518 -- | Construct a 'PrettyField' from a flag which can be 'pretty'-ied, wrapped in newtypeWrapper.
519 fieldPAla
520 :: (Pretty b, Newtype a b)
521 => FieldName
522 -> (a -> b)
523 -> Flag a
524 -> [String]
525 -> Bool
526 -> Maybe (PrettyField FieldAnnotation)
527 fieldPAla fieldName newtypeWrapper fieldContentsFlag fieldComments includeField =
528 fieldD fieldName (pretty . newtypeWrapper <$> fieldContentsFlag) fieldComments includeField
529
530 -- | Construct a 'PrettyField' from a 'Doc' Flag.
531 fieldD :: FieldName -- ^ Name of the field
532 -> Flag Doc -- ^ Field contents
533 -> [String] -- ^ Comment to explain the field
534 -> Bool -- ^ Should the field be included (commented out) even if blank?
535 -> Maybe (PrettyField FieldAnnotation)
536 fieldD fieldName fieldContentsFlag fieldComments includeField =
537 case fieldContentsFlag of
538 NoFlag ->
539 -- If there is no content, optionally produce a commented out field.
540 fieldSEmptyContents fieldName fieldComments includeField
541
542 Flag fieldContents ->
543 if isEmpty fieldContents
544 then
545 -- If the doc is empty, optionally produce a commented out field.
546 fieldSEmptyContents fieldName fieldComments includeField
547 else
548 -- If the doc is not empty, produce a field.
549 Just $ case (noComments c, minimal c) of
550 -- If the "--no-comments" flag is set, strip comments.
551 (Flag True, _) ->
552 fieldSWithContents fieldName fieldContents []
553 -- If the "--minimal" flag is set, strip comments.
554 (_, Flag True) ->
555 fieldSWithContents fieldName fieldContents []
556 -- Otherwise, include comments.
557 (_, _) ->
558 fieldSWithContents fieldName fieldContents fieldComments
559
560 -- | Optionally produce a field with no content (depending on flags).
561 fieldSEmptyContents :: FieldName
562 -> [String]
563 -> Bool
564 -> Maybe (PrettyField FieldAnnotation)
565 fieldSEmptyContents fieldName fieldComments includeField
566 | not includeField || (minimal c == Flag True) =
567 Nothing
568 | otherwise =
569 Just (PrettyField (commentedOutWithComments fieldComments) fieldName empty)
570
571 -- | Produce a field with content.
572 fieldSWithContents :: FieldName
573 -> Doc
574 -> [String]
575 -> PrettyField FieldAnnotation
576 fieldSWithContents fieldName fieldContents fieldComments =
577 PrettyField (withComments (map ("-- " ++) fieldComments)) fieldName fieldContents
578
579 executableStanza :: PrettyField FieldAnnotation
580 executableStanza = PrettySection annNoComments (toUTF8BS "executable") [exeName] $ catMaybes
581 [ fieldS "main-is" (mainIs c)
582 [".hs or .lhs file containing the Main module."]
583 True
584 ]
585 ++
586 generateBuildInfo ExecBuild c
587 where
588 exeName = text (maybe "" prettyShow . flagToMaybe $ packageName c)
589
590 libraryStanza :: PrettyField FieldAnnotation
591 libraryStanza = PrettySection annNoComments (toUTF8BS "library") [] $ catMaybes
592 [ fieldPAla "exposed-modules" formatExposedModules (maybeToFlag (exposedModules c))
593 ["Modules exported by the library."]
594 True
595 ]
596 ++
597 generateBuildInfo LibBuild c
598
599
600 testSuiteStanza :: PrettyField FieldAnnotation
601 testSuiteStanza = PrettySection annNoComments (toUTF8BS "test-suite") [testSuiteName] $ catMaybes
602 [ field "default-language" (language c)
603 ["Base language which the package is written in."]
604 True
605
606 , fieldS "type" (Flag "exitcode-stdio-1.0")
607 ["The interface type and version of the test suite."]
608 True
609
610 , fieldPAla "hs-source-dirs" formatHsSourceDirs
611 (maybeToFlag $ fmap (fmap unsafeMakeSymbolicPath) $ testDirs c) -- TODO
612 ["Directories containing source files."]
613 True
614
615 , fieldS "main-is" (Flag testFile)
616 ["The entrypoint to the test suite."]
617 True
618
619 , fieldPAla "build-depends" formatDependencyList (maybeToFlag (dependencies c))
620 ["Test dependencies."]
621 True
622 ]
623 where
624 testSuiteName =
625 text (maybe "" ((++"-test") . prettyShow) . flagToMaybe $ packageName c)
626
627 -- | Annotations for cabal file PrettyField.
628 data FieldAnnotation = FieldAnnotation
629 { annCommentedOut :: Bool
630 -- ^ True iif the field and its contents should be commented out.
631 , annCommentLines :: [String]
632 -- ^ Comment lines to place before the field or section.
633 }
634
635 -- | A field annotation instructing the pretty printer to comment out the field
636 -- and any contents, with no comments.
637 commentedOutWithComments :: [String] -> FieldAnnotation
638 commentedOutWithComments = FieldAnnotation True . map ("-- " ++)
639
640 -- | A field annotation with the specified comment lines.
641 withComments :: [String] -> FieldAnnotation
642 withComments = FieldAnnotation False
643
644 -- | A field annotation with no comments.
645 annNoComments :: FieldAnnotation
646 annNoComments = FieldAnnotation False []
647
648 postProcessFieldLines :: FieldAnnotation -> [String] -> [String]
649 postProcessFieldLines ann
650 | annCommentedOut ann = map ("-- " ++)
651 | otherwise = id