module Getops where

import Core_datatype

import Vtslib

import Type_defs

import Edlib



{-
(******************************************************************************)
(*   Syntax of flags:                                                         *)
(*                                                                            *)
(*   flags  ::= '--'							      *)
(*		'-' option [ flags]                                           *)
(*   option ::= <flag_char>+                                                  *)
(*              <arg_char> <arg>                                              *)
(******************************************************************************)
-}


data ArgType = Flag | Arg




getops :: [Char] -> [[Char]] -> MayBe ([(Char, Option [Char])], [[Char]]) [Char]

getops template argL
	= Ok ( [ ('t',SOME "Trm")], ["hello"])
--	= process_flags (gen_pattern template) argL



process_flags :: [(Char, ArgType)] -> [[Char]]
			    -> MayBe ([(Char, Option [Char])], [[Char]]) [Char]

process_flags pattern [] = Ok ([], [])

process_flags pattern ("--" : argL)
	= Ok ([], argL)

{-
process_flags pattern (arg : argL)
	| is_option arg
	    = process_options pattern True (tail arg) argL |>|
	      process_flags pattern                        |@|
	      ( \ ( opts' , opts ) argL' -> Ok (opts' ++ opts, argL'))
	| otherwise
	    = Ok ([], arg : argL)
-}





process_options :: [(Char, ArgType)] -> Bool -> [Char] -> [a]
				      -> MayBe ([(Char, Option a)], [a]) [Char]

process_options pattern allow_arg (opt : optL) argL
	= case (assoc opt pattern, (allow_arg, optL, argL)) of
	      (NONE,_)  -> Bad ( "Bad option: " <: opt )
	      (SOME Flag,_)
	                -> process_options pattern False optL argL        |@|
			   ( \ opts argL' -> Ok ((opt,NONE):opts, argL') )
			
	      (SOME Arg, (True,[],arg:argL))
			-> Ok ([(opt,SOME arg)], argL)
	      (SOME Arg, (True,[],[]))
			-> Bad (opt : " requires an argument")
	      (SOME Arg, _)
			-> Bad ("Option syntax error")

process_options pattern allow_arg "" argL = Ok ([],argL)





is_option :: [Char] -> Bool

is_option ( '-' : _ ) = True

is_option _ = False
	




gen_pattern :: [Char] -> [(Char, ArgType)]

gen_pattern [] = []

gen_pattern (opt : ':' : optL)
	= (opt,Arg) : gen_pattern optL

gen_pattern (opt : optL)
	= (opt,Flag) : gen_pattern optL





{-
assoc _ [] = NONE

assoc x ((y,z):l)
	| x==y = SOME z
	| x/=y = assoc x l
-}


