ParseUtils.hs 20.2 KB
Newer Older
1
{-# OPTIONS -cpp #-}
simonmar's avatar
simonmar committed
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
-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.ParseUtils
-- Copyright   :  (c) The University of Glasgow 2004
-- 
-- Maintainer  :  libraries@haskell.org
-- Stability   :  alpha
-- Portability :  portable
--
-- Utilities for parsing PackageDescription and InstalledPackageInfo.


{- All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:

    * Redistributions of source code must retain the above copyright
      notice, this list of conditions and the following disclaimer.

    * Redistributions in binary form must reproduce the above
      copyright notice, this list of conditions and the following
      disclaimer in the documentation and/or other materials provided
      with the distribution.

    * Neither the name of the University nor the names of other
      contributors may be used to endorse or promote products derived
      from this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}

-- This module is meant to be local-only to Distribution...

-- #hide
module Distribution.ParseUtils (
Simon Marlow's avatar
Simon Marlow committed
48
        LineNo, PError(..), PWarning, locatedErrorMsg, syntaxError, warning,
49
	runP, ParseResult(..),
50
	Field(..),
Simon Marlow's avatar
Simon Marlow committed
51
	FieldDescr(..), readFields,
ijones's avatar
ijones committed
52
	parseFilePathQ, parseTokenQ,
53
54
	parseModuleNameQ, parseDependency, parseOptVersion,
	parsePackageNameQ, parseVersionRangeQ,
Simon Marlow's avatar
Simon Marlow committed
55
56
	parseTestedWithQ, parseLicenseQ, parseExtensionQ, 
	parseSepList, parseCommaList, parseOptCommaList,
ijones's avatar
ijones committed
57
	showFilePath, showToken, showTestedWith, showDependency, showFreeText,
Simon Marlow's avatar
Simon Marlow committed
58
	field, simpleField, listField, commaListField, optsField, liftField,
59
	parseReadS, parseReadSQ, parseQuoted,
simonmar's avatar
simonmar committed
60
61
  ) where

ijones's avatar
ijones committed
62
import Distribution.Compiler (CompilerFlavor)
simonmar's avatar
simonmar committed
63
64
65
66
import Distribution.License
import Distribution.Version
import Distribution.Package	( parsePackageName )
import Distribution.Compat.ReadP as ReadP hiding (get)
67
import System.FilePath (normalise)
Simon Marlow's avatar
Simon Marlow committed
68
69
70
import Language.Haskell.Extension (Extension)

import Text.PrettyPrint.HughesPJ
ijones's avatar
ijones committed
71
import Control.Monad (liftM)
simonmar's avatar
simonmar committed
72
import Data.Char
Simon Marlow's avatar
Simon Marlow committed
73
import Data.Maybe	( fromMaybe)
simonmar's avatar
simonmar committed
74
75
76
77
78
79
80
81
82
83

-- -----------------------------------------------------------------------------

type LineNo = Int

data PError = AmbigousParse String LineNo
            | NoParse String LineNo
            | FromString String (Maybe LineNo)
        deriving Show

84
85
86
type PWarning = String

data ParseResult a = ParseFailed PError | ParseOk [PWarning] a
87
88
89
        deriving Show

instance Monad ParseResult where
90
	return x = ParseOk [] x
91
	ParseFailed err >>= _ = ParseFailed err
92
93
94
	ParseOk ws x >>= f = case f x of
	                       ParseFailed err -> ParseFailed err
			       ParseOk ws' x' -> ParseOk (ws'++ws) x'
95
	fail s = ParseFailed (FromString s Nothing)
simonmar's avatar
simonmar committed
96

97
runP :: LineNo -> String -> ReadP a a -> String -> ParseResult a
Simon Marlow's avatar
Simon Marlow committed
98
runP lineNo fieldname p s =
simonmar's avatar
simonmar committed
99
  case [ x | (x,"") <- results ] of
100
    [a] -> ParseOk [] a
simonmar's avatar
simonmar committed
101
    []  -> case [ x | (x,ys) <- results, all isSpace ys ] of
102
             [a] -> ParseOk [] a
Simon Marlow's avatar
Simon Marlow committed
103
104
105
             []  -> ParseFailed (NoParse fieldname lineNo)
             _   -> ParseFailed (AmbigousParse fieldname lineNo)
    _   -> ParseFailed (AmbigousParse fieldname lineNo)
simonmar's avatar
simonmar committed
106
107
  where results = readP_to_S p s

ijones's avatar
ijones committed
108
109
locatedErrorMsg :: PError -> (Maybe LineNo, String)
locatedErrorMsg (AmbigousParse f n) = (Just n, "Ambigous parse in field '"++f++"'")
110
locatedErrorMsg (NoParse f n)       = (Just n, "Parse of field '"++f++"' failed: ")
ijones's avatar
ijones committed
111
112
113
114
locatedErrorMsg (FromString s n)    = (n, s)

syntaxError :: LineNo -> String -> ParseResult a
syntaxError n s = ParseFailed $ FromString s (Just n)
simonmar's avatar
simonmar committed
115

116
117
118
warning :: String -> ParseResult ()
warning s = ParseOk [s] ()

Simon Marlow's avatar
Simon Marlow committed
119
120
data FieldDescr a 
  = FieldDescr 
simonmar's avatar
simonmar committed
121
122
      { fieldName     :: String
      , fieldGet      :: a -> Doc
123
      , fieldSet      :: LineNo -> String -> a -> ParseResult a
simonmar's avatar
simonmar committed
124
125
      }

Simon Marlow's avatar
Simon Marlow committed
126
127
128
129
130
131
132
133
134
135
136
field :: String -> (a -> Doc) -> (ReadP a a) -> FieldDescr a
field name showF readF = 
  FieldDescr name showF (\lineNo val _st -> runP lineNo name readF val)

liftField :: (b -> a) -> (a -> b -> b) -> FieldDescr a -> FieldDescr b
liftField get set (FieldDescr name showF parseF)
 = FieldDescr name (\b -> showF (get b))
	(\lineNo str b -> do
	    a <- parseF lineNo str (get b)
	    return (set a b))

nominolo@gmail.com's avatar
nominolo@gmail.com committed
137
138
139
-- Parser combinator for simple fields.  Takes a field name, a pretty printer,
-- a parser function, an accessor, and a modifier, returns a package
-- FieldDescr over the compoid structure.
Simon Marlow's avatar
Simon Marlow committed
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
simpleField :: String -> (a -> Doc) -> (ReadP a a)
            -> (b -> a) -> (a -> b -> b) -> FieldDescr b
simpleField name showF readF get set
  = liftField get set $ field name showF readF

commaListField :: String -> (a -> Doc) -> (ReadP [a] a)
		 -> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b
commaListField name showF readF get set = 
  liftField get set $ 
    field name (fsep . punctuate comma . map showF) (parseCommaList readF)

listField :: String -> (a -> Doc) -> (ReadP [a] a)
		 -> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b
listField name showF readF get set = 
  liftField get set $ 
    field name (fsep . map showF) (parseOptCommaList readF)

optsField :: String -> CompilerFlavor -> (b -> [(CompilerFlavor,[String])]) -> ([(CompilerFlavor,[String])] -> b -> b) -> FieldDescr b
optsField name flavor get set = 
   liftField (fromMaybe [] . lookup flavor . get) 
	     (\opts b -> set (update flavor opts (get b)) b) $
	field name (hsep . map text)
		   (sepBy parseTokenQ' (munch1 isSpace))
  where
        update f opts [] = [(f,opts)]
	update f opts ((f',opts'):rest)
           | f == f'   = (f, opts ++ opts') : rest
           | otherwise = (f',opts') : update f opts rest
simonmar's avatar
simonmar committed
168

169
170
------------------------------------------------------------------------------

171
172
trimTrailingSpaces :: String -> String
trimTrailingSpaces = reverse . dropWhile isSpace . reverse
simonmar's avatar
simonmar committed
173

174
175
176
177
178
179
180
181
182
183
184
185
186

dropSpaces :: String -> String
dropSpaces = dropWhile isSpace

data Field  = F LineNo String String
            | Section String String [Field]
            | IfBlock String [Field] [Field]
              deriving (Show
                       ,Eq)   -- for testing

--   sectionname ::= "library" | "executable"
sectionNames :: [String]
sectionNames = ["library", "executable:"]
Simon Marlow's avatar
Simon Marlow committed
187
188
189

-- |Split a file into "Field: value" groups
readFields :: String -> ParseResult [Field]
190
191
192
193
194
195
readFields = mkStanza 
           -- . merge 
           . filter validLine 
           . zip [1..] 
           . map trimTrailingSpaces . lines
  where validLine (_,s) = case dropSpaces s of
ijones's avatar
ijones committed
196
197
198
                            '-':'-':_ -> False      -- Comment
                            []        -> False      -- blank line
                            _         -> True
simonmar's avatar
simonmar committed
199

Simon Marlow's avatar
Simon Marlow committed
200
mkStanza :: [(Int,String)] -> ParseResult [Field]
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
mkStanza lines = parseLines lines []
  where 
    parseLines [] fs = return (reverse fs)
    parseLines ls fs = do (f, ls') <- getField ls
                          parseLines ls' $ maybe fs (:fs) f

-- parses:
--
--   field ::= '#' directive value '\n'
--           | [<indent>] fieldname ':' space* fieldvalue
--           | "if" space cond
--           | sectionname section
--
getField :: [(Int,String)] -> ParseResult (Maybe Field,[(Int,String)])
getField [] = return (Nothing, [])
getField ((n,[]):lines) = return (Nothing,lines)
getField ((n,'#':xs):lines) | not (isSpace (head xs)) = do
  return (Just $ F n ('#':dir) (dropSpaces val), lines)
Simon Marlow's avatar
Simon Marlow committed
219
  where (dir,val) = break isSpace xs
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
getField ((lineno,line0):lines) =
    let (spaces,line) = span isSpace line0
        indent = length spaces in 
    case break (`elem` " :{") line of
      (fld0, ':':val0) -> do  -- regular field
        let fld = map toLower fld0
            (val, lines') = getFieldValue indent (dropWhile isSpace val0) lines
        return (Just $ F lineno fld val, lines')
      (blkName, ' ':rest) 
        | map toLower blkName == "if"             -> getIf (lineno,rest) lines 
        | map toLower blkName `elem` sectionNames -> getSection blkName (lineno,rest) lines
        | otherwise -> syntaxError lineno $
            "Missing colon after field label or invalid section name"
      (blkName, '{':rest) 
        | map toLower blkName `elem` sectionNames -> 
            getSection blkName (lineno,'{':rest) lines
      ("","") -> return (Nothing,lines)
      (_,_) -> syntaxError lineno $
        "Unrecognized field format: '" ++ line ++ "'"
          


-- parses:
--
--   cond ::= (any - '}')* block [ space* "else" block ]
--
getIf :: (Int,String) -> [(Int,String)] -> ParseResult (Maybe Field,[(Int,String)])
getIf (n,rest) lines = do
    (cond, ifBlock, lines') <- 
        case break (=='{') (dropSpaces rest) of
          (cond, '{':cs) -> 
            do (b,ls) <- getBlock (n,'{':cs) lines
               return (cond, b, ls)
          (cond, _) -> -- condition spans more than one line
            syntaxError n "Multi-line conditions currently not supported."
    (elseBlock, lines'') <- tryElseBlock lines'
    return (Just $ IfBlock cond ifBlock elseBlock, lines'') 
  where 
    tryElseBlock [] = return ([], [])
    tryElseBlock ((n,l):ls) = 
        if all isSpace l then return ([],ls) 
        else case (splitAt 4 . dropSpaces) l of
          (kw, rest) -> 
              if kw == "else" then 
                  getBlock (n,dropSpaces rest) ls
              else syntaxError n "Only 'else' may appear after an if-Block"
          
-- parses:
-- 
--   block ::= space* '{' space* '\n'
--             field*
--             space* '}' space* '\n'
--   
getBlock :: (Int,String) -> [(Int,String)] -> ParseResult ([Field],[(Int,String)])
getBlock (n,rest) lines = do
    lines' <- checkBlockStart (n,dropSpaces rest) lines
    munchTillEndOfBlock lines' []
  where
    checkBlockStart (n,'{':cs) ls = 
        if all isSpace cs then return ls
        else syntaxError n "Invalid characters after '{'"
    checkBlockStart (_,[]) ((n,l):ls) = 
        checkBlockStart (n,dropSpaces l) ls
    checkBlockStart (n,_) _ = syntaxError n "'{' expected"
                         
    munchTillEndOfBlock [] _ = syntaxError (-1) "missing '}' at end of file"
    munchTillEndOfBlock lines@((n,l):ls) fs =
        case break (=='}') l of
          (spaces, '}':rest) ->   
              if all isSpace spaces
              then return ( reverse fs
                          , (n, rest):ls) 
              else syntaxError n "'}' must be first character on the line"
          _ -> do (f,ls') <- getField lines
                  munchTillEndOfBlock ls' $ maybe fs (:fs) f

-- parses:
--
--   section ::= space* [ blocklabel ] space* block
--   
getSection :: String -> (Int,String) -> [(Int,String)] 
           -> ParseResult (Maybe Field,[(Int,String)])
getSection sectName (n,l) lines = 
    case break (=='{') (dropSpaces l) of
      (sectLabel, '{':rest) -> 
          do (b,lines') <- getBlock (n,'{':rest) lines 
             return (Just $ Section sectName sectLabel b, lines')

-- Get the field value of a field at given indentation      
getFieldValue :: Int -> String -> [(Int,String)] 
              -> (String,[(Int,String)])
getFieldValue indent val lines = 
    ( val' ++ rest 
    , lines')
  where
    val' = dropWhile isSpace val
    rest = (if val' == "" then tail else id) $
             -- don't include initial newline if it would be the first
             -- character
             concatMap (getContinuation . snd) valrest
                
    (valrest,lines') = span (isContinuation indent . snd) lines
    -- the continuation of a field value is everything that is indented
    -- relative to the field's label
    isContinuation indent line = 
        length (takeWhile isSpace line) > indent && not (all isSpace line)
    getContinuation line = '\n':stripDot (dropWhile isSpace line)
    stripDot "." = ""
    stripDot s   = s

------------------------------------------------------------------------------
simonmar's avatar
simonmar committed
331
332

-- |parse a module name
333
parseModuleNameQ :: ReadP r String
ijones's avatar
ijones committed
334
335
parseModuleNameQ = parseQuoted modu <++ modu
 where modu = do 
336
337
338
	  c <- satisfy isUpper
	  cs <- munch (\x -> isAlphaNum x || x `elem` "_'.")
	  return (c:cs)
simonmar's avatar
simonmar committed
339

340
parseFilePathQ :: ReadP r FilePath
341
parseFilePathQ = liftM normalise parseTokenQ
simonmar's avatar
simonmar committed
342
343
344
345
346

parseReadS :: Read a => ReadP r a
parseReadS = readS_to_P reads

parseDependency :: ReadP r Dependency
347
parseDependency = do name <- parsePackageNameQ
simonmar's avatar
simonmar committed
348
                     skipSpaces
349
                     ver <- parseVersionRangeQ <++ return AnyVersion
simonmar's avatar
simonmar committed
350
351
352
                     skipSpaces
                     return $ Dependency name ver

ijones's avatar
ijones committed
353
parsePackageNameQ :: ReadP r String
354
parsePackageNameQ = parseQuoted parsePackageName <++ parsePackageName 
ijones's avatar
ijones committed
355
356

parseVersionRangeQ :: ReadP r VersionRange
357
358
parseVersionRangeQ = parseQuoted parseVersionRange <++ parseVersionRange

simonmar's avatar
simonmar committed
359
parseOptVersion :: ReadP r Version
360
361
362
363
364
365
366
367
368
369
370
parseOptVersion = parseQuoted ver <++ ver
  where ver = parseVersion <++ return noVersion
	noVersion = Version{ versionBranch=[], versionTags=[] }

parseTestedWithQ :: ReadP r (CompilerFlavor,VersionRange)
parseTestedWithQ = parseQuoted tw <++ tw
  where tw = do compiler <- parseReadS
		skipSpaces
		version <- parseVersionRange <++ return AnyVersion
		skipSpaces
		return (compiler,version)
simonmar's avatar
simonmar committed
371

372
373
parseLicenseQ :: ReadP r License
parseLicenseQ = parseQuoted parseReadS <++ parseReadS
simonmar's avatar
simonmar committed
374

375
376
377
378
-- urgh, we can't define optQuotes :: ReadP r a -> ReadP r a
-- because the "compat" version of ReadP isn't quite powerful enough.  In
-- particular, the type of <++ is ReadP r r -> ReadP r a -> ReadP r a
-- Hence the trick above to make 'lic' polymorphic.
simonmar's avatar
simonmar committed
379

380
381
parseExtensionQ :: ReadP r Extension
parseExtensionQ = parseQuoted parseReadS <++ parseReadS
simonmar's avatar
simonmar committed
382

383
384
385
386
-- | Parse something optionally wrapped in quotes.
parseReadSQ :: Read a => ReadP r a
parseReadSQ = parseQuoted parseReadS <++ parseReadS

ijones's avatar
ijones committed
387
388
parseTokenQ :: ReadP r String
parseTokenQ = parseReadS <++ munch1 (\x -> not (isSpace x) && x /= ',')
simonmar's avatar
simonmar committed
389

Simon Marlow's avatar
Simon Marlow committed
390
391
392
393
394
395
396
397
398
parseTokenQ' :: ReadP r String
parseTokenQ' = parseReadS <++ munch1 (\x -> not (isSpace x))

parseSepList :: ReadP r b
	     -> ReadP r a -- ^The parser for the stuff between commas
             -> ReadP r [a]
parseSepList sepr p = sepBy p separator
    where separator = skipSpaces >> sepr >> skipSpaces

simonmar's avatar
simonmar committed
399
400
parseCommaList :: ReadP r a -- ^The parser for the stuff between commas
               -> ReadP r [a]
Simon Marlow's avatar
Simon Marlow committed
401
parseCommaList = parseSepList (ReadP.char ',')
simonmar's avatar
simonmar committed
402

ijones's avatar
ijones committed
403
parseOptCommaList :: ReadP r a -- ^The parser for the stuff between commas
Simon Marlow's avatar
Simon Marlow committed
404
405
                  -> ReadP r [a]
parseOptCommaList = parseSepList (optional (ReadP.char ','))
ijones's avatar
ijones committed
406

407
408
409
parseQuoted :: ReadP r a -> ReadP r a
parseQuoted p = between (ReadP.char '"') (ReadP.char '"') p

simonmar's avatar
simonmar committed
410
411
412
413
-- --------------------------------------------
-- ** Pretty printing

showFilePath :: FilePath -> Doc
ijones's avatar
ijones committed
414
415
416
417
showFilePath = showToken

showToken :: String -> Doc
showToken str
418
419
 | not (any dodgy str) &&
   not (null str)       = text str
ijones's avatar
ijones committed
420
421
 | otherwise            = text (show str)
  where dodgy c = isSpace c || c == ','
simonmar's avatar
simonmar committed
422
423
424
425
426
427

showTestedWith :: (CompilerFlavor,VersionRange) -> Doc
showTestedWith (compiler,version) = text (show compiler ++ " " ++ showVersionRange version)

showDependency :: Dependency -> Doc
showDependency (Dependency name ver) = text name <+> text (showVersionRange ver)
428
429
430
431
432

-- | Pretty-print free-format text, ensuring that it is vertically aligned,
-- and with blank lines replaced by dots for correct re-parsing.
showFreeText :: String -> Doc
showFreeText s = vcat [text (if null l then "." else l) | l <- lines s]
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560

------------------------------------------------------------------------------
-- TESTING

#ifdef DEBUG
test_readFields = case readFields testFile of
                    ParseOk _ x -> x == expectedResult
                    _ -> False
  where 
    testFile = unlines $
          [ "Cabal-version: 3"
          , ""
          , "Description: This is a test file   "
          , "  with a description longer than two lines.  "
          , "if os(windows) {"
          , "  License:  You may not use this software"
          , "    ."
          , "    If you do use this software you will be seeked and destroyed."
          , "}"
          , "if os(linux) {"
          , "  Main-is:  foo1  "
          , "}"
          , ""
          , "if os(vista) {"
          , "  executable RootKit {"
          , "    Main-is: DRMManager.hs"
          , "  }"
          , "} else {"
          , "  executable VistaRemoteAccess {"
          , "    Main-is: VCtrl"
          , "}}"
          , ""
          , "executable Foo-bar {"
          , "  Main-is: Foo.hs"
          , "}"
          ]
    expectedResult = 
          [ F 1 "cabal-version" "3"
          , F 3 "description" 
                  "This is a test file\nwith a description longer than two lines."
          , IfBlock "os(windows) " 
              [ F 6 "license" 
                      "You may not use this software\n\nIf you do use this software you will be seeked and destroyed."
              ]
              []
          , IfBlock "os(linux) " 
              [ F 11 "main-is" "foo1" ] 
              [ ]
          , IfBlock "os(vista) " 
              [ Section "executable" "RootKit " 
                [ F 16 "main-is" "DRMManager.hs"]
              ] 
              [ Section "executable" "VistaRemoteAccess "
                 [F 20 "main-is" "VCtrl"]
              ]
          , Section "executable" "Foo-bar " 
              [F 24 "main-is" "Foo.hs"]
          ]

test_readFieldsCompat' = case test_readFieldsCompat of
                           ParseOk _ fs -> mapM_ (putStrLn . show) fs
                           x -> putStrLn $ "Failed: " ++ show x
test_readFieldsCompat = readFields testPkgDesc
  where 
    testPkgDesc = unlines [
        "-- Required",
        "Name: Cabal",
        "Version: 0.1.1.1.1-rain",
        "License: LGPL",
        "License-File: foo",
        "Copyright: Free Text String",
        "Cabal-version: >1.1.1",
        "-- Optional - may be in source?",
        "Author: Happy Haskell Hacker",
        "Homepage: http://www.haskell.org/foo",
        "Package-url: http://www.haskell.org/foo",
        "Synopsis: a nice package!",
        "Description: a really nice package!",
        "Category: tools",
        "buildable: True",
        "CC-OPTIONS: -g -o",
        "LD-OPTIONS: -BStatic -dn",
        "Frameworks: foo",
        "Tested-with: GHC",
        "Stability: Free Text String",
        "Build-Depends: haskell-src, HUnit>=1.0.0-rain",
        "Other-Modules: Distribution.Package, Distribution.Version,",
        "                Distribution.Simple.GHCPackageConfig",
        "Other-files: file1, file2",
        "Extra-Tmp-Files:    file1, file2",
        "C-Sources: not/even/rain.c, such/small/hands",
        "HS-Source-Dirs: src, src2",
        "Exposed-Modules: Distribution.Void, Foo.Bar",
        "Extensions: OverlappingInstances, TypeSynonymInstances",
        "Extra-Libraries: libfoo, bar, bang",
        "Extra-Lib-Dirs: \"/usr/local/libs\"",
        "Include-Dirs: your/slightest, look/will",
        "Includes: /easily/unclose, /me, \"funky, path\\\\name\"",
        "Install-Includes: /easily/unclose, /me, \"funky, path\\\\name\"",
        "GHC-Options: -fTH -fglasgow-exts",
        "Hugs-Options: +TH",
        "Nhc-Options: ",
        "Jhc-Options: ",
        "",
        "-- Next is an executable",
        "Executable: somescript",
        "Main-is: SomeFile.hs",
        "Other-Modules: Foo1, Util, Main",
        "HS-Source-Dir: scripts",
        "Extensions: OverlappingInstances",
        "GHC-Options: ",
        "Hugs-Options: ",
        "Nhc-Options: ",
        "Jhc-Options: "
        ]
{-
test' = do h <- openFile "../Cabal.cabal" ReadMode
           s <- hGetContents h
           let r = readFields s
           case r of
             ParseOk _ fs -> mapM_ (putStrLn . show) fs
             x -> putStrLn $ "Failed: " ++ show x
           putStrLn "==================="
           mapM_ (putStrLn . show) $
                 merge . zip [1..] . lines $ s
           hClose h
-}
#endif