-- | Shell quoting

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Control.Monad.Shell.Quote (
	Quoted(..),
	Quotable(..),
	Val(..),
) where

import qualified Data.Text.Lazy as L
import Data.String
import Data.Char

-- | A value that is safely quoted so that it can be exposed to the shell.
--
-- While the constructor is exposed, you should avoid directly constucting
-- Quoted values. Instead, use 'quote'.
newtype Quoted a = Q { Quoted a -> a
getQ :: a }
	deriving (Quoted a -> Quoted a -> Bool
(Quoted a -> Quoted a -> Bool)
-> (Quoted a -> Quoted a -> Bool) -> Eq (Quoted a)
forall a. Eq a => Quoted a -> Quoted a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Quoted a -> Quoted a -> Bool
$c/= :: forall a. Eq a => Quoted a -> Quoted a -> Bool
== :: Quoted a -> Quoted a -> Bool
$c== :: forall a. Eq a => Quoted a -> Quoted a -> Bool
Eq, Eq (Quoted a)
Eq (Quoted a)
-> (Quoted a -> Quoted a -> Ordering)
-> (Quoted a -> Quoted a -> Bool)
-> (Quoted a -> Quoted a -> Bool)
-> (Quoted a -> Quoted a -> Bool)
-> (Quoted a -> Quoted a -> Bool)
-> (Quoted a -> Quoted a -> Quoted a)
-> (Quoted a -> Quoted a -> Quoted a)
-> Ord (Quoted a)
Quoted a -> Quoted a -> Bool
Quoted a -> Quoted a -> Ordering
Quoted a -> Quoted a -> Quoted a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Quoted a)
forall a. Ord a => Quoted a -> Quoted a -> Bool
forall a. Ord a => Quoted a -> Quoted a -> Ordering
forall a. Ord a => Quoted a -> Quoted a -> Quoted a
min :: Quoted a -> Quoted a -> Quoted a
$cmin :: forall a. Ord a => Quoted a -> Quoted a -> Quoted a
max :: Quoted a -> Quoted a -> Quoted a
$cmax :: forall a. Ord a => Quoted a -> Quoted a -> Quoted a
>= :: Quoted a -> Quoted a -> Bool
$c>= :: forall a. Ord a => Quoted a -> Quoted a -> Bool
> :: Quoted a -> Quoted a -> Bool
$c> :: forall a. Ord a => Quoted a -> Quoted a -> Bool
<= :: Quoted a -> Quoted a -> Bool
$c<= :: forall a. Ord a => Quoted a -> Quoted a -> Bool
< :: Quoted a -> Quoted a -> Bool
$c< :: forall a. Ord a => Quoted a -> Quoted a -> Bool
compare :: Quoted a -> Quoted a -> Ordering
$ccompare :: forall a. Ord a => Quoted a -> Quoted a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Quoted a)
Ord, Int -> Quoted a -> ShowS
[Quoted a] -> ShowS
Quoted a -> String
(Int -> Quoted a -> ShowS)
-> (Quoted a -> String) -> ([Quoted a] -> ShowS) -> Show (Quoted a)
forall a. Show a => Int -> Quoted a -> ShowS
forall a. Show a => [Quoted a] -> ShowS
forall a. Show a => Quoted a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Quoted a] -> ShowS
$cshowList :: forall a. Show a => [Quoted a] -> ShowS
show :: Quoted a -> String
$cshow :: forall a. Show a => Quoted a -> String
showsPrec :: Int -> Quoted a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Quoted a -> ShowS
Show, b -> Quoted a -> Quoted a
NonEmpty (Quoted a) -> Quoted a
Quoted a -> Quoted a -> Quoted a
(Quoted a -> Quoted a -> Quoted a)
-> (NonEmpty (Quoted a) -> Quoted a)
-> (forall b. Integral b => b -> Quoted a -> Quoted a)
-> Semigroup (Quoted a)
forall b. Integral b => b -> Quoted a -> Quoted a
forall a. Semigroup a => NonEmpty (Quoted a) -> Quoted a
forall a. Semigroup a => Quoted a -> Quoted a -> Quoted a
forall a b. (Semigroup a, Integral b) => b -> Quoted a -> Quoted a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Quoted a -> Quoted a
$cstimes :: forall a b. (Semigroup a, Integral b) => b -> Quoted a -> Quoted a
sconcat :: NonEmpty (Quoted a) -> Quoted a
$csconcat :: forall a. Semigroup a => NonEmpty (Quoted a) -> Quoted a
<> :: Quoted a -> Quoted a -> Quoted a
$c<> :: forall a. Semigroup a => Quoted a -> Quoted a -> Quoted a
Semigroup, Semigroup (Quoted a)
Quoted a
Semigroup (Quoted a)
-> Quoted a
-> (Quoted a -> Quoted a -> Quoted a)
-> ([Quoted a] -> Quoted a)
-> Monoid (Quoted a)
[Quoted a] -> Quoted a
Quoted a -> Quoted a -> Quoted a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. Monoid a => Semigroup (Quoted a)
forall a. Monoid a => Quoted a
forall a. Monoid a => [Quoted a] -> Quoted a
forall a. Monoid a => Quoted a -> Quoted a -> Quoted a
mconcat :: [Quoted a] -> Quoted a
$cmconcat :: forall a. Monoid a => [Quoted a] -> Quoted a
mappend :: Quoted a -> Quoted a -> Quoted a
$cmappend :: forall a. Monoid a => Quoted a -> Quoted a -> Quoted a
mempty :: Quoted a
$cmempty :: forall a. Monoid a => Quoted a
$cp1Monoid :: forall a. Monoid a => Semigroup (Quoted a)
Monoid)

