{-# LANGUAGE NamedFieldPuns #-}

module ShellWords.Quote
  ( -- * Quoting for shells
    quote
  , join
  ) where

import Prelude

-- | How to escape a `String` for @sh(1)@.
data EscapeStyle
  = -- | No escaping.
    NoEscaping
  | -- | Wrapped in single quotes.
    SingleQuoted
  | -- | Wrapped in single quotes
    Mixed

-- | Internal state for `escapeStyle`.
data EscapeStyleState
  = EscapeStyleState
  { EscapeStyleState -> Bool
hasSpecial :: Bool
  , EscapeStyleState -> Bool
hasNewline :: Bool
  , EscapeStyleState -> Bool
hasSingleQuote :: Bool
  }

-- | Determine how to escape a `String`.
escapeStyle :: String -> EscapeStyle
escapeStyle :: String -> EscapeStyle
escapeStyle String
"" = EscapeStyle
SingleQuoted
escapeStyle String
str =
  let
    isOtherSpecial :: Char -> Bool
    isOtherSpecial :: Char -> Bool
isOtherSpecial Char
c = Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"|&;<>()$`\\\" \t*?[#~=%" :: String)

    helper :: EscapeStyleState -> String -> EscapeStyle
    helper :: EscapeStyleState -> String -> EscapeStyle
helper EscapeStyleState
state (Char
c : String
s)
      | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' = EscapeStyleState -> String -> EscapeStyle
helper EscapeStyleState
state {hasNewline = True, hasSpecial = True} String
s
      | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'' = EscapeStyleState -> String -> EscapeStyle
helper EscapeStyleState
state {hasSingleQuote = True, hasSpecial = True} String
s
      | Char -> Bool
isOtherSpecial Char
c = EscapeStyleState -> String -> EscapeStyle
helper EscapeStyleState
state {hasSpecial = True} String
s
      | Bool
otherwise = EscapeStyleState -> String -> EscapeStyle
helper EscapeStyleState
state String
s
    helper EscapeStyleState {Bool
hasSpecial :: EscapeStyleState -> Bool
hasSpecial :: Bool
hasSpecial, Bool
hasNewline :: EscapeStyleState -> Bool
hasNewline :: Bool
hasNewline, Bool
hasSingleQuote :: EscapeStyleState -> Bool
hasSingleQuote :: Bool
hasSingleQuote} []
      | Bool -> Bool
not Bool
hasSpecial = EscapeStyle
NoEscaping
      | Bool
hasNewline Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
hasSingleQuote = EscapeStyle
SingleQuoted
      | Bool
otherwise = EscapeStyle
Mixed
  in
    EscapeStyleState -> String -> EscapeStyle
helper
      EscapeStyleState
        { hasSpecial :: Bool
hasSpecial = Bool
False
        , hasNewline :: Bool
hasNewline = Bool
False
        , hasSingleQuote :: Bool
hasSingleQuote = Bool
False
        }
      String
str

-- | Escape special characters in a string, so that it will retain its literal
-- meaning when used as a part of command in a Unix shell.
--
-- It tries to avoid introducing any unnecessary quotes or escape characters,
-- but specifics regarding quoting style are left unspecified.
quote :: String -> String
quote :: String -> String
quote String
str =
  case String -> EscapeStyle
escapeStyle String
str of
    EscapeStyle
NoEscaping -> String
str
    EscapeStyle
SingleQuoted -> String
"'" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
str String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"'"
    EscapeStyle
Mixed ->
      let
        quoteMixed :: String -> String
        quoteMixed :: String -> String
quoteMixed [] = []
        quoteMixed (Char
'\'' : String
s) = String
"'\\''" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
quoteMixed String
s
        quoteMixed (Char
c : String
s) = Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
quoteMixed String
s
      in
        String
"'" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
quoteMixed String
str String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"'"

-- | Joins arguments into a single command line suitable for execution in a Unix shell.
--
-- Each argument is quoted using `quote` to preserve its literal meaning when
-- parsed by Unix shell.
--
-- Note: This function is essentially an (infallible) inverse of `parse`.
join :: [String] -> String
join :: [String] -> String
join = [String] -> String
unwords ([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
quote