    {-# LANGUAGE ScopedTypeVariables #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  GHC.ResponseFile
    -- License     :  BSD-style (see the file LICENSE)
    --
    -- Maintainer  :  libraries@haskell.org
    -- Stability   :  internal
    -- Portability :  portable
    --
    -- GCC style response files.
    --
    -- @since 4.12.0.0
    ----------------------------------------------------------------------------

    -- Migrated from Haddock.

    module GHC.ResponseFile (
        getArgsWithResponseFiles,
        unescapeArgs,
        escapeArgs,
        expandResponse
      ) where

    import Control.Exception
    import Data.Char          (isSpace)
    import Data.Foldable      (foldl')
    import System.Environment (getArgs)
    import System.Exit        (exitFailure)
    import System.IO

    {-|
    Like 'getArgs', but can also read arguments supplied via response files.

    For example, consider a program @foo@:

    @
    main :: IO ()
    main = do
      args <- getArgsWithResponseFiles
      putStrLn (show args)
    @

    And a response file @args.txt@:

    @
    --one 1
    --\'two\' 2
    --"three" 3
    @

    Then the result of invoking @foo@ with @args.txt@ is:

    > > ./foo @args.txt
    > ["--one","1","--two","2","--three","3"]

    -}
    getArgsWithResponseFiles :: IO [String]
    getArgsWithResponseFiles :: IO [String]
    getArgsWithResponseFiles = IO [String]
    getArgs IO [String] -> ([String] -> IO [String]) -> IO [String]
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= [String] -> IO [String]
    expandResponse

    -- | Given a string of concatenated strings, separate each by removing
    -- a layer of /quoting/ and\/or /escaping/ of certain characters.
    --
    -- These characters are: any whitespace, single quote, double quote,
    -- and the backslash character.  The backslash character always
    -- escapes (i.e., passes through without further consideration) the
    -- character which follows.  Characters can also be escaped in blocks
    -- by quoting (i.e., surrounding the blocks with matching pairs of
    -- either single- or double-quotes which are not themselves escaped).
    --
    -- Any whitespace which appears outside of either of the quoting and
    -- escaping mechanisms, is interpreted as having been added by this
    -- special concatenation process to designate where the boundaries
    -- are between the original, un-concatenated list of strings.  These
    -- added whitespace characters are removed from the output.
    --
    -- > unescapeArgs "hello\\ \\\"world\\\"\n" == escapeArgs "hello \"world\""
    unescapeArgs :: String -> [String]
    unescapeArgs :: String -> [String]
    unescapeArgs = (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null) ([String] -> [String])
    -> (String -> [String]) -> String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    unescape

    -- | Given a list of strings, concatenate them into a single string
    -- with escaping of certain characters, and the addition of a newline
    -- between each string.  The escaping is done by adding a single
    -- backslash character before any whitespace, single quote, double
    -- quote, or backslash character, so this escaping character must be
    -- removed.  Unescaped whitespace (in this case, newline) is part
    -- of this "transport" format to indicate the end of the previous
    -- string and the start of a new string.
    --
    -- While 'unescapeArgs' allows using quoting (i.e., convenient
    -- escaping of many characters) by having matching sets of single- or
    -- double-quotes,'escapeArgs' does not use the quoting mechasnism,
    -- and thus will always escape any whitespace, quotes, and
    -- backslashes.
    --
    -- > unescapeArgs "hello\\ \\\"world\\\"\\n" == escapeArgs "hello \"world\""
    escapeArgs :: [String] -> String
    escapeArgs :: [String] -> String
    escapeArgs = [String] -> String
    unlines ([String] -> String)
    -> ([String] -> [String]) -> [String] -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> String
    escapeArg

    -- | Arguments which look like @\@foo@ will be replaced with the
    -- contents of file @foo@. A gcc-like syntax for response files arguments
    -- is expected.  This must re-constitute the argument list by doing an
    -- inverse of the escaping mechanism done by the calling-program side.
    --
    -- We quit if the file is not found or reading somehow fails.
    -- (A convenience routine for haddock or possibly other clients)
    expandResponse :: [String] -> IO [String]
    expandResponse :: [String] -> IO [String]
    expandResponse = ([[String]] -> [String]) -> IO [[String]] -> IO [String]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [[String]] -> [String]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat (IO [[String]] -> IO [String])
    -> ([String] -> IO [[String]]) -> [String] -> IO [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> IO [String]) -> [String] -> IO [[String]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM String -> IO [String]
    expand
      where
        expand :: String -> IO [String]
        expand :: String -> IO [String]
    expand (Char
    '@':String
    f) = String -> IO String
    readFileExc String
    f IO String -> (String -> IO [String]) -> IO [String]
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= [String] -> IO [String]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([String] -> IO [String])
    -> (String -> [String]) -> String -> IO [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    unescapeArgs
        expand String
    x = [String] -> IO [String]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [String
    x]

        readFileExc :: String -> IO String
    readFileExc String
    f =
          String -> IO String
    readFile String
    f IO String -> (IOException -> IO String) -> IO String
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `catch` \(IOException
    e :: IOException) -> do
            Handle -> String -> IO ()
    hPutStrLn Handle
    stderr (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Error while expanding response file: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ IOException -> String
    forall a. Show a => a -> String
    show IOException
    e
            IO String
    forall a. IO a
    exitFailure

    data Quoting = NoneQ | SngQ | DblQ

    unescape :: String -> [String]
    unescape :: String -> [String]
    unescape String
    args = [String] -> [String]
    forall a. [a] -> [a]
    reverse ([String] -> [String])
    -> ([String] -> [String]) -> [String] -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> String
    forall a. [a] -> [a]
    reverse ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ String -> Quoting -> Bool -> String -> [String] -> [String]
    go String
    args Quoting
    NoneQ Bool
    False [] []
        where
          -- n.b., the order of these cases matters; these are cribbed from gcc
          -- case 1: end of input
          go :: String -> Quoting -> Bool -> String -> [String] -> [String]
    go []     Quoting
    _q    Bool
    _bs   String
    a [String]
    as = String
    aString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    as
          -- case 2: back-slash escape in progress
          go (Char
    c:String
    cs) Quoting
    q     Bool
    True  String
    a [String]
    as = String -> Quoting -> Bool -> String -> [String] -> [String]
    go String
    cs Quoting
    q     Bool
    False (Char
    cChar -> String -> String
    forall a. a -> [a] -> [a]
    :String
    a) [String]
    as
          -- case 3: no back-slash escape in progress, but got a back-slash
          go (Char
    c:String
    cs) Quoting
    q     Bool
    False String
    a [String]
    as
            | Char
    '\\' Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    c              = String -> Quoting -> Bool -> String -> [String] -> [String]
    go String
    cs Quoting
    q     Bool
    True  String
    a     [String]
    as
          -- case 4: single-quote escaping in progress
          go (Char
    c:String
    cs) Quoting
    SngQ  Bool
    False String
    a [String]
    as
            | Char
    '\'' Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    c              = String -> Quoting -> Bool -> String -> [String] -> [String]
    go String
    cs Quoting
    NoneQ Bool
    False String
    a     [String]
    as
            | Bool
    otherwise              = String -> Quoting -> Bool -> String -> [String] -> [String]
    go String
    cs Quoting
    SngQ  Bool
    False (Char
    cChar -> String -> String
    forall a. a -> [a] -> [a]
    :String
    a) [String]
    as
          -- case 5: double-quote escaping in progress
          go (Char
    c:String
    cs) Quoting
    DblQ  Bool
    False String
    a [String]
    as
            | Char
    '"' Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    c               = String -> Quoting -> Bool -> String -> [String] -> [String]
    go String
    cs Quoting
    NoneQ Bool
    False String
    a     [String]
    as
            | Bool
    otherwise              = String -> Quoting -> Bool -> String -> [String] -> [String]
    go String
    cs Quoting
    DblQ  Bool
    False (Char
    cChar -> String -> String
    forall a. a -> [a] -> [a]
    :String
    a) [String]
    as
          -- case 6: no escaping is in progress
          go (Char
    c:String
    cs) Quoting
    NoneQ Bool
    False String
    a [String]
    as
            | Char -> Bool
    isSpace Char
    c              = String -> Quoting -> Bool -> String -> [String] -> [String]
    go String
    cs Quoting
    NoneQ Bool
    False []    (String
    aString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    as)
            | Char
    '\'' Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    c              = String -> Quoting -> Bool -> String -> [String] -> [String]
    go String
    cs Quoting
    SngQ  Bool
    False String
    a     [String]
    as
            | Char
    '"'  Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    c              = String -> Quoting -> Bool -> String -> [String] -> [String]
    go String
    cs Quoting
    DblQ  Bool
    False String
    a     [String]
    as
            | Bool
    otherwise              = String -> Quoting -> Bool -> String -> [String] -> [String]
    go String
    cs Quoting
    NoneQ Bool
    False (Char
    cChar -> String -> String
    forall a. a -> [a] -> [a]
    :String
    a) [String]
    as

    escapeArg :: String -> String
    escapeArg :: String -> String
    escapeArg = String -> String
    forall a. [a] -> [a]
    reverse (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> Char -> String) -> String -> String -> String
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' String -> Char -> String
    escape []

    escape :: String -> Char -> String
    escape :: String -> Char -> String
    escape String
    cs Char
    c
      |    Char -> Bool
    isSpace Char
    c
        Bool -> Bool -> Bool
    || Char
    '\\' Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    c
        Bool -> Bool -> Bool
    || Char
    '\'' Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    c
        Bool -> Bool -> Bool
    || Char
    '"'  Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    c = Char
    cChar -> String -> String
    forall a. a -> [a] -> [a]
    :Char
    '\\'Char -> String -> String
    forall a. a -> [a] -> [a]
    :String
    cs -- n.b., our caller must reverse the result
      | Bool
    otherwise    = Char
    cChar -> String -> String
    forall a. a -> [a] -> [a]
    :String
    cs