Args.hs

{-# LANGUAGE TypeSynonymInstances #-}

-- | Functions for working with command line arguments and options.
module System.Build.Args(
                          quote,
                          (~~),
                          (~:),
                          (~?),
                          param,
                          many,
                          manys,
                          (~~~>),
                          (~~>),
                          (-~>),
                          (^^^),
                          space,
                          searchPath,
                          tryEnvs,
                          ArgShow(..)
                        ) where

import Control.Monad
import Data.List
import qualified Data.Map as M
import System.Environment
import System.FilePath

class ArgShow a where
  arg :: a -> String

instance ArgShow String where
  arg = id

instance ArgShow Int where
  arg = show

-- | Surrounds the given string in double-quotes and escapes any already there.
quote :: String
         -> String
quote s = '"' : (s >>= \x -> if x == '"' then "\\\"" else [x]) ++ "\""

-- | An empty list if the boolean is @False@ otherwise the given string value with @'-'@ prepended.
(~~) :: String
        -> Bool
        -> String
g ~~ k = if k then '-' : g else []

-- | If the given list of file paths is empty, then returns the empty list. Otherwise prepend @'-'@ to the string followed by @' '@ then the search path separator intercalated in the list of file paths.
--
-- > Posix
-- > "123" ~?? ["abc", "def"] == "-123 \"abc\":\"def\""
-- > "123" ~?? ["abc", "def", "ghi"] == "-123 \"abc\":\"def\":\"ghi\""
(~:) :: String
        -> [FilePath]
        -> String
_ ~: [] = []
s ~: z = '-' : s ++ ' ' : [searchPathSeparator] >===< z

-- | If the given value is @Nothing@ return the empty list, otherwise run the given function.
(~?) :: (k -> [a])
        -> Maybe k
        -> [a]
(~?) = maybe []

-- | If the given value is @Nothing@ return the empty list, otherwise prepend @'-'@ to the given string followed by the given character followed by surrounding the result of running the given function in double-quotes.
--
-- > param "abc" 'x' id (Just "tuv") == "-abcx\"tuv\""
-- > param "abc" 'x' id Nothing == ""
param :: String
         -> Char
         -> (k -> String)
         -> Maybe k
         -> String
param k c s = (~?) (\z -> '-' : k ++ c : quote (s z))

-- | A parameter with many values interspersed by @' '@.
--
-- > many "abc" ["tuv", "wxy"] == "-abc \"tuv\" -abc \"wxy\""
many :: String
        -> [String]
        -> String
many k v = intercalate " " $ map (k ~~~>) v

-- | A parameter with many values interspersed by @' '@.
--
-- > manys id "abc" ["tuv", "wxy"] == "-abc \"tuv\" -abc \"wxy\""
manys :: (a -> String)
         -> String
         -> [a]
         -> String
manys f k = many k . map f

-- | Prepends @'-'@ followed by the first value then @' '@ then the second value surrounded by double-quotes.
--
-- > "abc" ~~~> "def" == "-abc \"def\""
(~~~>) :: String
          -> String
          -> String
(~~~>) = (. Just) . (~~>)

-- | If the given value is @Nothing@ return the empty list, otherwise prepend @'-'@ followed by the first value then @' '@ followed by surrounding the result of running the given function in double-quotes.
--
-- > "abc" ~~> Just "def" == "-abc \"def\""
-- > "abc" ~~> Nothing == ""
(~~>) :: (ArgShow k) =>
         String
         -> Maybe k
         -> String
(~~>) k = param k ' ' arg

-- | If the given value is @Nothing@ return the empty list, otherwise prepend @'-'@ followed by the first value then @':'@ followed by surrounding the result of @show@ in double-quotes.
--
-- > "abc" ~~> Just "def" == "-abc:\"def\""
-- > "abc" ~~> Nothing == ""
(-~>) :: (ArgShow k) =>
         String
         -> Maybe k
         -> String
(-~>) k = param k ':' arg

-- | Removes all empty lists from the first argument the intercalates the second argument.
--
-- > ["abc", "", "def"] ^^^ "x" == "abcxdef"
(^^^) :: [[a]]
         -> [a]
         -> [a]
g ^^^ t = Data.List.intercalate t (filter (not . null) g)

-- | Surrounds each given value in double-quotes then intercalates @' '@.
--
-- > space ["abc", "def"] == "\"abc\" \"def\""
space :: [String]
         -> String
space = (>===<) " "

-- | Surrounds each given value in double-quotes then intercalates @[searchPathSeparator]@.
--
-- > searchPath ["abc", "def"] == "\"abc\":\"def\""
searchPath :: [String]
              -> String
searchPath = (>===<) [searchPathSeparator]

-- | Look up the given environment variables. The first one found that exists has its associated function called to produce a value.
tryEnvs :: [(String, String -> a)]
           -> IO (Maybe a)
tryEnvs es = do e <- getEnvironment
                let k [] = Nothing
                    k ((a, b):t) = fmap b (a `M.lookup` M.fromList e) `mplus` k t
                return (k es)


-- not exported

(>===<) :: String -> [String] -> String
s >===< k = intercalate s (fmap quote k)