{-# LANGUAGE CPP #-}
module CmdLineEnv(options, progName, resourceName, args, argKey, argReadKey, argFlag, argKeyList) where
import IOUtil(progArgs,progName,getEnvi)
import FilePaths(aFilePath,pathTail)
import Utils(segments)
import HbcUtils(apFst, apSnd)
import Data.Char
import Data.Maybe(fromMaybe)
import Control.Applicative((<|>))
--import NonStdTrace(trace)

argReadKey key def = case lookupOptions key of
	   Nothing -> def
	   Just a -> case reads a of
		(v,_):_ -> v
		_ -> error (" Illegal value to flag -"++key++
			    " (default value is "++show def++" of type "++
			    showType def++"): "++a)
#ifndef __HBC__
  where showType _ = "<type??>"
#endif

argKey key def = lookupOptions key `elseM` def
argFlag key def = argKey key (if def then yes else no) == yes
argKeyList key def = maybe def (segments (/=':')) (lookupOptions key)

lookupOptions key = lookup key options
	            <|> env ("FUD_"++resourceName++"_"++key)
	            <|> env ("FUD_"++key)
    where env e = getEnvi e >>= \v -> Just (if v == "" then yes else v)
	  --getEnvi' e = trace ("getEnvi "++e) $ getEnvi e

elseM :: Maybe a -> a -> a
elseM = flip fromMaybe

yes = "yes"
no = "no"

(args, options) = parseOptions progArgs

parseOptions ("-":al) = (al,[]) -- a dash on its own terminates options parsing
parseOptions (('-':ak):av:al) =
    case av of
      '-':avr@(c:_) | isAlpha c && last4 ak /= "font" ->
                       apSnd ((ak,yes):) (parseOptions (av:al))
      _ -> apSnd ((ak,av):) (parseOptions al)
parseOptions ['-':ak] = ([],[(ak, yes)])
parseOptions (a:al) = apFst (a:) (parseOptions al)
parseOptions [] = ([],[])

last4 = reverse . take 4 . reverse

resourceName = pathTail (aFilePath progName)