{- | Very simple command line interface option parser.

Only allows options of the form --key=value, with the form --key equal to --key=True.

A list of OptUsr describes the options and provides default values.

'get_opt_arg' merges user and default values into a table with values for all options.

To fetch options use 'opt_get' and 'opt_read'.

-}
module Music.Theory.Opt where

import Control.Monad {- base -}
import Data.List {- base -}
import Data.Maybe {- base -}
import System.Environment {- base -}
import System.Exit {- base -}

import qualified Data.List.Split as Split {- split -}

import qualified Music.Theory.Either as T {- hmt-base -}
import qualified Music.Theory.Read as T {- hmt-base -}

{- | (Key,Value)

Key does not include leading '--'.
-}
type Opt = (String,String)

-- | (Key,Default-Value,Type,Note)
type OptUsr = (String,String,String,String)

-- | Re-write default values at OptUsr.
opt_usr_rw_def :: [Opt] -> [OptUsr] -> [OptUsr]
opt_usr_rw_def :: [Opt] -> [OptUsr] -> [OptUsr]
opt_usr_rw_def [Opt]
rw =
  let f :: (String, String, c, d) -> (String, String, c, d)
f (String
k,String
v,c
ty,d
dsc) = case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
k [Opt]
rw of
                         Just String
v' -> (String
k,String
v',c
ty,d
dsc)
                         Maybe String
Nothing -> (String
k,String
v,c
ty,d
dsc)
  in forall a b. (a -> b) -> [a] -> [b]
map forall {c} {d}. (String, String, c, d) -> (String, String, c, d)
f

-- | OptUsr to Opt.
opt_plain :: OptUsr -> Opt
opt_plain :: OptUsr -> Opt
opt_plain (String
k,String
v,String
_,String
_) = (String
k,String
v)

-- | OptUsr to help string, indent is two spaces.
opt_usr_help :: OptUsr -> String
opt_usr_help :: OptUsr -> String
opt_usr_help (String
k,String
v,String
t,String
n) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"  ",String
k,String
":",String
t,String
" -- ",String
n,String
"; default=",if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
v then String
"Nil" else String
v]

-- | 'unlines' of 'opt_usr_help'
opt_help :: [OptUsr] -> String
opt_help :: [OptUsr] -> String
opt_help = [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map OptUsr -> String
opt_usr_help

-- | Lookup Key in Opt, error if non-existing.
opt_get :: [Opt] -> String -> String
opt_get :: [Opt] -> String -> String
opt_get [Opt]
o String
k = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error (String
"opt_get: " forall a. [a] -> [a] -> [a]
++ String
k)) (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
k [Opt]
o)

-- | Variant that returns Nothing if the result is the empty string, else Just the result.
opt_get_nil :: [Opt] -> String -> Maybe String
opt_get_nil :: [Opt] -> String -> Maybe String
opt_get_nil [Opt]
o String
k = let r :: String
r = [Opt] -> String -> String
opt_get [Opt]
o String
k in if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
r then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just String
r

-- | 'read' of 'get_opt'
opt_read :: Read t => [Opt] -> String -> t
opt_read :: forall t. Read t => [Opt] -> String -> t
opt_read [Opt]
o = forall a. Read a => String -> a
T.read_err forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Opt] -> String -> String
opt_get [Opt]
o

-- | Parse k or k=v string, else error.
opt_param_parse :: String -> Opt
opt_param_parse :: String -> Opt
opt_param_parse String
p =
  case forall a. Eq a => [a] -> [a] -> [[a]]
Split.splitOn String
"=" String
p of
    [String
lhs] -> (String
lhs,String
"True")
    [String
lhs,String
rhs] -> (String
lhs,String
rhs)
    [String]
_ -> forall a. HasCallStack => String -> a
error (String
"opt_param_parse: " forall a. [a] -> [a] -> [a]
++ String
p)

-- | Parse option string of form "--opt" or "--key=value".
--
-- > opt_parse "--opt" == Just ("opt","True")
-- > opt_parse "--key=value" == Just ("key","value")
opt_parse :: String -> Maybe Opt
opt_parse :: String -> Maybe Opt
opt_parse String
s =
  case String
s of
    Char
'-':Char
'-':String
p -> forall a. a -> Maybe a
Just (String -> Opt
opt_param_parse String
p)
    String
_ -> forall a. Maybe a
Nothing

-- | Parse option sequence, collating options and non-options.
--
-- > opt_set_parse (words "--a --b=c d") == ([("a","True"),("b","c")],["d"])
opt_set_parse :: [String] -> ([Opt],[String])
opt_set_parse :: [String] -> ([Opt], [String])
opt_set_parse =
  let f :: String -> Either Opt String
f String
s = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. b -> Either a b
Right String
s) forall a b. a -> Either a b
Left (String -> Maybe Opt
opt_parse String
s)
  in forall a b. [Either a b] -> ([a], [b])
T.partition_eithers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map String -> Either Opt String
f

-- | Left-biased Opt merge.
opt_merge :: [Opt] -> [Opt] -> [Opt]
opt_merge :: [Opt] -> [Opt] -> [Opt]
opt_merge [Opt]
p [Opt]
q =
  let x :: [String]
x = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [Opt]
p
  in [Opt]
p forall a. [a] -> [a] -> [a]
++ forall a. (a -> Bool) -> [a] -> [a]
filter (\(String
k,String
_) -> String
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
x) [Opt]
q

