------------------------------------------------------------------
-- |
-- Module      :  IdlOptions
-- Copyright   :  (c) Dmitry Golubovsky, 2009
-- License     :  BSD-style
-- 
-- Maintainer  :  golubovsky@gmail.com
-- Stability   :  experimental
-- Portability :  portable
-- 
--
--
-- Parse command line options for idlconv, including cpphs options.
------------------------------------------------------------------

module IdlOptions (
  module Text.ParserCombinators.Parsec
 ,parseArgs
 ,arg
 ,eol
 ,eoo
 ,kw
 ,opt
 ,optparm
 ,noopt
 ,sepopts
  )where

import Control.Monad
import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Prim
import Text.ParserCombinators.Parsec.Pos

-- Define parsec-based combinators to parse the command line arguments assuming
-- they come in as a list of strings (from getArgs).

-- A parser takes a list of strings and produces the parsing result (user-defined).
-- Each argument is passed to a user-defined action which ends up modifying the state.

-- Parse command line arguments with user-define state.

parseArgs :: GenParser String s a -> s -> [String] -> Either ParseError s

parseArgs g is ss = runParser (g >> getState) is "<command line>" ss

-- Parser combinators.

-- A single argument. The user action possibly returns modified state (Just) or
-- the parser fails on unexpected input. The first argument labels the parser,
-- so what's expected would also be included with the error message.

arg :: String -> (String -> s -> Maybe s) -> GenParser String s ()

arg ex ua = try p <?> ex where 
  p = do
    t <- tokenPrim id (\pos s ss -> updatePosString pos s) Just
    s <- getState
    case ua t s of
      Just s' -> setState s'
      Nothing -> unexpected t

-- An argument which is not an option (should not start with hyphen)

noopt :: String -> (String -> s -> Maybe s) -> GenParser String s ()

noopt ex ua = arg ex $ \t s -> case t of
  ('-':_) -> Nothing
  _       -> ua t s

-- Match a single-letter option without a parameter. The user function
-- is given the option character if succeeds. Options may be grouped
-- together under a single hyphen-prefixed token, so if there is any
-- remainder, it is resubmitted for parsing.

opt :: Char -> (Char -> s -> Maybe s) -> GenParser String s ()

opt c ua = try p <?> ('-' : c : []) where
  p = do
    t <- tokenPrim id (\pos s ss -> updatePosString pos s) Just
    case t of
      "" -> unexpected "empty argument"
      ('-':o:r) | o == c -> do
        when (not $ null r) $ do
          i <- getInput
          setInput (('-':r):i)
        s <- getState
        case ua o s of
          Just s' -> setState s'
          Nothing -> fail $ "invalid option -" ++ [o]
      ('-':o:_) -> fail $ "invalid option -" ++ [o]
      _ -> unexpected t

-- Match a single-letter option with a parameter. The user function is given
-- the option character and the parameter string if succeeds. Recognition of
-- the parameter value is entirely upon the user function. The parameter may
-- follow the option in the next token, or it may be within the same token.
-- Additional argument to this function describes the meaning of this option
-- that appears in the "expected" message.

optparm :: Char -> String -> (Char -> String -> s -> Maybe s) -> GenParser String s ()

optparm c mng ua = try p <?> ex c mng where
  ex cc "" = ex cc "parameter"
  ex cc ss = '-' : cc : ' ' : ss
  p = do
    t <- tokenPrim id (\pos s ss -> updatePosString pos s) Just
    case t of
      "" -> unexpected "empty argument"
      ('-':o:r) | o == c -> do
        v <- if null r
          then (tokenPrim id (\pos s ss -> updatePosString pos s) Just <|> 
                fail ("option -" ++ [o] ++ " requires a value"))
          else return r
        s <- getState
        case ua o v s of
          Just s' -> setState s'
          Nothing -> fail $ "invalid value " ++ v ++ " of option -" ++ [o]
      ('-':o:_) -> fail $ "invalid option -" ++ [o]
      _ -> unexpected t

-- End of line. This parser does not change the user state and succeeds only if the
-- remainder of the command line is empty.

eol = do
  i <- getInput
  if null i then return () else fail ""

-- Match a keyword. The user function is given a keyword if succeeds.

kw :: String -> (String -> s -> Maybe s) -> GenParser String s ()

kw w ua = arg w $ \ww s -> if w == ww then ua w s else Nothing

-- End of options. This parser succeeds on double-hyphens, and fails on
-- anything else.

eoo :: GenParser String s ()

eoo = kw "--" $ \_ -> Just

-- Implement end of options with treatment of the remaining arguments as
-- non-options even though they may start with a hyphen.
-- The user function and description will be used with all remaining arguments.

sepopts :: String -> (String -> s -> Maybe s) -> GenParser String s ()

sepopts ex ua = eol <|> (eoo >> many (arg ex ua) >> eol)