← Back to branch summary

~ubuntu-branches/ubuntu/maverick/haskell-configfile/maverick

« back to all changes in this revision

Viewing changes to src/Data/ConfigFile/Parser.hs

  • Committer: Bazaar Package Importer
  • Author(s): John Goerzen
  • Date: 2007-03-08 14:22:03 UTC
  • Revision ID: james.westby@ubuntu.com-20070308142203-j9niks7p5q8e9ycs
Tags: 1.0.1
Rebuild against newer MissingH.

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/Data/ConfigFile/Parser.hs
 
1
{- arch-tag: ConfigParser parser support
 
2
Copyright (C) 2004 John Goerzen <jgoerzen@complete.org>
 
3
 
 
4
This program is free software; you can redistribute it and/or modify
 
5
it under the terms of the GNU Lesser General Public License as published by
 
6
the Free Software Foundation; either version 2.1 of the License, or
 
7
(at your option) any later version.
 
8
 
 
9
This program is distributed in the hope that it will be useful,
 
10
but WITHOUT ANY WARRANTY; without even the implied warranty of
 
11
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
12
GNU Lesser General Public License for more details.
 
13
 
 
14
You should have received a copy of the GNU Lesser General Public License
 
15
along with this program; if not, write to the Free Software
 
16
Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
 
17
-}
 
18
 
 
19
{- |
 
20
   Module     : Data.ConfigFile.Parser
 
21
   Copyright  : Copyright (C) 2004 John Goerzen
 
22
   License    : GNU LGPL, version 2.1 or above
 
23
 
 
24
   Maintainer : John Goerzen <jgoerzen@complete.org> 
 
25
   Stability  : provisional
 
26
   Portability: portable
 
27
 
 
28
Parser support for "Data.ConfigFile".  This module is not intended to be
 
29
used directly by your programs.
 
30
 
 
31
Copyright (c) 2004 John Goerzen, jgoerzen\@complete.org
 
32
-}
 
33
module Data.ConfigFile.Parser
 
34
(
 
35
 parse_string, parse_file, parse_handle, interpmain, ParseOutput
 
36
       --satisfyG,
 
37
       --main
 
38
) where
 
39
import Text.ParserCombinators.Parsec
 
40
import Control.Monad.Error(throwError, MonadError)
 
41
import Data.String
 
42
import Data.ConfigFile.Lexer
 
43
import System.IO(Handle, hGetContents)
 
44
import Text.ParserCombinators.Parsec.Utils
 
45
import Data.ConfigFile.Types
 
46
 
 
47
----------------------------------------------------------------------
 
48
-- Exported funcs
 
49
----------------------------------------------------------------------
 
50
 
 
51
parse_string :: MonadError CPError m =>
 
52
                String -> m ParseOutput
 
53
parse_string s = 
 
54
    detokenize "(string)" $ parse loken "(string)" s
 
55
 
 
56
--parse_file :: FilePath -> IO (CPResult ParseOutput)
 
57
parse_file :: MonadError CPError m => FilePath -> IO (m ParseOutput)
 
58
parse_file f =
 
59
    do o <- parseFromFile loken f
 
60
       return $ detokenize f o
 
61
 
 
62
--parse_handle :: Handle -> IO (CPResult ParseOutput)
 
63
parse_handle :: MonadError CPError m => Handle -> IO (m ParseOutput)
 
64
parse_handle h =
 
65
    do s <- hGetContents h
 
66
       let o = parse loken (show h) s
 
67
       return $ detokenize (show h) o
 
68
 
 
69
----------------------------------------------------------------------
 
70
-- Private funcs
 
71
----------------------------------------------------------------------
 
72
detokenize fp l =
 
73
    let conv msg (Left err) = throwError $ (ParseError (show err), msg)
 
74
        conv msg (Right val) = return val
 
75
        in do r <- conv "lexer" l
 
76
              conv "parser" $ runParser main () fp r
 
77
 
 
78
main :: GeneralizedTokenParser CPTok () ParseOutput
 
79
main =
 
80
    do {s <- sectionlist; return s}
 
81
    <|> try (do 
 
82
             o <- optionlist
 
83
             s <- sectionlist
 
84
             return $ ("DEFAULT", o) : s
 
85
            )
 
86
    <|> do {o <- optionlist; return $ [("DEFAULT", o)] }
 
87
    <?> "Error parsing config file tokens"
 
88
        
 
89
sectionlist :: GeneralizedTokenParser CPTok () ParseOutput
 
90
sectionlist = do {eof; return []}
 
91
              <|> try (do 
 
92
                       s <- sectionhead
 
93
                       eof
 
94
                       return [(s, [])]
 
95
                      )
 
96
              <|> do
 
97
                  s <- section
 
98
                  sl <- sectionlist
 
99
                  return (s : sl)
 
100
 
 
101
section :: GeneralizedTokenParser CPTok () (String, [(String, String)])
 
102
section = do {sh <- sectionhead; ol <- optionlist; return (sh, ol)}
 
103
 
 
104
sectionhead :: GeneralizedTokenParser CPTok () String
 
105
sectionhead = 
 
106
    let wf (NEWSECTION x) = Just x
 
107
        wf _ = Nothing
 
108
        in
 
109
        do {s <- tokeng wf; return $ strip s}
 
110
 
 
111
optionlist :: GeneralizedTokenParser CPTok () [(String, String)]
 
112
optionlist = many1 coption
 
113
 
 
114
coption :: GeneralizedTokenParser CPTok () (String, String)
 
115
coption =
 
116
    let wf (NEWOPTION x) = Just x
 
117
        wf _ = Nothing
 
118
        wfx (EXTENSIONLINE x) = Just x
 
119
        wfx _ = Nothing
 
120
        in
 
121
        do o <- tokeng wf
 
122
           l <- many $ tokeng wfx
 
123
           return (strip (fst o), valmerge ((snd o) : l))
 
124
 
 
125
valmerge :: [String] -> String
 
126
valmerge vallist =
 
127
    let vl2 = map strip vallist
 
128
        in join "\n" vl2
 
129
 
 
130
----------------------------------------------------------------------
 
131
-- Interpolation
 
132
----------------------------------------------------------------------
 
133
 
 
134
interpval :: Parser String
 
135
interpval  = do
 
136
            string "%("
 
137
            s <- (many1 $ noneOf ")") <?> "interpolation name"
 
138
            string ")s"               <?> "end of interpolation name"
 
139
            return s
 
140
 
 
141
percentval :: Parser String
 
142
percentval = do
 
143
             string "%%"
 
144
             return "%"
 
145
 
 
146
interpother :: Parser String
 
147
interpother = do
 
148
              c <- noneOf "%"
 
149
              return [c]
 
150
 
 
151
interptok :: (String -> Either CPError String) -> Parser String
 
152
interptok lookupfunc = (try percentval)
 
153
                       <|> interpother
 
154
                       <|> do s <- interpval
 
155
                              case lookupfunc s of
 
156
                                 Left (InterpolationError x, _) -> fail x
 
157
                                 Left _ -> fail $ "unresolvable interpolation reference to \"" ++ s ++ "\""
 
158
                                 Right x -> return x
 
159
 
 
160
 
 
161
interpmain :: (String -> Either CPError String) -> Parser String
 
162
interpmain lookupfunc =
 
163
    do r <- manyTill (interptok lookupfunc) eof
 
164
       return $ concat r