-- | Process argument list.
opt_proc :: [OptUsr] -> [String] -> ([Opt], [String])
opt_proc :: [OptUsr] -> [String] -> ([Opt], [String])
opt_proc [OptUsr]
def [String]
arg =
  let ([Opt]
o,[String]
a) = [String] -> ([Opt], [String])
opt_set_parse [String]
arg
  in ([Opt] -> [Opt] -> [Opt]
opt_merge [Opt]
o (forall a b. (a -> b) -> [a] -> [b]
map OptUsr -> Opt
opt_plain [OptUsr]
def),[String]
a)

-- | Usage text
type OptHelp = [String]

-- | Format usage pre-amble and 'opt_help'.
opt_help_pp :: OptHelp -> [OptUsr] -> String
opt_help_pp :: [String] -> [OptUsr] -> String
opt_help_pp [String]
usg [OptUsr]
def = [String] -> String
unlines ([String]
usg forall a. [a] -> [a] -> [a]
++ [String
"",[OptUsr] -> String
opt_help [OptUsr]
def])

-- | Print help and exit.
opt_usage :: OptHelp -> [OptUsr] -> IO ()
opt_usage :: [String] -> [OptUsr] -> IO ()
opt_usage [String]
usg [OptUsr]
def = String -> IO ()
putStrLn ([String] -> [OptUsr] -> String
opt_help_pp [String]
usg [OptUsr]
def)  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. ExitCode -> IO a
exitWith ExitCode
ExitSuccess

-- | Print help and error.
opt_error :: OptHelp -> [OptUsr] -> t
opt_error :: forall t. [String] -> [OptUsr] -> t
opt_error [String]
usg [OptUsr]
def = forall a. HasCallStack => String -> a
error ([String] -> [OptUsr] -> String
opt_help_pp [String]
usg [OptUsr]
def)

-- | Verify that all Opt have keys that are in OptUsr
opt_verify :: OptHelp -> [OptUsr] -> [Opt] -> IO ()
opt_verify :: [String] -> [OptUsr] -> [Opt] -> IO ()
opt_verify [String]
usg [OptUsr]
def =
  let k_set :: [String]
k_set = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. OptUsr -> Opt
opt_plain) [OptUsr]
def
      f :: (String, b) -> IO ()
f (String
k,b
_) = if String
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
k_set
                then forall (m :: * -> *) a. Monad m => a -> m a
return ()
                else String -> IO ()
putStrLn (String
"Unknown Key: " forall a. [a] -> [a] -> [a]
++ String
k forall a. [a] -> [a] -> [a]
++ String
"\n") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [String] -> [OptUsr] -> IO ()
opt_usage [String]
usg [OptUsr]
def
  in forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall {b}. (String, b) -> IO ()
f

-- | 'opt_set_parse' and maybe 'opt_verify' and 'opt_merge' of 'getArgs'.
--   If arguments include -h or --help run 'opt_usage'
opt_get_arg :: Bool -> OptHelp -> [OptUsr] -> IO ([Opt],[String])
opt_get_arg :: Bool -> [String] -> [OptUsr] -> IO ([Opt], [String])
opt_get_arg Bool
chk [String]
usg [OptUsr]
def = do
  [String]
a <- IO [String]
getArgs
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
"-h" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
a Bool -> Bool -> Bool
|| String
"--help" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
a) ([String] -> [OptUsr] -> IO ()
opt_usage [String]
usg [OptUsr]
def)
  let ([Opt]
o,[String]
p) = [String] -> ([Opt], [String])
opt_set_parse [String]
a
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
chk ([String] -> [OptUsr] -> [Opt] -> IO ()
opt_verify [String]
usg [OptUsr]
def [Opt]
o)
  forall (m :: * -> *) a. Monad m => a -> m a
return ([Opt] -> [Opt] -> [Opt]
opt_merge [Opt]
o (forall a b. (a -> b) -> [a] -> [b]
map OptUsr -> Opt
opt_plain [OptUsr]
def),[String]
p)

-- | Parse param set, one parameter per line.
--
-- > opt_param_set_parse "a\nb=c" == [("a","True"),("b","c")]
opt_param_set_parse :: String -> [Opt]
opt_param_set_parse :: String -> [Opt]
opt_param_set_parse = forall a b. (a -> b) -> [a] -> [b]
map String -> Opt
opt_param_parse forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines

-- | Simple scanner over argument list.
opt_scan :: [String] -> String -> Maybe String
opt_scan :: [String] -> String -> Maybe String
opt_scan [String]
a String
k =
  let ([Opt]
o,[String]
_) = [String] -> ([Opt], [String])
opt_set_parse [String]
a
  in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
== String
k) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [Opt]
o)

-- | Scanner with default value.
opt_scan_def :: [String] -> (String,String) -> String
opt_scan_def :: [String] -> Opt -> String
opt_scan_def [String]
a (String
k,String
v) = forall a. a -> Maybe a -> a
fromMaybe String
v ([String] -> String -> Maybe String
opt_scan [String]
a String
k)

-- | Reading scanner with default value.
opt_scan_read :: Read t => [String] -> (String,t) -> t
opt_scan_read :: forall t. Read t => [String] -> (String, t) -> t
opt_scan_read [String]
a (String
k,t
v) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe t
v forall a. Read a => String -> a
read ([String] -> String -> Maybe String
opt_scan [String]
a String
k)