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 -- |A parser for commandlines, returns an arg list and expands
   19 -- format strings given in a translation table. Additionally
   20 -- the commandline can end with "%<" specifying that the command
   21 -- expects input on stdin.
   22 --
   23 -- Some tests for the parser.
   24 --
   25 -- > formatTable = [('s',"<insert subject here>"),
   26 -- >                ('a',"<insert author here>")]
   27 -- >
   28 -- > testParser :: (Show a, Eq a) => Parser a -> String -> a -> a
   29 -- > testParser p s ok = case parse p "" s of
   30 -- >                     Left e -> error $ "Parser failed with: " ++ (show e)
   31 -- >                     Right res -> if res == ok
   32 -- >                                  then res
   33 -- >                                  else error $ "Parser failed: got "
   34 -- >                                         ++ (show res) ++ ", expected "
   35 -- >                                         ++ (show ok)
   36 -- >
   37 -- > testCases = [("a b",(["a","b"], False)),
   38 -- >              ("a b %<",(["a","b"], True)),
   39 -- >              ("a b %< ",(["a","b"], True)),
   40 -- >              ("\"arg0 contains spaces \\\"quotes\\\"\" b",
   41 -- >               (["arg0 contains spaces \"quotes\"","b"],False)),
   42 -- >              ("a %s %<",(["a","<insert subject here>"], True))]
   43 -- >
   44 -- > runTests = map (uncurry $ testParser (commandline formatTable)) testCases
   45 module CommandLine ( parseCmd, addUrlencoded ) where
   46 import Text.ParserCombinators.Parsec
   47 import Data.Char ( ord, intToDigit, toUpper )
   48 import Data.List ( find )
   49 
   50 -- | assoc list mapping characters to strings
   51 -- eg (c,s) means that %c is replaced by s
   52 type FTable = [(Char,String)]
   53 commandline :: FTable -> Parser ([String], Bool)
   54 commandline ftable = consumeAll (do l <- sepEndBy1 (arg ftable) 
   55                                                    (try separator)
   56                                     redir <- formatRedir
   57                                     spaces
   58                                     return (l,redir))
   59 
   60 escape:: Parser String
   61 arg, format, quotedArg, unquotedArg, quoteContent :: FTable -> Parser String
   62 arg ftable = (quotedArg ftable <|> unquotedArg ftable)
   63 
   64 unquotedArg ftable = do (try $ format ftable)
   65                           <|> (many1 $ noneOf [' ', '\t', '"', '%'])
   66 
   67 quotedArg ftable = between (char '"') (char '"') $ quoteContent ftable
   68 
   69 quoteContent ftable = do s1 <- escape
   70                                <|> (try $ format ftable)
   71                                <|> (many1 (noneOf ['"', '\\', '%']))
   72                          s2 <- quoteContent ftable
   73                          return $ s1 ++ s2
   74                      <|> return ""
   75 
   76 formatRedir :: Parser Bool
   77 formatRedir = do string "%<"
   78                  return True
   79             <|> return False
   80 
   81 format ftable = do char '%'
   82                    c <- oneOf  (map fst ftable)
   83                    return $ expandFormat ftable c
   84 
   85 escape = do char '\\'
   86             c <- anyChar
   87             return [c]
   88 
   89 consumeAll :: Parser a -> Parser a
   90 consumeAll p = do r <- p
   91                   eof
   92                   return r
   93                 
   94 separator :: Parser ()
   95 separator = do skipMany1 space
   96 
   97 expandFormat :: FTable -> Char -> String
   98 expandFormat ftable c = case find ((==c) . fst) ftable of
   99                           Just (_,s) -> s
  100                           Nothing -> error "impossible"
  101 
  102 -- | parse a commandline returning a list of strings 
  103 -- (intended to be used as argv) and a bool value which
  104 -- specifies if the command expects input on stdin
  105 -- format specifiers with a mapping in ftable are accepted
  106 -- and replaced by the given strings. E.g. if the ftable is
  107 -- [('s',"Some subject")], then "%s" is replaced by "Some subject"
  108 parseCmd :: FTable -> String -> Either ParseError ([String],Bool)
  109 parseCmd ftable s = parse (commandline ftable) "" s
  110 
  111 urlEncode :: String -> String
  112 urlEncode s = concat $ map escapeC s
  113     where escapeC x = if allowed x then [x] else '%':(intToHex $ ord x)
  114           intToHex i = map intToDigit [i `div` 16, i `mod` 16]    
  115           allowed x = x `elem` ['a' .. 'z'] ++ ['A' .. 'Z'] ++ ['0' .. '9']
  116                       ++ "!'()*-.~"
  117 
  118 -- | for every mapping (c,s), add a mapping with uppercase c
  119 -- and the urlencoded string s
  120 addUrlencoded :: FTable -> FTable
  121 addUrlencoded ftable =
  122   ftable ++(map (\ (c,x) -> (toUpper c, urlEncode x)) ftable)