src/CommandLine.lhs

   1 %  Copyright (C) 2005 Benedikt Schmidt
   2 %
   3 %  This program is free software; you can redistribute it and/or modify
   4 %  it under the terms of the GNU General Public License as published by
   5 %  the Free Software Foundation; either version 2, or (at your option)
   6 %  any later version.
   7 %
   8 %  This program is distributed in the hope that it will be useful,
   9 %  but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 %  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 %  GNU General Public License for more details.
  12 %
  13 %  You should have received a copy of the GNU General Public License
  14 %  along with this program; see the file COPYING.  If not, write to
  15 %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  16 %  Boston, MA 02110-1301, USA.
  17
  18
  19 A parser for commandlines, returns an arg list and expands
  20 format strings given in a translation table. Additionally
  21 the commandline can end with "%<" specifying that the command
  22 expects input on stdin.
  23
  24 \begin{code}
  25 module CommandLine ( parseCmd, addUrlencoded ) where
  26 import Text.ParserCombinators.Parsec
  27 import Data.Char ( ord, intToDigit, toUpper )
  28 import Data.List ( find )
  29 \end{code}
  30
  31 \begin{code}
  32 -- | assoc list mapping characters to strings
  33 -- eg (c,s) means that %c is replaced by s
  34 type FTable = [(Char,String)]
  35 commandline :: FTable -> Parser ([String], Bool)
  36 commandline ftable = consumeAll (do l <- sepEndBy1 (arg ftable)
  37                                                    (try separator)
  38                                     redir <- formatRedir
  39                                     spaces
  40                                     return (l,redir))
  41
  42 escape:: Parser String
  43 arg, format, quotedArg, unquotedArg, quoteContent :: FTable -> Parser String
  44 arg ftable = (quotedArg ftable <|> unquotedArg ftable)
  45
  46 unquotedArg ftable = do (try $ format ftable)
  47                           <|> (many1 $ noneOf [' ', '\t', '"', '%'])
  48
  49 quotedArg ftable = between (char '"') (char '"') $ quoteContent ftable
  50
  51 quoteContent ftable = do s1 <- escape
  52                                <|> (try $ format ftable)
  53                                <|> (many1 (noneOf ['"', '\\', '%']))
  54                          s2 <- quoteContent ftable
  55                          return $ s1 ++ s2
  56                      <|> return ""
  57
  58 formatRedir :: Parser Bool
  59 formatRedir = do string "%<"
  60                  return True
  61             <|> return False
  62
  63 format ftable = do char '%'
  64                    c <- oneOf  (map fst ftable)
  65                    return $ expandFormat ftable c
  66
  67 escape = do char '\\'
  68             c <- anyChar
  69             return [c]
  70
  71 consumeAll :: Parser a -> Parser a
  72 consumeAll p = do r <- p
  73                   eof
  74                   return r
  75
  76 separator :: Parser ()
  77 separator = do skipMany1 space
  78
  79 expandFormat :: FTable -> Char -> String
  80 expandFormat ftable c = case find ((==c) . fst) ftable of
  81                           Just (_,s) -> s
  82                           Nothing -> error "impossible"
  83
  84 -- | parse a commandline returning a list of strings
  85 -- (intended to be used as argv) and a bool value which
  86 -- specifies if the command expects input on stdin
  87 -- format specifiers with a mapping in ftable are accepted
  88 -- and replaced by the given strings. E.g. if the ftable is
  89 -- [('s',"Some subject")], then "%s" is replaced by "Some subject"
  90 parseCmd :: FTable -> String -> Either ParseError ([String],Bool)
  91 parseCmd ftable s = parse (commandline ftable) "" s
  92
  93 urlEncode :: String -> String
  94 urlEncode s = concat $ map escapeC s
  95     where escapeC x = if allowed x then [x] else '%':(intToHex $ ord x)
  96           intToHex i = map intToDigit [i `div` 16, i `mod` 16]
  97           allowed x = x `elem` ['a' .. 'z'] ++ ['A' .. 'Z'] ++ ['0' .. '9']
  98                       ++ "!'()*-.~"
  99
 100 -- | for every mapping (c,s), add a mapping with uppercase c
 101 -- and the urlencoded string s
 102 addUrlencoded :: FTable -> FTable
 103 addUrlencoded ftable =
 104   ftable ++(map (\ (c,x) -> (toUpper c, urlEncode x)) ftable)
 105 \end{code}
 106 Some tests for the parser.
 107
 108 formatTable = [('s',"<insert subject here>"),
 109                ('a',"<insert author here>")]
 110
 111 testParser :: (Show a, Eq a) => Parser a -> String -> a -> a
 112 testParser p s ok = case parse p "" s of
 113                     Left e -> error $ "Parser failed with: " ++ (show e)
 114                     Right res -> if res == ok
 115                                  then res
 116                                  else error $ "Parser failed: got "
 117                                         ++ (show res) ++ ", expected "
 118                                         ++ (show ok)
 119
 120 testCases = [("a b",(["a","b"], False)),
 121              ("a b %<",(["a","b"], True)),
 122              ("a b %< ",(["a","b"], True)),
 123              ("\"arg0 contains spaces \\\"quotes\\\"\" b",
 124               (["arg0 contains spaces \"quotes\"","b"],False)),
 125              ("a %s %<",(["a","<insert subject here>"], True))]
 126
 127 runTests = map (uncurry $ testParser (commandline formatTable)) testCases