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

argReadKey :: [Char] -> p -> p
argReadKey [Char]
key p
def = case [Char] -> Maybe [Char]
lookupOptions [Char]
key of
	   Maybe [Char]
Nothing -> p
def
	   Just [Char]
a -> case ReadS p
forall a. Read a => ReadS a
reads [Char]
a of
		(p
v,[Char]
_):[(p, [Char])]
_ -> p
v
		[(p, [Char])]
_ -> [Char] -> p
forall a. HasCallStack => [Char] -> a
error ([Char]
" Illegal value to flag -"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
key[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
			    [Char]
" (default value is "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++p -> [Char]
forall a. Show a => a -> [Char]
show p
def[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" of type "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
			    p -> [Char]
forall p. p -> [Char]
showType p
def[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"): "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
a)
#ifndef __HBC__
  where showType :: p -> [Char]
showType p
_ = [Char]
"<type??>"
#endif

argKey :: [Char] -> [Char] -> [Char]
argKey [Char]
key [Char]
def = [Char] -> Maybe [Char]
lookupOptions [Char]
key Maybe [Char] -> [Char] -> [Char]
forall a. Maybe a -> a -> a
`elseM` [Char]
def
argFlag :: [Char] -> Bool -> Bool
argFlag [Char]
key Bool
def = [Char] -> [Char] -> [Char]
argKey [Char]
key (if Bool
def then [Char]
yes else [Char]
no) [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
yes
argKeyList :: [Char] -> [[Char]] -> [[Char]]
argKeyList [Char]
key [[Char]]
def = [[Char]] -> ([Char] -> [[Char]]) -> Maybe [Char] -> [[Char]]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [[Char]]
def ((Char -> Bool) -> [Char] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [[a]]
segments (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
':')) ([Char] -> Maybe [Char]
lookupOptions [Char]
key)

lookupOptions :: [Char] -> Maybe [Char]
lookupOptions [Char]
key = [Char] -> [([Char], [Char])] -> Maybe [Char]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Char]
key [([Char], [Char])]
options
	      Maybe [Char] -> Maybe [Char] -> Maybe [Char]
forall a. Maybe a -> Maybe a -> Maybe a
`orM` ([Char] -> Maybe [Char]
env ([Char]
"FUD_"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
removePath [Char]
progName[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"_"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
key))
	      Maybe [Char] -> Maybe [Char] -> Maybe [Char]
forall a. Maybe a -> Maybe a -> Maybe a
`orM` ([Char] -> Maybe [Char]
env ([Char]
"FUD_"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
key))

    where removePath :: [Char] -> [Char]
removePath = [Char] -> [Char]
forall a. [a] -> [a]
reverse ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], [Char]) -> [Char]
forall a b. (a, b) -> a
fst (([Char], [Char]) -> [Char])
-> ([Char] -> ([Char], [Char])) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> [Char] -> ([Char], [Char])
forall a. Eq a => a -> [a] -> ([a], [a])
breakAt Char
'/' ([Char] -> ([Char], [Char]))
-> ([Char] -> [Char]) -> [Char] -> ([Char], [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
forall a. [a] -> [a]
reverse
	  env :: [Char] -> Maybe [Char]
env [Char]
e = [Char] -> Maybe [Char]
getEnvi [Char]
e Maybe [Char] -> ([Char] -> Maybe [Char]) -> Maybe [Char]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Char]
v -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just (if [Char]
v [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"" then [Char]
yes else [Char]
v)
	  --getEnvi' e = trace ("getEnvi "++e) $ getEnvi e

orM :: Maybe a -> Maybe a -> Maybe a
--orM = (++)
orM :: Maybe a -> Maybe a -> Maybe a
orM Maybe a
Nothing  Maybe a
b = Maybe a
b
orM Maybe a
a        Maybe a
b = Maybe a
a

elseM :: Maybe a -> a -> a
elseM :: Maybe a -> a -> a
elseM = (a -> Maybe a -> a) -> Maybe a -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe
--elseM (Just a) a' = a
--elseM Nothing  a' = a'

yes :: [Char]
yes = [Char]
"yes"
no :: [Char]
no = [Char]
"no"

([[Char]]
args, [([Char], [Char])]
options) =
    let parse :: [[Char]] -> ([[Char]], [([Char], [Char])])
parse ((Char
'-' : [Char]
ak) : [Char]
av : [[Char]]
al) = case [Char]
av of
	      Char
'-':[Char]
avr -> if Bool -> Bool
not ([Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
avr) Bool -> Bool -> Bool
&& Char -> Bool
isAlpha ([Char] -> Char
forall a. [a] -> a
head [Char]
avr)
	          Bool -> Bool -> Bool
&& [Char] -> [Char]
forall a. [a] -> [a]
reverse (Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
4 ([Char] -> [Char]
forall a. [a] -> [a]
reverse [Char]
ak)) [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char]
"font" 
		  then ([([Char], [Char])] -> [([Char], [Char])])
-> ([[Char]], [([Char], [Char])]) -> ([[Char]], [([Char], [Char])])
forall t b a. (t -> b) -> (a, t) -> (a, b)
apSnd (([Char]
ak, [Char]
yes) ([Char], [Char]) -> [([Char], [Char])] -> [([Char], [Char])]
forall a. a -> [a] -> [a]
:) ([[Char]] -> ([[Char]], [([Char], [Char])])
parse ([Char]
av[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[[Char]]
al))
		  else ([[Char]], [([Char], [Char])])
thearg
	      [Char]
_ -> ([[Char]], [([Char], [Char])])
thearg
            where thearg :: ([[Char]], [([Char], [Char])])
thearg = ([([Char], [Char])] -> [([Char], [Char])])
-> ([[Char]], [([Char], [Char])]) -> ([[Char]], [([Char], [Char])])
forall t b a. (t -> b) -> (a, t) -> (a, b)
apSnd (([Char]
ak, [Char]
av) ([Char], [Char]) -> [([Char], [Char])] -> [([Char], [Char])]
forall a. a -> [a] -> [a]
:) ([[Char]] -> ([[Char]], [([Char], [Char])])
parse [[Char]]
al)
        parse [Char
'-' : [Char]
ak] = ([], [([Char]
ak, [Char]
yes)])
        parse ([Char]
"-":[[Char]]
al) = ([[Char]]
al,[])
        parse ([Char]
a : [[Char]]
al) = ([[Char]] -> [[Char]])
-> ([[Char]], [([Char], [Char])]) -> ([[Char]], [([Char], [Char])])
forall t a b. (t -> a) -> (t, b) -> (a, b)
apFst ([Char]
a [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:) ([[Char]] -> ([[Char]], [([Char], [Char])])
parse [[Char]]
al)
        parse [] = ([], [])
    in  [[Char]] -> ([[Char]], [([Char], [Char])])
parse [[Char]]
progArgs


resourceName :: [Char]
resourceName = AFilePath -> [Char]
pathTail ([Char] -> AFilePath
aFilePath [Char]
progName)