1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
|
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Client.ParseUtils
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
--
-- Parsing utilities.
-----------------------------------------------------------------------------
module Distribution.Client.ParseUtils ( parseFields, ppFields, ppSection )
where
import Distribution.ParseUtils
( FieldDescr(..), ParseResult(..), warning, lineNo )
import qualified Distribution.ParseUtils as ParseUtils
( Field(..) )
import Control.Monad ( foldM )
import Text.PrettyPrint ( (<>), (<+>), ($+$) )
import qualified Data.Map as Map
import qualified Text.PrettyPrint as Disp
( Doc, text, colon, vcat, empty, isEmpty, nest )
--FIXME: replace this with something better
parseFields :: [FieldDescr a] -> a -> [ParseUtils.Field] -> ParseResult a
parseFields fields = foldM setField
where
fieldMap = Map.fromList
[ (name, f) | f@(FieldDescr name _ _) <- fields ]
setField accum (ParseUtils.F line name value) =
case Map.lookup name fieldMap of
Just (FieldDescr _ _ set) -> set line value accum
Nothing -> do
warning $ "Unrecognized field " ++ name ++ " on line " ++ show line
return accum
setField accum f = do
warning $ "Unrecognized stanza on line " ++ show (lineNo f)
return accum
-- | This is a customised version of the functions from Distribution.ParseUtils
-- that also optionally print default values for empty fields as comments.
--
ppFields :: [FieldDescr a] -> (Maybe a) -> a -> Disp.Doc
ppFields fields def cur = Disp.vcat [ ppField name (fmap getter def) (getter cur)
| FieldDescr name getter _ <- fields]
ppField :: String -> (Maybe Disp.Doc) -> Disp.Doc -> Disp.Doc
ppField name mdef cur
| Disp.isEmpty cur = maybe Disp.empty
(\def -> Disp.text "--" <+> Disp.text name
<> Disp.colon <+> def) mdef
| otherwise = Disp.text name <> Disp.colon <+> cur
ppSection :: String -> String -> [FieldDescr a] -> (Maybe a) -> a -> Disp.Doc
ppSection name arg fields def cur
| Disp.isEmpty fieldsDoc = Disp.empty
| otherwise = Disp.text name <+> argDoc
$+$ (Disp.nest 2 fieldsDoc)
where
fieldsDoc = ppFields fields def cur
argDoc | arg == "" = Disp.empty
| otherwise = Disp.text arg
|