-- | Quotes a value to allow it to be safely exposed to the shell.
--
-- The method used is to replace ' with '"'"' and wrap the value inside
-- single quotes. This works for POSIX shells, as well as other shells
-- like csh.
--
-- The single quotes are omitted for simple values that do not need
-- any quoting.
class Quotable t where
	quote :: t -> Quoted L.Text

instance Quotable L.Text where
	quote :: Text -> Quoted Text
quote Text
t
		| (Char -> Bool) -> Text -> Bool
L.all Char -> Bool
bareable Text
t Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
L.any Char -> Bool
bareable Text
t = Text -> Quoted Text
forall a. a -> Quoted a
Q Text
t
		| Bool
otherwise = Text -> Quoted Text
forall a. a -> Quoted a
Q (Text -> Quoted Text) -> Text -> Quoted Text
forall a b. (a -> b) -> a -> b
$ Text
q Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
L.intercalate Text
"'\"'\"'" (Text -> Text -> [Text]
L.splitOn Text
q Text
t) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
q
	  where
		q :: Text
q = Text
"'"
		bareable :: Char -> Bool
bareable Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'

instance Quotable String where
	quote :: String -> Quoted Text
quote = Text -> Quoted Text
forall t. Quotable t => t -> Quoted Text
quote (Text -> Quoted Text) -> (String -> Text) -> String -> Quoted Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
L.pack

instance (Show v) => Quotable (Val v) where
	quote :: Val v -> Quoted Text
quote (Val v
v) = String -> Quoted Text
forall t. Quotable t => t -> Quoted Text
quote (String -> Quoted Text) -> String -> Quoted Text
forall a b. (a -> b) -> a -> b
$ v -> String
forall a. Show a => a -> String
show v
v

-- To avoid double-quoting Text and String, override the above instance.
-- This needs OverlappingInstances
instance Quotable (Val L.Text) where
	quote :: Val Text -> Quoted Text
quote (Val Text
s) = Text -> Quoted Text
forall t. Quotable t => t -> Quoted Text
quote Text
s
instance Quotable (Val String) where
	quote :: Val String -> Quoted Text
quote (Val String
s) = String -> Quoted Text
forall t. Quotable t => t -> Quoted Text
quote String
s

-- | An arbitrary value.
newtype Val v = Val v

instance IsString (Quoted L.Text) where
	fromString :: String -> Quoted Text
fromString = String -> Quoted Text
forall t. Quotable t => t -> Quoted Text
quote