-- | This is a shell monad, for generating shell scripts.
--
-- The emphasis is on generating shell code that will work in any POSIX
-- compliant shell and avoids many common shell pitfalls, including
-- insufficient quoting, while allowing the Haskell type checker to be
-- leveraged for additional safety.
--
-- Here is a hello world example.
--
-- > {-# LANGUAGE OverloadedStrings, ExtendedDefaultRules #-}
-- > import Control.Monad.Shell
-- > import Data.Monoid
-- > import qualified Data.Text.Lazy as T
-- > import qualified Data.Text.Lazy.IO as T
-- > default (T.Text)
-- > 
-- > main :: IO ()
-- > main = T.writeFile "hello.sh" $ script $ do
-- > 	cmd "echo" "hello, world"
-- > 	username <- newVarFrom (Output (cmd "whoami")) ()
-- > 	cmd "echo" "from" (WithVar username (<> "'s shell"))
--
-- When run, that generates this shell code:
-- 
-- > #!/bin/sh
-- > echo 'hello, world'
-- > _v="$(whoami)"
-- > echo from "$_v"''"'"'s shell'
--
-- There are several other examples shipped in the examples/ directory
-- of the shell-monad package. For example, protocol.hs shows how 
-- shell-monad can be used to implement a shell script that speaks a
-- protocol that is defined using Haskell data types.

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE EmptyDataDecls #-}

module Control.Monad.Shell (
	-- * Core
	Script,
	script,
	linearScript,
	Term,
	Var,
	Static,
	Quoted,
	Quotable(..),
	glob,
	-- * Running commands
	run,
	cmd,
	Param,
	CmdParams,
	Output(..),
	-- * Shell variables
	NamedLike(..),
	NameHinted,
	static,
	newVar,
	newVarFrom,
	newVarContaining,
	setVar,
	globalVar,
	positionalParameters,
	takeParameter,
	defaultVar,
	whenVar,
	lengthVar,
	trimVar,
	Greediness(..),
	Direction(..),
	WithVar(..),
	-- * Monadic combinators
	func,
	forCmd,
	whileCmd,
	ifCmd,
	whenCmd,
	unlessCmd,
	caseOf,
	subshell,
	group,
	withEnv,
	(-|-),
	(-&&-),
	(-||-),
	-- * Redirection
	RedirFile,
	(|>),
	(|>>),
	(|<),
	toStderr,
	(>&),
	(<&),
	(&),
	hereDocument,
	-- * Error handling
	stopOnFailure,
	ignoreFailure,
	errUnlessVar,
	-- * Tests
	test,
	Test(..),
	-- * Shell Arithmetic Expressions
	val,
	Arith(..),
	-- * Misc
	comment,
	readVar,
) where

import qualified Data.Text.Lazy as L
import qualified Data.Set as S
import Data.Char
import System.Posix.Types (Fd)
import System.Posix.IO (stdInput, stdOutput, stdError)

import Control.Monad.Shell.Quote

-- | A term that can be expanded in a shell command line.
data Term t a where
	VarTerm :: UntypedVar -> Term Var a
	StaticTerm :: (Quotable (Val a)) => a -> Term Static a

-- | Used to represent a shell variable.
data Var
-- | Used for a static value.
data Static

data UntypedVar = V
	{ UntypedVar -> VarName
varName :: VarName
	, UntypedVar -> Env -> VarName -> Quoted Text
expandVar :: Env -> VarName -> Quoted L.Text
	}

newtype VarName = VarName L.Text
	deriving (VarName -> VarName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VarName -> VarName -> Bool
$c/= :: VarName -> VarName -> Bool
== :: VarName -> VarName -> Bool
$c== :: VarName -> VarName -> Bool
Eq, Eq VarName
VarName -> VarName -> Bool
VarName -> VarName -> Ordering
VarName -> VarName -> VarName
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
min :: VarName -> VarName -> VarName
$cmin :: VarName -> VarName -> VarName
max :: VarName -> VarName -> VarName
$cmax :: VarName -> VarName -> VarName
>= :: VarName -> VarName -> Bool
$c>= :: VarName -> VarName -> Bool
> :: VarName -> VarName -> Bool
$c> :: VarName -> VarName -> Bool
<= :: VarName -> VarName -> Bool
$c<= :: VarName -> VarName -> Bool
< :: VarName -> VarName -> Bool
$c< :: VarName -> VarName -> Bool
compare :: VarName -> VarName -> Ordering
$ccompare :: VarName -> VarName -> Ordering
Ord, Indent -> VarName -> ShowS
[VarName] -> ShowS
VarName -> String
forall a.
(Indent -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VarName] -> ShowS
$cshowList :: [VarName] -> ShowS
show :: VarName -> String
$cshow :: VarName -> String
showsPrec :: Indent -> VarName -> ShowS
$cshowsPrec :: Indent -> VarName -> ShowS
Show)

simpleVar :: forall a. VarName -> Term Var a
simpleVar :: forall a. VarName -> Term Var a
simpleVar = forall a. UntypedVar -> Term Var a
VarTerm forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarName -> UntypedVar
simpleVar'

simpleVar' :: VarName -> UntypedVar
simpleVar' :: VarName -> UntypedVar
simpleVar' VarName
name = V
	{ varName :: VarName
varName = VarName
name
	-- Used to expand the variable; can be overridden for other
	-- types of variable expansion.
	--
	-- It's important that the shell code this generates never
	-- contain any quotes. That would prevent it from being nested
	-- inside an arithmatic expression.
	, expandVar :: Env -> VarName -> Quoted Text
expandVar = \Env
_ (VarName Text
n) -> forall a. a -> Quoted a
Q (Text
"$" forall a. Semigroup a => a -> a -> a
<> Text
n)
	}

-- | Treats the Text as a glob.
--
-- When used as a 'Param' to a command, it expands to one parameter per
-- matching file.
--
-- > forCmd (cmd "ls" (glob "*/*.cabal")) $ \file ->
-- >     cmd "echo" file
--
-- When used in a 'caseOf', it matches text against the glob.
--
-- The input is assumed to be a well-formed glob. Characters in it that
-- are not alphanumeric and are not wildcard characters will be escaped
-- before it is exposed to the shell. This allows eg, spaces in globs.
glob :: L.Text -> Quoted L.Text
glob :: Text -> Quoted Text
glob = forall a. a -> Quoted a
Q forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Text) -> Text -> Text
L.concatMap Char -> Text
escape
  where
	escape :: Char -> Text
escape Char
c
		| Char -> Bool
isAlphaNum Char
c = Char -> Text
L.singleton Char
c
		| Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"*?[!-:]\\" :: String) = Char -> Text
L.singleton Char
c
		| Bool
otherwise = Text
"\\" forall a. Semigroup a => a -> a -> a
<> Char -> Text
L.singleton Char
c

-- | A shell function.
newtype Func = Func L.Text
	deriving (Func -> Func -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Func -> Func -> Bool
$c/= :: Func -> Func -> Bool
== :: Func -> Func -> Bool
$c== :: Func -> Func -> Bool
Eq, Eq Func
Func -> Func -> Bool
Func -> Func -> Ordering
Func -> Func -> Func
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
min :: Func -> Func -> Func
$cmin :: Func -> Func -> Func
max :: Func -> Func -> Func
$cmax :: Func -> Func -> Func
>= :: Func -> Func -> Bool
$c>= :: Func -> Func -> Bool
> :: Func -> Func -> Bool
$c> :: Func -> Func -> Bool
<= :: Func -> Func -> Bool
$c<= :: Func -> Func -> Bool
< :: Func -> Func -> Bool
$c< :: Func -> Func -> Bool
compare :: Func -> Func -> Ordering
$ccompare :: Func -> Func -> Ordering
Ord, Indent -> Func -> ShowS
[Func] -> ShowS
Func -> String
forall a.
(Indent -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Func] -> ShowS
$cshowList :: [Func] -> ShowS
show :: Func -> String
$cshow :: Func -> String
showsPrec :: Indent -> Func -> ShowS
$cshowsPrec :: Indent -> Func -> ShowS
Show)

class Named t where
	getName :: t -> L.Text

instance Named (Term Var t) where
	getName :: Term Var t -> Text
getName (VarTerm UntypedVar
v) = forall t. Named t => t -> Text
getName UntypedVar
v

instance Named UntypedVar where
	getName :: UntypedVar -> Text
getName = forall t. Named t => t -> Text
getName forall b c a. (b -> c) -> (a -> b) -> a -> c
. UntypedVar -> VarName
varName

instance Named VarName where
	getName :: VarName -> Text
getName (VarName Text
n) = Text
n

instance Named Func where
	getName :: Func -> Text
getName (Func Text
n) = Text
n

type Indent = Int

type LocalEnv = (L.Text, L.Text)

-- | A shell expression.
data Expr
	= Cmd Indent [LocalEnv] L.Text
	-- ^ a command. may have a local environment to be added to it
	| Raw Indent L.Text
	-- ^ shell code that is not able to a have a local environment added to it
	| EnvWrap Indent L.Text [LocalEnv] [Expr]
	-- ^ named script with a local environment to add to it
	| Comment L.Text -- ^ a comment
	| Subshell L.Text [Expr] -- ^ expressions run in a sub-shell
	| Group L.Text [Expr] -- ^ expressions run in a group
	| Pipe Expr Expr -- ^ Piping the first Expr to the second Expr
	| And Expr Expr -- ^ &&
	| Or Expr Expr -- ^ ||
	| Redir Expr RedirSpec -- ^ Redirects a file handle of the Expr

-- | Indents an Expr
indent :: Expr -> Expr
indent :: Expr -> Expr
indent (Cmd Indent
i [LocalEnv]
localenvs Text
t) = Indent -> [LocalEnv] -> Text -> Expr
Cmd (Indent
i forall a. Num a => a -> a -> a
+ Indent
1) [LocalEnv]
localenvs Text
t
indent (Raw Indent
i Text
t) = Indent -> Text -> Expr
Raw (Indent
i forall a. Num a => a -> a -> a
+ Indent
1) Text
t
indent (EnvWrap Indent
i Text
n [LocalEnv]
localenvs [Expr]
e) = Indent -> Text -> [LocalEnv] -> [Expr] -> Expr
EnvWrap (Indent
i forall a. Num a => a -> a -> a
+ Indent
1) Text
n [LocalEnv]
localenvs (forall a b. (a -> b) -> [a] -> [b]
map Expr -> Expr
indent [Expr]
e)
indent (Comment Text
t) = Text -> Expr
Comment forall a b. (a -> b) -> a -> b
$ Text
"\t" forall a. Semigroup a => a -> a -> a
<> Text
t
indent (Subshell Text
i [Expr]
l) = Text -> [Expr] -> Expr
Subshell (Text
"\t" forall a. Semigroup a => a -> a -> a
<> Text
i) (forall a b. (a -> b) -> [a] -> [b]
map Expr -> Expr
indent [Expr]
l)
indent (Group Text
i [Expr]
l) = Text -> [Expr] -> Expr
Group (Text
"\t" forall a. Semigroup a => a -> a -> a
<> Text
i) (forall a b. (a -> b) -> [a] -> [b]
map Expr -> Expr
indent [Expr]
l)
indent (Pipe Expr
e1 Expr
e2) = Expr -> Expr -> Expr
Pipe (Expr -> Expr
indent Expr
e1) (Expr -> Expr
indent Expr
e2)
indent (Redir Expr
e RedirSpec
r) = Expr -> RedirSpec -> Expr
Redir (Expr -> Expr
indent Expr
e) RedirSpec
r
indent (And Expr
e1 Expr
e2) = Expr -> Expr -> Expr
And (Expr -> Expr
indent Expr
e1) (Expr -> Expr
indent Expr
e2)
indent (Or Expr
e1 Expr
e2) = Expr -> Expr -> Expr
Or (Expr -> Expr
indent Expr
e1) (Expr -> Expr
indent Expr
e2)

-- | Specifies a redirection.
data RedirSpec
	= RedirToFile Fd FilePath -- ^ redirect the fd to a file
	| RedirToFileAppend Fd FilePath -- ^ append to file
	| RedirFromFile Fd FilePath -- ^ use a file as input
	| RedirOutput Fd Fd -- ^ redirect first fd to the second
	| RedirInput Fd Fd -- ^ same, but for input fd
	| RedirHereDoc L.Text -- ^ use a here document as input

-- | Shell script monad.
newtype Script a = Script (Env -> ([Expr], Env, a))
	deriving (forall a b. a -> Script b -> Script a
forall a b. (a -> b) -> Script a -> Script b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Script b -> Script a
$c<$ :: forall a b. a -> Script b -> Script a
fmap :: forall a b. (a -> b) -> Script a -> Script b
$cfmap :: forall a b. (a -> b) -> Script a -> Script b
Functor)

instance Applicative Script where
	pure :: forall a. a -> Script a
pure a
a = forall a. (Env -> ([Expr], Env, a)) -> Script a
Script forall a b. (a -> b) -> a -> b
$ \Env
env -> ([], Env
env, a
a)
	Script Env -> ([Expr], Env, a -> b)
f <*> :: forall a b. Script (a -> b) -> Script a -> Script b
<*> Script Env -> ([Expr], Env, a)
a = forall a. (Env -> ([Expr], Env, a)) -> Script a
Script forall a b. (a -> b) -> a -> b
$ \Env
env0 ->
		let ([Expr]
expr1, Env
env1, a -> b
f') = Env -> ([Expr], Env, a -> b)
f Env
env0
		    ([Expr]
expr2, Env
env2, a
a') = Env -> ([Expr], Env, a)
a Env
env1
		in  ([Expr]
expr1 forall a. Semigroup a => a -> a -> a
<> [Expr]
expr2, Env
env2, a -> b
f' a
a')

instance Monad Script where
	Script a
a >>= :: forall a b. Script a -> (a -> Script b) -> Script b
>>= a -> Script b
b = forall a. (Env -> ([Expr], Env, a)) -> Script a
Script forall a b. (a -> b) -> a -> b
$ \Env
start -> let
		([Expr]
left, Env
mid, a
v) = forall f. Script f -> Env -> ([Expr], Env, f)
call Script a
a Env
start
		([Expr]
right, Env
end, b
ret) = forall f. Script f -> Env -> ([Expr], Env, f)
call (a -> Script b
b a
v) Env
mid
		in ([Expr]
left forall a. [a] -> [a] -> [a]
++ [Expr]
right, Env
end, b
ret)
	  where
		call :: Script f -> Env -> ([Expr], Env, f)
		call :: forall f. Script f -> Env -> ([Expr], Env, f)
call (Script Env -> ([Expr], Env, f)
f) = Env -> ([Expr], Env, f)
f

-- | Environment built up by the shell script monad,
-- so it knows which environment variables and functions are in use.
data Env = Env
	{ Env -> Set VarName
envVars :: S.Set VarName
	, Env -> Set Func
envFuncs :: S.Set Func
	}

instance Semigroup Env where
	<> :: Env -> Env -> Env
(<>) Env
a Env
b = Set VarName -> Set Func -> Env
Env (Env -> Set VarName
envVars Env
a forall a. Semigroup a => a -> a -> a
<> Env -> Set VarName
envVars Env
b) (Env -> Set Func
envFuncs Env
a forall a. Semigroup a => a -> a -> a
<> Env -> Set Func
envFuncs Env
b)

instance Monoid Env where
	mempty :: Env
mempty = Set VarName -> Set Func -> Env
Env forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty

getEnv :: Script Env
getEnv :: Script Env
getEnv = forall a. (Env -> ([Expr], Env, a)) -> Script a
Script forall a b. (a -> b) -> a -> b
$ \Env
env -> ([], Env
env, Env
env)

modifyEnvVars :: Env -> (S.Set VarName -> S.Set VarName) -> Env
modifyEnvVars :: Env -> (Set VarName -> Set VarName) -> Env
modifyEnvVars Env
env Set VarName -> Set VarName
f = Env
env { envVars :: Set VarName
envVars = Set VarName -> Set VarName
f (Env -> Set VarName
envVars Env
env) }

modifyEnvFuncs :: Env -> (S.Set Func -> S.Set Func) -> Env
modifyEnvFuncs :: Env -> (Set Func -> Set Func) -> Env
modifyEnvFuncs Env
env Set Func -> Set Func
f = Env
env { envFuncs :: Set Func
envFuncs = Set Func -> Set Func
f (Env -> Set Func
envFuncs Env
env) }

-- | Runs the monad and generates a list of Expr
gen :: Script f -> [Expr]
gen :: forall f. Script f -> [Expr]
gen = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. Env -> Script f -> ([Expr], Env)
runScript forall a. Monoid a => a
mempty

-- | Runs the monad, and returns a list of Expr and the modified
-- environment.
runScript :: Env -> Script f -> ([Expr], Env)
runScript :: forall f. Env -> Script f -> ([Expr], Env)
runScript Env
env (Script Env -> ([Expr], Env, f)
f) = ([Expr]
code, Env
env') where ([Expr]
code, Env
env', f
_) = Env -> ([Expr], Env, f)
f Env
env

-- | Runs the passed Script, using the current environment,
-- and returns the list of Expr it generates.
runM :: Script () -> Script [Expr]
runM :: Script () -> Script [Expr]
runM Script ()
s = forall a. (Env -> ([Expr], Env, a)) -> Script a
Script forall a b. (a -> b) -> a -> b
$ \Env
env -> 
	let ([Expr]
r, Env
env') = forall f. Env -> Script f -> ([Expr], Env)
runScript Env
env Script ()
s
	in ([], Env
env', [Expr]
r)

-- | Generates a shell script, including hashbang,
-- suitable to be written to a file.
script :: Script f -> L.Text
script :: forall f. Script f -> Text
script = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Monoid a => a -> a -> a
mappend Text
"\n" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
L.intercalate Text
"\n" forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
	(Text
"#!/bin/sh"forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Expr -> Text
fmt Bool
True) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. Script f -> [Expr]
gen

-- | Formats an Expr to shell  script.
--
-- Can generate either multiline or single line shell script.
fmt :: Bool -> Expr -> L.Text
fmt :: Bool -> Expr -> Text
fmt Bool
multiline = Expr -> Text
go
  where
	fmtlocalenvs :: [LocalEnv] -> Text
fmtlocalenvs = Text -> [Text] -> Text
L.intercalate Text
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\(Text
k, Text
v) -> Text
k forall a. Semigroup a => a -> a -> a
<> Text
"=" forall a. Semigroup a => a -> a -> a
<> Text
v)

	go :: Expr -> Text
go (Cmd Indent
i [] Text
t) = String -> Text
L.pack (forall a. Indent -> a -> [a]
replicate Indent
i Char
'\t') forall a. Semigroup a => a -> a -> a
<> Text
t
	go (Cmd Indent
i [LocalEnv]
localenvs Text
t) = String -> Text
L.pack (forall a. Indent -> a -> [a]
replicate Indent
i Char
'\t') forall a. Semigroup a => a -> a -> a
<> [LocalEnv] -> Text
fmtlocalenvs [LocalEnv]
localenvs forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
t
	go (Raw Indent
i Text
t) = String -> Text
L.pack (forall a. Indent -> a -> [a]
replicate Indent
i Char
'\t') forall a. Semigroup a => a -> a -> a
<> Text
t
	go (EnvWrap Indent
i Text
n [LocalEnv]
localenvs [Expr]
e) =
		let (Text
lp, Text
sep) = if Bool
multiline
			then (String -> Text
L.pack (forall a. Indent -> a -> [a]
replicate Indent
i Char
'\t'), Text
"\n")
			else (Text
"", Text
";")
		in Text
lp forall a. Semigroup a => a -> a -> a
<> Text
n forall a. Semigroup a => a -> a -> a
<> Text
"() { : " forall a. Semigroup a => a -> a -> a
<> Text
sep
		   forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
L.intercalate Text
sep (forall a b. (a -> b) -> [a] -> [b]
map (Expr -> Text
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Expr
indent) [Expr]
e) forall a. Semigroup a => a -> a -> a
<> Text
sep
		   forall a. Semigroup a => a -> a -> a
<> Text
lp forall a. Semigroup a => a -> a -> a
<> Text
"}" forall a. Semigroup a => a -> a -> a
<> Text
sep
		   forall a. Semigroup a => a -> a -> a
<> Text
lp forall a. Semigroup a => a -> a -> a
<> [LocalEnv] -> Text
fmtlocalenvs [LocalEnv]
localenvs forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
n
	-- Comments are represented using : for two reasons:
	-- 1. To support single line rendering.
	-- 2. So that it's a valid shell expression; any
	-- Expr, including Comment can be combined with any other.
	-- For example, Pipe Comment Comment.
	go (Comment Text
t) = Text
": " forall a. Semigroup a => a -> a -> a
<> forall a. Quoted a -> a
getQ (forall t. Quotable t => t -> Quoted Text
quote ((Char -> Bool) -> Text -> Text
L.filter (forall a. Eq a => a -> a -> Bool
/= Char
'\n') Text
t))
	go (Subshell Text
i []) = Text
i forall a. Semigroup a => a -> a -> a
<> Text
"( : )"
	go (Subshell Text
i [Expr]
l) =
		let (Text
wrap, Text
sep) = if Bool
multiline then (Text
"\n", Text
"\n") else (Text
"", Text
";")
		in Text
i forall a. Semigroup a => a -> a -> a
<> Text
"(" forall a. Semigroup a => a -> a -> a
<> Text
wrap forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
L.intercalate Text
sep (forall a b. (a -> b) -> [a] -> [b]
map (Expr -> Text
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Expr
indent) [Expr]
l) forall a. Semigroup a => a -> a -> a
<> Text
wrap forall a. Semigroup a => a -> a -> a
<> Text
i forall a. Semigroup a => a -> a -> a
<> Text
")"
	go (Group Text
i []) = Text
i forall a. Semigroup a => a -> a -> a
<> Text
"{ :; }"
	go (Group Text
i [Expr]
l) =
		let (Text
wrap, Text
sep, Text
end) = if Bool
multiline then (Text
"\n", Text
"\n", Text
"") else (Text
"", Text
";", Text
";")
		in Text
i forall a. Semigroup a => a -> a -> a
<> Text
"{" forall a. Semigroup a => a -> a -> a
<> Text
wrap forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
L.intercalate Text
sep (forall a b. (a -> b) -> [a] -> [b]
map (Expr -> Text
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Expr
indent) [Expr]
l) forall a. Semigroup a => a -> a -> a
<> Text
end forall a. Semigroup a => a -> a -> a
<> Text
wrap forall a. Semigroup a => a -> a -> a
<> Text
i forall a. Semigroup a => a -> a -> a
<> Text
"}"
	go (Pipe Expr
e1 Expr
e2) = Expr -> Text
go Expr
e1 forall a. Semigroup a => a -> a -> a
<> Text
" | " forall a. Semigroup a => a -> a -> a
<> Expr -> Text
go Expr
e2
	go (And Expr
e1 Expr
e2) = Expr -> Text
go Expr
e1 forall a. Semigroup a => a -> a -> a
<> Text
" && " forall a. Semigroup a => a -> a -> a
<> Expr -> Text
go Expr
e2
	go (Or Expr
e1 Expr
e2) = Expr -> Text
go Expr
e1 forall a. Semigroup a => a -> a -> a
<> Text
" || " forall a. Semigroup a => a -> a -> a
<> Expr -> Text
go Expr
e2
	go (Redir Expr
e RedirSpec
r) = let use :: Text -> Text
use Text
t = Expr -> Text
go Expr
e forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
t in case RedirSpec
r of
		(RedirToFile Fd
fd String
f) ->
			Text -> Text
use forall a b. (a -> b) -> a -> b
$ Fd -> Maybe Fd -> Text
redirFd Fd
fd (forall a. a -> Maybe a
Just Fd
stdOutput) forall a. Semigroup a => a -> a -> a
<> Text
"> " forall a. Semigroup a => a -> a -> a
<> forall a. Quoted a -> a
getQ (forall t. Quotable t => t -> Quoted Text
quote (String -> Text
L.pack String
f))
		(RedirToFileAppend Fd
fd String
f) ->
			Text -> Text
use forall a b. (a -> b) -> a -> b
$ Fd -> Maybe Fd -> Text
redirFd Fd
fd (forall a. a -> Maybe a
Just Fd
stdOutput) forall a. Semigroup a => a -> a -> a
<> Text
">> " forall a. Semigroup a => a -> a -> a
<> forall a. Quoted a -> a
getQ (forall t. Quotable t => t -> Quoted Text
quote (String -> Text
L.pack String
f))
		(RedirFromFile Fd
fd String
f) ->
			Text -> Text
use forall a b. (a -> b) -> a -> b
$ Fd -> Maybe Fd -> Text
redirFd Fd
fd (forall a. a -> Maybe a
Just Fd
stdInput) forall a. Semigroup a => a -> a -> a
<> Text
"< " forall a. Semigroup a => a -> a -> a
<> forall a. Quoted a -> a
getQ (forall t. Quotable t => t -> Quoted Text
quote (String -> Text
L.pack String
f))
		(RedirOutput Fd
fd1 Fd
fd2) ->
			Text -> Text
use forall a b. (a -> b) -> a -> b
$ Fd -> Maybe Fd -> Text
redirFd Fd
fd1 (forall a. a -> Maybe a
Just Fd
stdOutput) forall a. Semigroup a => a -> a -> a
<> Text
">&" forall a. Semigroup a => a -> a -> a
<> Fd -> Text
showFd Fd
fd2
		(RedirInput Fd
fd1 Fd
fd2) ->
			Text -> Text
use forall a b. (a -> b) -> a -> b
$ Fd -> Maybe Fd -> Text
redirFd Fd
fd1 (forall a. a -> Maybe a
Just Fd
stdInput) forall a. Semigroup a => a -> a -> a
<> Text
"<&" forall a. Semigroup a => a -> a -> a
<> Fd -> Text
showFd Fd
fd2
		(RedirHereDoc Text
t)
			| Bool
multiline -> 
				let myEOF :: Text
myEOF = Text -> Text
eofMarker Text
t
				in Text -> Text
use forall a b. (a -> b) -> a -> b
$ Text
"<<" forall a. Semigroup a => a -> a -> a
<> Text
myEOF forall a. Semigroup a => a -> a -> a
<> Text
"\n"
					forall a. Semigroup a => a -> a -> a
<> Text
t 
					forall a. Semigroup a => a -> a -> a
<> Text
"\n" 
					forall a. Semigroup a => a -> a -> a
<> Text
myEOF
			-- Here documents cannot be represented in a single
			-- line script. Instead, generate:
			-- (echo l1; echo l2; ...) | cmd
			| Bool
otherwise ->
				let heredoc :: Expr
heredoc = Text -> [Expr] -> Expr
Subshell Text
L.empty forall a b. (a -> b) -> a -> b
$
					forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map (Text -> [Text]
L.lines Text
t) forall a b. (a -> b) -> a -> b
$ \Text
l -> Text -> Expr
raw forall a b. (a -> b) -> a -> b
$ 
						Text
"echo " forall a. Semigroup a => a -> a -> a
<> forall a. Quoted a -> a
getQ (forall t. Quotable t => t -> Quoted Text
quote Text
l)
				in Expr -> Text
go (Expr -> Expr -> Expr
Pipe Expr
heredoc Expr
e)

-- | Displays a Fd for use in a redirection.
-- 
-- Redirections have a default Fd; for example, ">" defaults to redirecting
-- stdout. In this case, the file descriptor number does not need to be
-- included.
redirFd :: Fd -> Maybe Fd -> L.Text
redirFd :: Fd -> Maybe Fd -> Text
redirFd Fd
fd Maybe Fd
deffd
	| forall a. a -> Maybe a
Just Fd
fd forall a. Eq a => a -> a -> Bool
== Maybe Fd
deffd = Text
""
	| Bool
otherwise = Fd -> Text
showFd Fd
fd

showFd :: Fd -> L.Text
showFd :: Fd -> Text
showFd = String -> Text
L.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

-- | Finds an approriate marker to end a here document; the marker cannot
-- appear inside the text.
eofMarker :: L.Text -> L.Text
eofMarker :: Text -> Text
eofMarker Text
t = Integer -> Text
go (Integer
1 :: Integer)
  where
	go :: Integer -> Text
go Integer
n = let marker :: Text
marker = Text
"EOF" forall a. Semigroup a => a -> a -> a
<> if Integer
n forall a. Eq a => a -> a -> Bool
== Integer
1 then Text
"" else String -> Text
L.pack (forall a. Show a => a -> String
show Integer
n)
		in if Text
marker Text -> Text -> Bool
`L.isInfixOf` Text
t
			then Integer -> Text
go (forall a. Enum a => a -> a
succ Integer
n)
			else Text
marker

-- | Generates a single line of shell code.
linearScript :: Script f -> L.Text
linearScript :: forall f. Script f -> Text
linearScript = [Expr] -> Text
toLinearScript forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. Script f -> [Expr]
gen

toLinearScript :: [Expr] -> L.Text
toLinearScript :: [Expr] -> Text
toLinearScript = Text -> [Text] -> Text
L.intercalate Text
"; " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Expr -> Text
fmt Bool
False)

-- | Adds a shell command to the script.
run :: L.Text -> [L.Text] -> Script ()
run :: Text -> [Text] -> Script ()
run Text
c [Text]
ps = Expr -> Script ()
add forall a b. (a -> b) -> a -> b
$ Text -> Expr
newCmd forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
L.intercalate Text
" " (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Quoted a -> a
getQ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Quotable t => t -> Quoted Text
quote) (Text
cforall a. a -> [a] -> [a]
:[Text]
ps))

newCmd :: L.Text -> Expr
newCmd :: Text -> Expr
newCmd Text
l = Indent -> [LocalEnv] -> Text -> Expr
Cmd Indent
0 [] Text
l

raw :: L.Text -> Expr
raw :: Text -> Expr
raw Text
l = Indent -> Text -> Expr
Raw Indent
0 Text
l

-- | Variadic and polymorphic version of 'run'
--
-- A command can be passed any number of Params.
--
-- > demo = script $ do
-- >   cmd "echo" "hello, world"
-- >   name <- newVar ()
-- >   readVar name
-- >   cmd "echo" "hello" name
--
-- For the most efficient use of 'cmd', add the following boilerplate,
-- which will make string literals in your program default to being Text:
--
-- > {-# LANGUAGE OverloadedStrings, ExtendedDefaultRules #-}
-- > {-# OPTIONS_GHC -fno-warn-type-defaults #-}
-- > import Control.Monad.Shell
-- > import qualified Data.Text.Lazy as L
-- > default (L.Text)
--
-- Note that the command to run is itself a Param, so it can be a Text,
-- or a String, or even a Var or Output. For example, this echos "hi":
--
-- > demo = script $ do
-- >    echovar <- newVarContaining "echo" ()
-- >    cmd echovar "hi"
cmd :: (Param command, CmdParams params) => command -> params
cmd :: forall command params.
(Param command, CmdParams params) =>
command -> params
cmd command
c = forall t. CmdParams t => (Env -> Text) -> [Env -> Text] -> t
cmdAll (forall a. Param a => a -> Env -> Text
toTextParam command
c) []

-- | A Param is anything that can be used as the parameter of a command.
class Param a where
	toTextParam :: a -> Env -> L.Text

-- | Text arguments are automatically quoted.
instance Param L.Text where
	toTextParam :: Text -> Env -> Text
toTextParam = forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Quoted a -> a
getQ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Quotable t => t -> Quoted Text
quote

-- | String arguments are automatically quoted.
instance Param String where
	toTextParam :: String -> Env -> Text
toTextParam = forall a. Param a => a -> Env -> Text
toTextParam forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
L.pack

instance Param UntypedVar where
	toTextParam :: UntypedVar -> Env -> Text
toTextParam UntypedVar
v Env
env = Text
"\"" forall a. Semigroup a => a -> a -> a
<> forall a. Quoted a -> a
getQ (UntypedVar -> Env -> VarName -> Quoted Text
expandVar UntypedVar
v Env
env (UntypedVar -> VarName
varName UntypedVar
v)) forall a. Semigroup a => a -> a -> a
<> Text
"\""

instance Param (Term Var a) where
	toTextParam :: Term Var a -> Env -> Text
toTextParam (VarTerm UntypedVar
v) = forall a. Param a => a -> Env -> Text
toTextParam UntypedVar
v

instance (Show a) => Param (Term Static a) where
	toTextParam :: Term Static a -> Env -> Text
toTextParam (StaticTerm a
a) = forall a. Param a => a -> Env -> Text
toTextParam forall a b. (a -> b) -> a -> b
$ forall t. Quotable t => t -> Quoted Text
quote forall a b. (a -> b) -> a -> b
$ forall v. v -> Val v
Val a
a

-- | Allows modifying the value of a shell variable before it is passed to
-- the command.
instance Param (WithVar a) where
	toTextParam :: WithVar a -> Env -> Text
toTextParam (WithVar Term Var a
v Quoted Text -> Quoted Text
f) = forall a. Quoted a -> a
getQ forall b c a. (b -> c) -> (a -> b) -> a -> c
. Quoted Text -> Quoted Text
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Quoted a
Q forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Param a => a -> Env -> Text
toTextParam Term Var a
v

-- | Quoted Text arguments are passed as-is.
instance Param (Quoted L.Text) where
	toTextParam :: Quoted Text -> Env -> Text
toTextParam (Q Text
v) = forall a b. a -> b -> a
const Text
v

-- | Allows passing the output of a command as a parameter.
instance Param Output where
	toTextParam :: Output -> Env -> Text
toTextParam (Output Script ()
s) Env
env =
		let t :: Text
t = [Expr] -> Text
toLinearScript forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall f. Env -> Script f -> ([Expr], Env)
runScript Env
env Script ()
s
		in Text
"\"$(" forall a. Semigroup a => a -> a -> a
<> Text
t forall a. Semigroup a => a -> a -> a
<> Text
")\""

-- | Allows passing an Arithmetic Expression as a parameter.
instance Param Arith where
	toTextParam :: Arith -> Env -> Text
toTextParam Arith
a Env
env =
		let t :: Text
t = Env -> Arith -> Text
fmtArith Env
env Arith
a
		in Text
"\"" forall a. Semigroup a => a -> a -> a
<> Text
t forall a. Semigroup a => a -> a -> a
<> Text
"\""

-- | Allows a function to take any number of Params.
class CmdParams t where
	cmdAll :: (Env -> L.Text) -> [Env -> L.Text] -> t

instance (Param arg, CmdParams result) => CmdParams (arg -> result) where
	cmdAll :: (Env -> Text) -> [Env -> Text] -> arg -> result
cmdAll Env -> Text
c [Env -> Text]
acc arg
x = forall t. CmdParams t => (Env -> Text) -> [Env -> Text] -> t
cmdAll Env -> Text
c (forall a. Param a => a -> Env -> Text
toTextParam arg
x forall a. a -> [a] -> [a]
: [Env -> Text]
acc)

instance (f ~ ()) => CmdParams (Script f) where
	cmdAll :: (Env -> Text) -> [Env -> Text] -> Script f
cmdAll Env -> Text
c [Env -> Text]
acc = forall a. (Env -> ([Expr], Env, a)) -> Script a
Script forall a b. (a -> b) -> a -> b
$ \Env
env -> 
		let ps :: [Text]
ps = forall a b. (a -> b) -> [a] -> [b]
map (\Env -> Text
f -> Env -> Text
f Env
env) (Env -> Text
c forall a. a -> [a] -> [a]
: forall a. [a] -> [a]
reverse [Env -> Text]
acc)
		in ([Text -> Expr
newCmd forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
L.intercalate Text
" " [Text]
ps], Env
env, ())

-- | The output of a command, or even a more complicated Script
-- can be passed as a parameter to 'cmd'
--
-- Examples:
--
-- > cmd "echo" "hello there," (Output (cmd "whoami"))
-- > cmd "echo" "root's pwent" (Output (cmd "cat" "/etc/passwd" -|- cmd "grep" "root"))
newtype Output = Output (Script ())

-- | Allows modifying the value of a variable before it is passed to a
-- command. The function is passed a Quoted Text which will expand to the
-- value of the variable, and can modify it, by using eg 'mappend'.
--
-- > cmd "rmdir" (WithVar name ("/home/" <>))
data WithVar a = WithVar (Term Var a) (Quoted L.Text -> Quoted L.Text)

-- | Adds an Expr to the script.
add :: Expr -> Script ()
add :: Expr -> Script ()
add Expr
expr = forall a. (Env -> ([Expr], Env, a)) -> Script a
Script forall a b. (a -> b) -> a -> b
$ \Env
env -> ([Expr
expr], Env
env, ())

-- | Adds a comment that is embedded in the generated shell script.
comment :: L.Text -> Script ()
comment :: Text -> Script ()
comment = Expr -> Script ()
add forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Expr
Comment

-- | Suggests that a shell variable or function have its name contain
-- the specified Text.
newtype NamedLike = NamedLike L.Text

-- | Class of values that provide a hint for the name to use for a shell
-- variable or function.
--
-- If you don't want to provide a naming hint, use @()@.
--
-- @
-- v1 <- 'newVar' ()
-- @
--
-- To provide a naming hint, use 'NamedLike'.
--
-- @
-- v1 <- 'newVar' ('NamedLike' \"x\")
-- @
class NameHinted h where
	hinted :: (Maybe L.Text -> a) -> h -> a

instance NameHinted () where
	hinted :: forall a. (Maybe Text -> a) -> () -> a
hinted Maybe Text -> a
f ()
_ = Maybe Text -> a
f forall a. Maybe a
Nothing

instance NameHinted NamedLike where
	hinted :: forall a. (Maybe Text -> a) -> NamedLike -> a
hinted Maybe Text -> a
f (NamedLike Text
h) = Maybe Text -> a
f (forall a. a -> Maybe a
Just Text
h)

instance NameHinted (Maybe L.Text) where
	hinted :: forall a. (Maybe Text -> a) -> Maybe Text -> a
hinted = forall a. a -> a
id

-- | Makes a Static Term from any value that can be shown.
static :: (Quotable (Val t)) => t -> Term Static t
static :: forall t. Quotable (Val t) => t -> Term Static t
static = forall t. Quotable (Val t) => t -> Term Static t
StaticTerm

-- | Defines a new shell variable, which starts out not being set.
--
-- Each call to newVar will generate a new, unique variable name.
--
-- The namehint can influence this name, but is modified to ensure
-- uniqueness.
newVar :: (NameHinted namehint) => forall a. namehint -> Script (Term Var a)
newVar :: forall namehint a.
NameHinted namehint =>
namehint -> Script (Term Var a)
newVar = forall namehint t.
NameHinted namehint =>
Text -> namehint -> Script (Term Var t)
newVarContaining' Text
""

newVarContaining' :: (NameHinted namehint) => L.Text -> namehint -> Script (Term Var t)
newVarContaining' :: forall namehint t.
NameHinted namehint =>
Text -> namehint -> Script (Term Var t)
newVarContaining' Text
value = forall h a. NameHinted h => (Maybe Text -> a) -> h -> a
hinted forall a b. (a -> b) -> a -> b
$ \Maybe Text
namehint -> do
	Term Var t
v <- forall namehint a.
NameHinted namehint =>
namehint -> Script (Term Var a)
newVarUnsafe Maybe Text
namehint
	forall a. (Env -> ([Expr], Env, a)) -> Script a
Script forall a b. (a -> b) -> a -> b
$ \Env
env -> ([Text -> Expr
raw (forall t. Named t => t -> Text
getName Term Var t
v forall a. Semigroup a => a -> a -> a
<> Text
"=" forall a. Semigroup a => a -> a -> a
<> Text
value)], Env
env, Term Var t
v)

-- | Creates a new shell variable with an initial value coming from any
-- 'Param'.
--
-- For example,
--
-- > packageName <- newVarFrom
-- >      (Output $
-- >          cmd "grep" "-i" "name\\s*:" (glob "*.cabal") -|-
-- >          cmd "perl" "-pe" "s/^name\\s*:\\s*//i")
-- >      (NamedLike "packageName")
--
-- Use this with 'WithVar' to store to modified value of a variable in a new
-- variable.
--
-- > home <- globalVar "HOME"
-- > cabalDir <- newVarFrom (WithVar home (<> "/.cabal")) ()
-- 
-- Or to capture the output of an arithmetic operation.
--
-- > sum <- newVarFrom (val x `APlus` 1) ()
--
newVarFrom
	:: (NameHinted namehint, Param param)
	=> param -> namehint -> Script (Term Var t)
newVarFrom :: forall namehint param t.
(NameHinted namehint, Param param) =>
param -> namehint -> Script (Term Var t)
newVarFrom param
param namehint
namehint = do
	Term Var t
v <- forall namehint a.
NameHinted namehint =>
namehint -> Script (Term Var a)
newVarUnsafe namehint
namehint
	forall a. (Env -> ([Expr], Env, a)) -> Script a
Script forall a b. (a -> b) -> a -> b
$ \Env
env ->
		([Text -> Expr
raw (forall t. Named t => t -> Text
getName Term Var t
v forall a. Semigroup a => a -> a -> a
<> Text
"=" forall a. Semigroup a => a -> a -> a
<> forall a. Param a => a -> Env -> Text
toTextParam param
param Env
env)], Env
env, Term Var t
v)

-- | Creates a new shell variable, with an initial value which can
-- be anything that can be shown.
--
-- > s <- newVarContaining "foo bar baz" (NamedLike "s")
-- > i <- newVarContaining (1 :: Int) (NamedLike "i")
newVarContaining :: (NameHinted namehint, Quotable (Val t)) => t -> namehint -> Script (Term Var t)
newVarContaining :: forall namehint t.
(NameHinted namehint, Quotable (Val t)) =>
t -> namehint -> Script (Term Var t)
newVarContaining = forall namehint t.
NameHinted namehint =>
Text -> namehint -> Script (Term Var t)
newVarContaining' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Quoted a -> a
getQ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Quotable t => t -> Quoted Text
quote forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. v -> Val v
Val

-- | Sets the Var to the value of the param. 
setVar :: Param param => forall a. Term Var a -> param -> Script ()
setVar :: forall param a. Param param => Term Var a -> param -> Script ()
setVar Term Var a
v param
p = forall a. (Env -> ([Expr], Env, a)) -> Script a
Script forall a b. (a -> b) -> a -> b
$ \Env
env -> 
	([Text -> Expr
raw (forall t. Named t => t -> Text
getName Term Var a
v forall a. Semigroup a => a -> a -> a
<> Text
"=" forall a. Semigroup a => a -> a -> a
<> forall a. Param a => a -> Env -> Text
toTextParam param
p Env
env)], Env
env, ())

-- | Gets a Var that refers to a global variable, such as PATH
globalVar :: forall a. L.Text -> Script (Term Var a)
globalVar :: forall a. Text -> Script (Term Var a)
globalVar Text
name = forall a. (Env -> ([Expr], Env, a)) -> Script a
Script forall a b. (a -> b) -> a -> b
$ \Env
env ->
	let v :: Term Var a
v = forall a. VarName -> Term Var a
simpleVar (Text -> VarName
VarName Text
name)
	in ([], Env -> (Set VarName -> Set VarName) -> Env
modifyEnvVars Env
env (forall a. Ord a => a -> Set a -> Set a
S.insert (Text -> VarName
VarName (forall t. Named t => t -> Text
getName Term Var a
v))), Term Var a
v)

-- | This special Var expands to whatever parameters were passed to the
-- shell script.
--
-- Inside a func, it expands to whatever parameters were passed to the
-- func.
--
-- (This is `$@` in shell)
positionalParameters :: forall a. Term Var a
positionalParameters :: forall a. Term Var a
positionalParameters = forall a. VarName -> Term Var a
simpleVar (Text -> VarName
VarName Text
"@")

-- | Takes the first positional parameter, removing it from
-- positionalParameters and returning a new Var that holds the value of the
-- parameter.
--
-- If there are no more positional parameters, the script will crash
-- with an error.
--
-- For example:
--
-- > removefirstfile = script $ do
-- >   cmd "rm" =<< takeParameter
-- >   cmd "echo" "remaining parameters:" positionalParameters
takeParameter :: (NameHinted namehint) => forall a. namehint -> Script (Term Var a)
takeParameter :: forall namehint a.
NameHinted namehint =>
namehint -> Script (Term Var a)
takeParameter = forall h a. NameHinted h => (Maybe Text -> a) -> h -> a
hinted forall a b. (a -> b) -> a -> b
$ \Maybe Text
namehint -> do
	Term Var a
p <- forall namehint a.
NameHinted namehint =>
namehint -> Script (Term Var a)
newVarUnsafe Maybe Text
namehint
	forall a. (Env -> ([Expr], Env, a)) -> Script a
Script forall a b. (a -> b) -> a -> b
$ \Env
env -> ([Text -> Expr
raw (forall t. Named t => t -> Text
getName Term Var a
p forall a. Semigroup a => a -> a -> a
<> Text
"=\"$1\""), Text -> Expr
raw Text
"shift"], Env
env, Term Var a
p)

-- | Creates a new shell variable, but does not ensure that it's not
-- already set to something. For use when the caller is going to generate
-- some shell script that is guaranteed to clobber any existing value of
-- the variable.
newVarUnsafe :: (NameHinted namehint) => forall a. namehint -> Script (Term Var a)
newVarUnsafe :: forall namehint a.
NameHinted namehint =>
namehint -> Script (Term Var a)
newVarUnsafe namehint
hint = forall a. UntypedVar -> Term Var a
VarTerm forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall namehint.
NameHinted namehint =>
namehint -> Script UntypedVar
newVarUnsafe' namehint
hint

newVarUnsafe' :: (NameHinted namehint) => namehint -> Script UntypedVar
newVarUnsafe' :: forall namehint.
NameHinted namehint =>
namehint -> Script UntypedVar
newVarUnsafe' = forall h a. NameHinted h => (Maybe Text -> a) -> h -> a
hinted forall a b. (a -> b) -> a -> b
$ \Maybe Text
namehint -> forall a. (Env -> ([Expr], Env, a)) -> Script a
Script forall a b. (a -> b) -> a -> b
$ \Env
env ->
	let name :: VarName
name = forall {t}.
(Eq t, Num t, Show t, Enum t) =>
Maybe Text -> Env -> t -> VarName
go Maybe Text
namehint Env
env (Integer
0 :: Integer)
	in ([], Env -> (Set VarName -> Set VarName) -> Env
modifyEnvVars Env
env (forall a. Ord a => a -> Set a -> Set a
S.insert VarName
name), VarName -> UntypedVar
simpleVar' VarName
name)
  where
	go :: Maybe Text -> Env -> t -> VarName
go Maybe Text
namehint Env
env t
x
		| forall a. Ord a => a -> Set a -> Bool
S.member VarName
name (Env -> Set VarName
envVars Env
env) =
			Maybe Text -> Env -> t -> VarName
go Maybe Text
namehint Env
env (forall a. Enum a => a -> a
succ t
x)
		| Bool
otherwise = VarName
name
	  where
		name :: VarName
name = Text -> VarName
VarName forall a b. (a -> b) -> a -> b
$ Text
"_"
			forall a. Semigroup a => a -> a -> a
<> Maybe Text -> Text
genvarname Maybe Text
namehint
			forall a. Semigroup a => a -> a -> a
<> if t
x forall a. Eq a => a -> a -> Bool
== t
0 then Text
"" else String -> Text
L.pack (forall a. Show a => a -> String
show (t
x forall a. Num a => a -> a -> a
+ t
1))
	
	genvarname :: Maybe Text -> Text
genvarname = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"v" ((Char -> Bool) -> Text -> Text
L.filter Char -> Bool
isAlpha)

-- | Generates a new Var. Expanding this Var will yield the same
-- result as expanding the input Var, unless it is empty, in which case
-- it instead defaults to the expansion of the param.
defaultVar :: (Param param) => forall a. Term Var a -> param -> Script (Term Var a)
defaultVar :: forall param a.
Param param =>
Term Var a -> param -> Script (Term Var a)
defaultVar = forall param a b.
Param param =>
Text -> Term Var a -> param -> Script (Term Var b)
funcVar' Text
":-"

-- | Generates a new Var. If the input Var is empty, then this new Var
-- will likewise expand to the empty string. But if not, the new Var
-- expands to the param.
whenVar :: (Param param) => forall a. Term Var a -> param -> Script (Term Var a)
whenVar :: forall param a.
Param param =>
Term Var a -> param -> Script (Term Var a)
whenVar = forall param a b.
Param param =>
Text -> Term Var a -> param -> Script (Term Var b)
funcVar' Text
":+"

-- | Generates a new Var. If the input Var is empty then expanding this new
-- Var will cause an error to be thrown, using the param as the error
-- message. If the input Var is not empty, then the new Var expands to the
-- same thing the input Var expands to.
errUnlessVar :: (Param param) => forall a. Term Var a -> param -> Script (Term Var a)
errUnlessVar :: forall param a.
Param param =>
Term Var a -> param -> Script (Term Var a)
errUnlessVar = forall param a b.
Param param =>
Text -> Term Var a -> param -> Script (Term Var b)
funcVar' Text
":?"

-- | Produces a Var that is a trimmed version of the input Var.
--
-- The Quoted Text is removed from the value of the Var, either
-- from the beginning or from the end.
--
-- If the Quoted Text was produced by 'glob', it could match in
-- multiple ways. You can choose whether to remove the shortest or
-- the longest match.
--
-- The act of trimming a Var is assumed to be able to produce a new
-- Var holding a different data type.
trimVar :: forall a. Greediness -> Direction -> Term Var String -> Quoted L.Text -> Script (Term Var a)
trimVar :: forall a.
Greediness
-> Direction
-> Term Var String
-> Quoted Text
-> Script (Term Var a)
trimVar Greediness
ShortestMatch Direction
FromBeginning = forall param a b.
Param param =>
Text -> Term Var a -> param -> Script (Term Var b)
funcVar' Text
"#"
trimVar Greediness
LongestMatch Direction
FromBeginning = forall param a b.
Param param =>
Text -> Term Var a -> param -> Script (Term Var b)
funcVar' Text
"##"
trimVar Greediness
ShortestMatch Direction
FromEnd = forall param a b.
Param param =>
Text -> Term Var a -> param -> Script (Term Var b)
funcVar' Text
"%"
trimVar Greediness
LongestMatch Direction
FromEnd = forall param a b.
Param param =>
Text -> Term Var a -> param -> Script (Term Var b)
funcVar' Text
"%%"

data Greediness = ShortestMatch | LongestMatch

data Direction = FromBeginning | FromEnd

-- | Generates a new Var, which expands to the length of the
-- expansion of the input Var.
--
-- Note that 'lengthVar positionalParameters' expands to the number
-- of positional parameters.
lengthVar :: forall a. Term Var a -> Script (Term Var Integer)
lengthVar :: forall a. Term Var a -> Script (Term Var Integer)
lengthVar Term Var a
v
	| forall t. Named t => t -> Text
getName Term Var a
v forall a. Eq a => a -> a -> Bool
== Text
"@" = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. VarName -> Term Var a
simpleVar (Text -> VarName
VarName Text
"#")
	| Bool
otherwise = forall a b. Term Var a -> (Text -> Text) -> Script (Term Var b)
funcVar Term Var a
v (Text
"#" forall a. Semigroup a => a -> a -> a
<>)		

-- To implement a Var -> Var function at the shell level,
-- generate shell code like this:
--
-- func () {
-- 	t="$orig"; echo "${t'}"
-- }
--
-- Where t' = transform t
--
-- The returned Var expands to a call to the function: $(func)
-- Note that it's important this call to the function not contain
-- any quotes, so that it can be used inside an arithmetic expression.
funcVar :: forall a b. Term Var a -> (L.Text -> L.Text) -> Script (Term Var b)
funcVar :: forall a b. Term Var a -> (Text -> Text) -> Script (Term Var b)
funcVar Term Var a
orig Text -> Text
transform = do
	UntypedVar
v <- forall namehint.
NameHinted namehint =>
namehint -> Script UntypedVar
newVarUnsafe' NamedLike
shortname
	Script ()
f <- Term Var () -> Script (Script ())
mkFunc (forall a. UntypedVar -> Term Var a
VarTerm UntypedVar
v)
	forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. UntypedVar -> Term Var a
VarTerm forall a b. (a -> b) -> a -> b
$ UntypedVar
v
		{ expandVar :: Env -> VarName -> Quoted Text
expandVar = \Env
env VarName
_ -> forall a. a -> Quoted a
Q forall a b. (a -> b) -> a -> b
$
			Text
"$(" forall a. Semigroup a => a -> a -> a
<> [Expr] -> Text
toLinearScript (forall a b. (a, b) -> a
fst (forall f. Env -> Script f -> ([Expr], Env)
runScript Env
env Script ()
f)) forall a. Semigroup a => a -> a -> a
<> Text
")"
		}
  where
	mkFunc :: Term Var () -> Script (Script ())
	mkFunc :: Term Var () -> Script (Script ())
mkFunc Term Var ()
tmp = forall namehint callfunc.
(NameHinted namehint, CmdParams callfunc) =>
namehint -> Script () -> Script callfunc
func NamedLike
shortname forall a b. (a -> b) -> a -> b
$ do
		forall param a. Param param => Term Var a -> param -> Script ()
setVar Term Var ()
tmp Term Var a
orig
		forall command params.
(Param command, CmdParams params) =>
command -> params
cmd (Text
"echo" :: L.Text) forall a b. (a -> b) -> a -> b
$ forall a. a -> Quoted a
Q forall a b. (a -> b) -> a -> b
$
			Text
"\"${" forall a. Semigroup a => a -> a -> a
<> Text -> Text
transform (forall t. Named t => t -> Text
getName Term Var ()
tmp) forall a. Semigroup a => a -> a -> a
<> Text
"}\""
	shortname :: NamedLike
shortname = Text -> NamedLike
NamedLike Text
"v"

funcVar' :: (Param param) => forall a b. L.Text -> Term Var a -> param -> Script (Term Var b)
funcVar' :: forall param a b.
Param param =>
Text -> Term Var a -> param -> Script (Term Var b)
funcVar' Text
op Term Var a
v param
p = do
	Text
t <- forall a. Param a => a -> Env -> Text
toTextParam param
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Script Env
getEnv
	forall a b. Term Var a -> (Text -> Text) -> Script (Term Var b)
funcVar Term Var a
v (forall a. Semigroup a => a -> a -> a
<> Text
op forall a. Semigroup a => a -> a -> a
<> Text
t)

-- | Defines a shell function, and returns an action that can be run to
-- call the function.
--
-- The action is variadic; it can be passed any number of CmdParams.
-- Typically, it will make sense to specify a more concrete type
-- when defining the shell function.
--
-- The shell function will be given a unique name, that is not used by any
-- other shell function. The namehint can be used to influence the contents
-- of the function name, which makes for more readable generated shell
-- code.
--
-- For example:
--
-- > demo = script $ do
-- >    hohoho <- mkHohoho
-- >    hohoho (static 1)
-- >    echo "And I heard him exclaim, ere he rode out of sight ..."
-- >    hohoho (static 3)
-- > 
-- > mkHohoho :: Script (Term Val Int -> Script ())
-- > mkHohoho = func (NamedLike "hohoho") $ do
-- >    num <- takeParameter
-- >    forCmd (cmd "seq" "1" num) $ \_n ->
-- >       cmd "echo" "Ho, ho, ho!" "Merry xmas!"
func
	:: (NameHinted namehint, CmdParams callfunc)
	=> namehint
	-> Script ()
	-> Script callfunc
func :: forall namehint callfunc.
(NameHinted namehint, CmdParams callfunc) =>
namehint -> Script () -> Script callfunc
func namehint
h Script ()
s = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall h a. NameHinted h => (Maybe Text -> a) -> h -> a
hinted namehint
h forall a b. (a -> b) -> a -> b
$ \Maybe Text
namehint -> forall a. (Env -> ([Expr], Env, a)) -> Script a
Script forall a b. (a -> b) -> a -> b
$ \Env
env ->
	let f :: Func
f = forall {t}.
(Eq t, Num t, Show t, Enum t) =>
Text -> Env -> t -> Func
go (Maybe Text -> Text
genfuncname Maybe Text
namehint) Env
env (Integer
0 :: Integer)
	    env' :: Env
env' = Env -> (Set Func -> Set Func) -> Env
modifyEnvFuncs Env
env (forall a. Ord a => a -> Set a -> Set a
S.insert Func
f)
	    ([Expr]
ls, Env
env'') = forall f. Env -> Script f -> ([Expr], Env)
runScript Env
env' Script ()
s
	in (Func -> [Expr] -> [Expr]
definefunc Func
f [Expr]
ls, Env
env'', forall {params}. CmdParams params => Func -> params
callfunc Func
f)
  where
	go :: Text -> Env -> t -> Func
go Text
basename Env
env t
x
		| forall a. Ord a => a -> Set a -> Bool
S.member Func
f (Env -> Set Func
envFuncs Env
env) = Text -> Env -> t -> Func
go Text
basename Env
env (forall a. Enum a => a -> a
succ t
x)
		| Bool
otherwise = Func
f
	  where
		f :: Func
f = Text -> Func
Func forall a b. (a -> b) -> a -> b
$ Text
"_"
			forall a. Semigroup a => a -> a -> a
<> Text
basename
			forall a. Semigroup a => a -> a -> a
<> if t
x forall a. Eq a => a -> a -> Bool
== t
0 then Text
"" else String -> Text
L.pack (forall a. Show a => a -> String
show (t
x forall a. Num a => a -> a -> a
+ t
1))
	
	genfuncname :: Maybe Text -> Text
genfuncname = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"p" ((Char -> Bool) -> Text -> Text
L.filter Char -> Bool
isAlpha)

	definefunc :: Func -> [Expr] -> [Expr]
definefunc (Func Text
f) [Expr]
ls = (Text -> Expr
raw forall a b. (a -> b) -> a -> b
$ Text
f forall a. Semigroup a => a -> a -> a
<> Text
" () { :") forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map Expr -> Expr
indent [Expr]
ls forall a. [a] -> [a] -> [a]
++ [ Text -> Expr
raw Text
"}" ]

	callfunc :: Func -> params
callfunc (Func Text
f) = forall command params.
(Param command, CmdParams params) =>
command -> params
cmd Text
f

-- | Runs the command, and separates its output into parts
-- (using the IFS)
--
-- The action is run for each part, passed a Var containing the part.
forCmd :: forall a. Script () -> (Term Var a -> Script ()) -> Script ()
forCmd :: forall a. Script () -> (Term Var a -> Script ()) -> Script ()
forCmd Script ()
c Term Var a -> Script ()
a = do
	Term Var a
v <- forall namehint a.
NameHinted namehint =>
namehint -> Script (Term Var a)
newVarUnsafe (Text -> NamedLike
NamedLike Text
"x")
	Text
s <- [Expr] -> Text
toLinearScript forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Script () -> Script [Expr]
runM Script ()
c
	Expr -> Script ()
add forall a b. (a -> b) -> a -> b
$ Text -> Expr
raw forall a b. (a -> b) -> a -> b
$ Text
"for " forall a. Semigroup a => a -> a -> a
<> forall t. Named t => t -> Text
getName Term Var a
v forall a. Semigroup a => a -> a -> a
<> Text
" in $(" forall a. Semigroup a => a -> a -> a
<> Text
s forall a. Semigroup a => a -> a -> a
<> Text
")"
	Text -> Script () -> Script ()
block Text
"do" (Term Var a -> Script ()
a Term Var a
v)
	Expr -> Script ()
add forall a b. (a -> b) -> a -> b
$ Text -> Expr
raw Text
"done"

-- | As long as the first Script exits nonzero, runs the second script.
whileCmd :: Script () -> Script () -> Script ()
whileCmd :: Script () -> Script () -> Script ()
whileCmd Script ()
c Script ()
a = do
	Text
s <- [Expr] -> Text
toLinearScript forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Script () -> Script [Expr]
runM Script ()
c
	Expr -> Script ()
add forall a b. (a -> b) -> a -> b
$ Text -> Expr
raw forall a b. (a -> b) -> a -> b
$ Text
"while $(" forall a. Semigroup a => a -> a -> a
<> Text
s forall a. Semigroup a => a -> a -> a
<> Text
")"
	Text -> Script () -> Script ()
block Text
"do" Script ()
a
	Expr -> Script ()
add forall a b. (a -> b) -> a -> b
$ Text -> Expr
raw Text
"done"

-- | if with a Script conditional.
--
-- If the conditional exits 0, the first action is run, else the second.
ifCmd :: Script () -> Script () -> Script () -> Script ()
ifCmd :: Script () -> Script () -> Script () -> Script ()
ifCmd Script ()
cond Script ()
thena Script ()
elsea = 
	(Text -> Text) -> Script () -> Script () -> Script ()
ifCmd' forall a. a -> a
id Script ()
cond forall a b. (a -> b) -> a -> b
$ do
		Text -> Script () -> Script ()
block Text
"then" Script ()
thena
		Text -> Script () -> Script ()
block Text
"else" Script ()
elsea

ifCmd' :: (L.Text -> L.Text) -> Script () -> Script () -> Script ()
ifCmd' :: (Text -> Text) -> Script () -> Script () -> Script ()
ifCmd' Text -> Text
condf Script ()
cond Script ()
body = do
	[Expr]
condl <- Script () -> Script [Expr]
runM Script ()
cond
	Expr -> Script ()
add forall a b. (a -> b) -> a -> b
$ Text -> Expr
raw forall a b. (a -> b) -> a -> b
$ Text
"if " forall a. Semigroup a => a -> a -> a
<> Text -> Text
condf ([Expr] -> Text
singleline [Expr]
condl)
	Script ()
body
	Expr -> Script ()
add forall a b. (a -> b) -> a -> b
$ Text -> Expr
raw Text
"fi"
  where
	singleline :: [Expr] -> Text
singleline [Expr]
l =
		let c :: Expr
c = case [Expr]
l of
			[c' :: Expr
c'@(Cmd {})] -> Expr
c'
			[c' :: Expr
c'@(Raw {})] -> Expr
c'
			[c' :: Expr
c'@(Subshell {})] -> Expr
c'
			[Expr]
_ -> Text -> [Expr] -> Expr
Subshell Text
L.empty [Expr]
l
		in [Expr] -> Text
toLinearScript [Expr
c]

-- | when with a monadic conditional
whenCmd :: Script () -> Script () -> Script ()
whenCmd :: Script () -> Script () -> Script ()
whenCmd Script ()
cond Script ()
a = 
	(Text -> Text) -> Script () -> Script () -> Script ()
ifCmd' forall a. a -> a
id Script ()
cond forall a b. (a -> b) -> a -> b
$
		Text -> Script () -> Script ()
block Text
"then" Script ()
a

-- | unless with a monadic conditional
unlessCmd :: Script () -> Script () -> Script ()
unlessCmd :: Script () -> Script () -> Script ()
unlessCmd Script ()
cond Script ()
a =
	(Text -> Text) -> Script () -> Script () -> Script ()
ifCmd' (Text
"! " forall a. Semigroup a => a -> a -> a
<>) Script ()
cond forall a b. (a -> b) -> a -> b
$
		Text -> Script () -> Script ()
block Text
"then" Script ()
a

-- | Matches the value of the Var against the Quoted Text (which can
-- be generated by 'glob'), and runs the Script action associated
-- with the first match.
--
-- > arg <- takeParameter ()
-- > caseOf arg
-- >   [ (quote "-h", showHelp)
-- >   , (glob "-*", cmd "echo" "Unknown option:" arg)
-- >   ]
caseOf :: forall a. Term Var a -> [(Quoted L.Text, Script ())] -> Script ()
caseOf :: forall a. Term Var a -> [(Quoted Text, Script ())] -> Script ()
caseOf Term Var a
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
caseOf Term Var a
v [(Quoted Text, Script ())]
l = Bool -> [(Quoted Text, Script ())] -> Script ()
go Bool
True [(Quoted Text, Script ())]
l
  where
	-- The case expression is formatted somewhat unusually,
	-- in order to make it work in both single line and multi-line
	-- rendering.
	--
	-- > case "$foo" in ook) : 
	-- >     echo got ook
	-- >     echo yay
	-- > : ;; *) :
	-- >     echo default
	-- > : ;; esac
	go :: Bool -> [(Quoted Text, Script ())] -> Script ()
go Bool
_ [] = Expr -> Script ()
add forall a b. (a -> b) -> a -> b
$ Text -> Expr
raw Text
";; esac"
	go Bool
atstart ((Quoted Text
t, Script ()
s):[(Quoted Text, Script ())]
rest) = do
		Env
env <- Script Env
getEnv
		let leader :: Text
leader = if Bool
atstart
			then Text
"case " forall a. Semigroup a => a -> a -> a
<> forall a. Param a => a -> Env -> Text
toTextParam Term Var a
v Env
env forall a. Semigroup a => a -> a -> a
<> Text
" in "
			else Text
": ;; "
		Expr -> Script ()
add forall a b. (a -> b) -> a -> b
$ Text -> Expr
raw forall a b. (a -> b) -> a -> b
$ Text
leader forall a. Semigroup a => a -> a -> a
<> forall a. Quoted a -> a
getQ Quoted Text
t forall a. Semigroup a => a -> a -> a
<> Text
") :"
		forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Expr -> Script ()
add forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Expr
indent) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Script () -> Script [Expr]
runM Script ()
s
		Bool -> [(Quoted Text, Script ())] -> Script ()
go Bool
False [(Quoted Text, Script ())]
rest

-- | Runs the script in a new subshell.
subshell :: Script () -> Script ()
subshell :: Script () -> Script ()
subshell Script ()
s = do
	[Expr]
e <- Script () -> Script [Expr]
runM Script ()
s
	Expr -> Script ()
add forall a b. (a -> b) -> a -> b
$ Text -> [Expr] -> Expr
Subshell Text
"" [Expr]
e

-- | Runs the script as a command group in the current subshell.
group :: Script () -> Script ()
group :: Script () -> Script ()
group Script ()
s = do
	[Expr]
e <- Script () -> Script [Expr]
runM Script ()
s
	Expr -> Script ()
add forall a b. (a -> b) -> a -> b
$ Text -> [Expr] -> Expr
Group Text
"" [Expr]
e

-- | Add a variable to the local environment of the script.
withEnv :: Param value => L.Text -> value -> Script () -> Script ()
withEnv :: forall value.
Param value =>
Text -> value -> Script () -> Script ()
withEnv Text
n value
v (Script Env -> ([Expr], Env, ())
f) = forall a. (Env -> ([Expr], Env, a)) -> Script a
Script forall a b. (a -> b) -> a -> b
$ ([Expr], Env, ()) -> ([Expr], Env, ())
addEnv forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env -> ([Expr], Env, ())
f
  where
	-- We can only add K=V to simple commands. If the input script
	-- contains anything more than one simple command we'll have to wrap
	-- the script into a fresh function and call that with the
	-- environment.
	addEnv :: ([Expr], Env, ()) -> ([Expr], Env, ())
addEnv ([Expr]
e, Env
env, ()
_) = let localenv :: LocalEnv
localenv = (Text
n, forall a. Param a => a -> Env -> Text
toTextParam value
v Env
env)
		in case [Expr]
e of
			[Cmd Indent
i [LocalEnv]
localenvs Text
l] -> ([Indent -> [LocalEnv] -> Text -> Expr
Cmd Indent
i (LocalEnv
localenv forall a. a -> [a] -> [a]
: [LocalEnv]
localenvs) Text
l], Env
env, ())
			[EnvWrap Indent
i Text
envName [LocalEnv]
localenvs [Expr]
e'] -> ([Indent -> Text -> [LocalEnv] -> [Expr] -> Expr
EnvWrap Indent
i Text
envName (LocalEnv
localenv forall a. a -> [a] -> [a]
: [LocalEnv]
localenvs) [Expr]
e'], Env
env, ())
			[Expr]
l -> ([Indent -> Text -> [LocalEnv] -> [Expr] -> Expr
EnvWrap Indent
0 (forall t. Named t => t -> Text
getName UntypedVar
name) [LocalEnv
localenv] [Expr]
l], Env
env', ())
	  where
		(Script Env -> ([Expr], Env, UntypedVar)
nameFn) = forall namehint.
NameHinted namehint =>
namehint -> Script UntypedVar
newVarUnsafe' (Text -> NamedLike
NamedLike Text
"envfn")
		([Expr]
_, Env
env', UntypedVar
name) = Env -> ([Expr], Env, UntypedVar)
nameFn Env
env

-- | Creates a block such as "do : ; cmd ; cmd" or "else : ; cmd ; cmd"
--
-- The use of : ensures that the block is not empty, and allows
-- for more regular indentation, as well as making the single line
-- formatting work.
block :: L.Text -> Script () -> Script ()
block :: Text -> Script () -> Script ()
block Text
word Script ()
s = do
	Expr -> Script ()
add forall a b. (a -> b) -> a -> b
$ Text -> Expr
raw forall a b. (a -> b) -> a -> b
$ Text
word forall a. Semigroup a => a -> a -> a
<> Text
" :"
	forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Expr -> Script ()
add forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Expr
indent) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Script () -> Script [Expr]
runM Script ()
s

-- | Fills a variable with a line read from stdin.
readVar :: Term Var String -> Script ()
readVar :: Term Var String -> Script ()
readVar Term Var String
v = Expr -> Script ()
add forall a b. (a -> b) -> a -> b
$ Text -> Expr
newCmd forall a b. (a -> b) -> a -> b
$ Text
"read " forall a. Semigroup a => a -> a -> a
<> forall a. Quoted a -> a
getQ (forall t. Quotable t => t -> Quoted Text
quote (forall t. Named t => t -> Text
getName Term Var String
v))

-- | By default, shell scripts continue running past commands that exit
-- nonzero. Use 'stopOnFailure True' to make the script stop on the first
-- such command.
stopOnFailure :: Bool -> Script ()
stopOnFailure :: Bool -> Script ()
stopOnFailure Bool
b = Expr -> Script ()
add forall a b. (a -> b) -> a -> b
$ Text -> Expr
raw forall a b. (a -> b) -> a -> b
$ Text
"set " forall a. Semigroup a => a -> a -> a
<> (if Bool
b then Text
"-" else Text
"+") forall a. Semigroup a => a -> a -> a
<> Text
"e"

-- | Makes a nonzero exit status be ignored.
ignoreFailure :: Script () -> Script ()
ignoreFailure :: Script () -> Script ()
ignoreFailure Script ()
s = Script () -> Script [Expr]
runM Script ()
s forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Expr -> Script ()
add forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Expr
go)
  where
	go :: Expr -> Expr
go c :: Expr
c@(Cmd Indent
_ [LocalEnv]
_ Text
_) = Expr -> Expr -> Expr
Or Expr
c Expr
true
	go c :: Expr
c@(Raw Indent
_ Text
_) = Expr -> Expr -> Expr
Or Expr
c Expr
true
	go c :: Expr
c@(Comment Text
_) = Expr
c
	go (EnvWrap Indent
i Text
n [LocalEnv]
localenvs [Expr]
e) = Indent -> Text -> [LocalEnv] -> [Expr] -> Expr
EnvWrap Indent
i Text
n [LocalEnv]
localenvs (forall a b. (a -> b) -> [a] -> [b]
map Expr -> Expr
go [Expr]
e)
	go (Subshell Text
i [Expr]
l) = Text -> [Expr] -> Expr
Subshell Text
i (forall a b. (a -> b) -> [a] -> [b]
map Expr -> Expr
go [Expr]
l)
	go (Group Text
i [Expr]
l) = Text -> [Expr] -> Expr
Group Text
i (forall a b. (a -> b) -> [a] -> [b]
map Expr -> Expr
go [Expr]
l)
	-- Assumes pipefail is not set.
	go (Pipe Expr
e1 Expr
e2) = Expr -> Expr -> Expr
Pipe Expr
e1 (Expr -> Expr
go Expr
e2)
	-- Note that in shell, a && b || true will result in true;
	-- there is no need for extra parens.
	go c :: Expr
c@(And Expr
_ Expr
_) = Expr -> Expr -> Expr
Or Expr
c Expr
true
	go (Or Expr
e1 Expr
e2) = Expr -> Expr -> Expr
Or Expr
e1 (Expr -> Expr
go Expr
e2)
	go (Redir Expr
e RedirSpec
r) = Expr -> RedirSpec -> Expr
Redir (Expr -> Expr
go Expr
e) RedirSpec
r

	true :: Expr
true = Text -> Expr
raw Text
"true"

-- | Pipes together two Scripts.
(-|-) :: Script () -> Script () -> Script ()
-|- :: Script () -> Script () -> Script ()
(-|-) = (Expr -> Expr -> Expr) -> Script () -> Script () -> Script ()
combine Expr -> Expr -> Expr
Pipe

-- | ANDs two Scripts.
(-&&-) :: Script () -> Script () -> Script ()
-&&- :: Script () -> Script () -> Script ()
(-&&-) = (Expr -> Expr -> Expr) -> Script () -> Script () -> Script ()
combine Expr -> Expr -> Expr
And

-- | ORs two Scripts.
(-||-) :: Script () -> Script () -> Script ()
-||- :: Script () -> Script () -> Script ()
(-||-) = (Expr -> Expr -> Expr) -> Script () -> Script () -> Script ()
combine Expr -> Expr -> Expr
Or

combine :: (Expr -> Expr -> Expr) -> Script () -> Script () -> Script ()
combine :: (Expr -> Expr -> Expr) -> Script () -> Script () -> Script ()
combine Expr -> Expr -> Expr
f Script ()
a Script ()
b = do
	[Expr]
alines <- Script () -> Script [Expr]
runM Script ()
a
	[Expr]
blines <- Script () -> Script [Expr]
runM Script ()
b
	Expr -> Script ()
add forall a b. (a -> b) -> a -> b
$ Expr -> Expr -> Expr
f ([Expr] -> Expr
toSingleExp [Expr]
alines) ([Expr] -> Expr
toSingleExp [Expr]
blines)

toSingleExp :: [Expr] -> Expr
toSingleExp :: [Expr] -> Expr
toSingleExp [Expr
e] = Expr
e
toSingleExp [Expr]
l = Text -> [Expr] -> Expr
Subshell Text
L.empty [Expr]
l

redir :: Script () -> RedirSpec -> Script ()
redir :: Script () -> RedirSpec -> Script ()
redir Script ()
s RedirSpec
r = do
	Expr
e <- [Expr] -> Expr
toSingleExp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Script () -> Script [Expr]
runM Script ()
s
	Expr -> Script ()
add forall a b. (a -> b) -> a -> b
$ Expr -> RedirSpec -> Expr
Redir Expr
e RedirSpec
r

-- | Any function that takes a RedirFile can be passed a
-- a FilePath, in which case the default file descriptor will be redirected
-- to/from the FilePath.
--
-- Or, it can be passed a tuple of (Fd, FilePath), in which case the
-- specified Fd will be redirected to/from the FilePath.
class RedirFile r where
	fromRedirFile :: Fd -> r -> (Fd, FilePath)

instance RedirFile FilePath where
	fromRedirFile :: Fd -> String -> (Fd, String)
fromRedirFile = (,)

instance RedirFile (Fd, FilePath) where
	fromRedirFile :: Fd -> (Fd, String) -> (Fd, String)
fromRedirFile = forall a b. a -> b -> a
const forall a. a -> a
id

fileRedir :: RedirFile f => f -> Fd -> (Fd -> FilePath -> RedirSpec) -> RedirSpec
fileRedir :: forall f.
RedirFile f =>
f -> Fd -> (Fd -> String -> RedirSpec) -> RedirSpec
fileRedir f
f Fd
deffd Fd -> String -> RedirSpec
c = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Fd -> String -> RedirSpec
c (forall r. RedirFile r => Fd -> r -> (Fd, String)
fromRedirFile Fd
deffd f
f)

-- | Redirects to a file, overwriting any existing file.
--
-- For example, to shut up a noisy command:
--
-- > cmd "find" "/" |> "/dev/null"
(|>) :: RedirFile f => Script () -> f -> Script ()
Script ()
s |> :: forall f. RedirFile f => Script () -> f -> Script ()
|> f
f = Script () -> RedirSpec -> Script ()
redir Script ()
s (forall f.
RedirFile f =>
f -> Fd -> (Fd -> String -> RedirSpec) -> RedirSpec
fileRedir f
f Fd
stdOutput Fd -> String -> RedirSpec
RedirToFile)

-- | Appends to a file. (If file doesn't exist, it will be created.)
(|>>) :: RedirFile f => Script () -> f -> Script ()
Script ()
s |>> :: forall f. RedirFile f => Script () -> f -> Script ()
|>> f
f = Script () -> RedirSpec -> Script ()
redir Script ()
s (forall f.
RedirFile f =>
f -> Fd -> (Fd -> String -> RedirSpec) -> RedirSpec
fileRedir f
f Fd
stdOutput Fd -> String -> RedirSpec
RedirToFileAppend)

-- | Redirects standard input from a file.
(|<) :: RedirFile f => Script () -> f -> Script ()
Script ()
s |< :: forall f. RedirFile f => Script () -> f -> Script ()
|< f
f = Script () -> RedirSpec -> Script ()
redir Script ()
s (forall f.
RedirFile f =>
f -> Fd -> (Fd -> String -> RedirSpec) -> RedirSpec
fileRedir f
f Fd
stdInput Fd -> String -> RedirSpec
RedirFromFile)

-- | Redirects a script's output to stderr.
toStderr :: Script () -> Script ()
toStderr :: Script () -> Script ()
toStderr Script ()
s = Script ()
s Script () -> Fd -> (Script (), Fd)
&Fd
stdOutput(Script (), Fd) -> Fd -> Script ()
>&Fd
stdError

-- | Redirects the first file descriptor to output to the second.
--
-- For example, to redirect a command's stderr to stdout:
--
-- > cmd "foo" &stdError>&stdOutput
(>&) :: (Script (), Fd) -> Fd -> Script ()
(Script ()
s, Fd
fd1) >& :: (Script (), Fd) -> Fd -> Script ()
>& Fd
fd2 = Script () -> RedirSpec -> Script ()
redir Script ()
s (Fd -> Fd -> RedirSpec
RedirOutput Fd
fd1 Fd
fd2)

-- | Redirects the first file descriptor to input from the second.
--
-- For example, to read from Fd 42:
--
-- > cmd "foo" &stdInput<&Fd 42
(<&) :: (Script (), Fd) -> Fd -> Script ()
(Script ()
s, Fd
fd1) <& :: (Script (), Fd) -> Fd -> Script ()
<& Fd
fd2 = Script () -> RedirSpec -> Script ()
redir Script ()
s (Fd -> Fd -> RedirSpec
RedirInput Fd
fd1 Fd
fd2)

-- | Helper for '>&' and '<&'
(&) :: Script () -> Fd -> (Script (), Fd)
& :: Script () -> Fd -> (Script (), Fd)
(&) = (,)

-- | Provides the Text as input to the Script, using a here-document.
hereDocument :: Script () -> L.Text -> Script ()
hereDocument :: Script () -> Text -> Script ()
hereDocument Script ()
s Text
t = Script () -> RedirSpec -> Script ()
redir Script ()
s (Text -> RedirSpec
RedirHereDoc Text
t)

-- | Creates a Script that checks a Test and exits true (0) or false (1).
--
-- Useful with ifCmd, whenCmd, etc; for example:
--
-- > ifCmd (test (FileExists "foo")) (foo, bar)
test :: Test -> Script ()
test :: Test -> Script ()
test Test
t = forall a. (Env -> ([Expr], Env, a)) -> Script a
Script forall a b. (a -> b) -> a -> b
$ \Env
env -> ([Text -> Expr
newCmd forall a b. (a -> b) -> a -> b
$ Text
"test " forall a. Semigroup a => a -> a -> a
<> Env -> Test -> Text
mkTest Env
env Test
t], Env
env, ())

mkTest :: Env -> Test -> L.Text
mkTest :: Env -> Test -> Text
mkTest Env
env = Test -> Text
go
  where
	go :: Test -> Text
go (TNot Test
t) = forall {a}. (Semigroup a, IsString a) => a -> a -> a
unop Text
"!" (Test -> Text
go Test
t)
	go (TAnd Test
t1 Test
t2) = forall {a}. (Semigroup a, IsString a) => a -> a -> a -> a
binop (Test -> Text
go Test
t1) Text
"&&" (Test -> Text
go Test
t2)
	go (TOr Test
t1 Test
t2) = forall {a}. (Semigroup a, IsString a) => a -> a -> a -> a
binop (Test -> Text
go Test
t1) Text
"||" (Test -> Text
go Test
t2)
	go (TEmpty p
p) = forall {a}. (Semigroup a, IsString a) => a -> a -> a
unop Text
"-z" (forall p. Param p => p -> Text
pv p
p)
	go (TNonEmpty p
p) = forall {a}. (Semigroup a, IsString a) => a -> a -> a
unop Text
"-n" (forall p. Param p => p -> Text
pv p
p)
	go (TStrEqual p
p1 q
p2) = forall {a}. (Semigroup a, IsString a) => a -> a -> a -> a
binop (forall p. Param p => p -> Text
pv p
p1) Text
"=" (forall p. Param p => p -> Text
pv q
p2)
	go (TStrNotEqual p
p1 q
p2) = forall {a}. (Semigroup a, IsString a) => a -> a -> a -> a
binop (forall p. Param p => p -> Text
pv p
p1) Text
"!=" (forall p. Param p => p -> Text
pv q
p2)
	go (TEqual Term Var p
p1 Term Var q
p2) = forall {a}. (Semigroup a, IsString a) => a -> a -> a -> a
binop (forall p. Param p => p -> Text
pv Term Var p
p1) Text
"-eq" (forall p. Param p => p -> Text
pv Term Var q
p2)
	go (TNotEqual Term Var p
p1 Term Var q
p2) = forall {a}. (Semigroup a, IsString a) => a -> a -> a -> a
binop (forall p. Param p => p -> Text
pv Term Var p
p1) Text
"-ne" (forall p. Param p => p -> Text
pv Term Var q
p2)
	go (TGT Term Var p
p1 Term Var q
p2) = forall {a}. (Semigroup a, IsString a) => a -> a -> a -> a
binop (forall p. Param p => p -> Text
pv Term Var p
p1) Text
"-gt" (forall p. Param p => p -> Text
pv Term Var q
p2)
	go (TLT Term Var p
p1 Term Var q
p2) = forall {a}. (Semigroup a, IsString a) => a -> a -> a -> a
binop (forall p. Param p => p -> Text
pv Term Var p
p1) Text
"-lt" (forall p. Param p => p -> Text
pv Term Var q
p2)
	go (TGE Term Var p
p1 Term Var q
p2) = forall {a}. (Semigroup a, IsString a) => a -> a -> a -> a
binop (forall p. Param p => p -> Text
pv Term Var p
p1) Text
"-ge" (forall p. Param p => p -> Text
pv Term Var q
p2)
	go (TLE Term Var p
p1 Term Var q
p2) = forall {a}. (Semigroup a, IsString a) => a -> a -> a -> a
binop (forall p. Param p => p -> Text
pv Term Var p
p1) Text
"-le" (forall p. Param p => p -> Text
pv Term Var q
p2)
	go (TFileEqual p
p1 q
p2) = forall {a}. (Semigroup a, IsString a) => a -> a -> a -> a
binop (forall p. Param p => p -> Text
pv p
p1) Text
"-ef" (forall p. Param p => p -> Text
pv q
p2)
	go (TFileNewer p
p1 q
p2) = forall {a}. (Semigroup a, IsString a) => a -> a -> a -> a
binop (forall p. Param p => p -> Text
pv p
p1) Text
"-nt" (forall p. Param p => p -> Text
pv q
p2)
	go (TFileOlder p
p1 q
p2) = forall {a}. (Semigroup a, IsString a) => a -> a -> a -> a
binop (forall p. Param p => p -> Text
pv p
p1) Text
"-ot" (forall p. Param p => p -> Text
pv q
p2)
	go (TBlockExists p
p) = forall {a}. (Semigroup a, IsString a) => a -> a -> a
unop Text
"-b" (forall p. Param p => p -> Text
pv p
p)
	go (TCharExists p
p) = forall {a}. (Semigroup a, IsString a) => a -> a -> a
unop Text
"-c" (forall p. Param p => p -> Text
pv p
p)
	go (TDirExists p
p) = forall {a}. (Semigroup a, IsString a) => a -> a -> a
unop Text
"-d" (forall p. Param p => p -> Text
pv p
p)
	go (TFileExists p
p) = forall {a}. (Semigroup a, IsString a) => a -> a -> a
unop Text
"-e" (forall p. Param p => p -> Text
pv p
p)
	go (TRegularFileExists p
p) = forall {a}. (Semigroup a, IsString a) => a -> a -> a
unop Text
"-f" (forall p. Param p => p -> Text
pv p
p)
	go (TSymlinkExists p
p) = forall {a}. (Semigroup a, IsString a) => a -> a -> a
unop Text
"-L" (forall p. Param p => p -> Text
pv p
p)
	go (TFileNonEmpty p
p) = forall {a}. (Semigroup a, IsString a) => a -> a -> a
unop Text
"-s" (forall p. Param p => p -> Text
pv p
p)
	go (TFileExecutable p
p) = forall {a}. (Semigroup a, IsString a) => a -> a -> a
unop Text
"-x" (forall p. Param p => p -> Text
pv p
p)

	paren :: a -> a
paren a
t = a
"\\( " forall a. Semigroup a => a -> a -> a
<> a
t forall a. Semigroup a => a -> a -> a
<> a
" \\)"
	
	binop :: a -> a -> a -> a
binop a
a a
o a
b = forall {a}. (Semigroup a, IsString a) => a -> a
paren forall a b. (a -> b) -> a -> b
$ a
a forall a. Semigroup a => a -> a -> a
<> a
" " forall a. Semigroup a => a -> a -> a
<> a
o forall a. Semigroup a => a -> a -> a
<> a
" " forall a. Semigroup a => a -> a -> a
<> a
b
	unop :: a -> a -> a
unop a
o a
v = forall {a}. (Semigroup a, IsString a) => a -> a
paren forall a b. (a -> b) -> a -> b
$ a
o forall a. Semigroup a => a -> a -> a
<> a
" " forall a. Semigroup a => a -> a -> a
<> a
v

	pv :: (Param p) => p -> L.Text
	pv :: forall p. Param p => p -> Text
pv = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Param a => a -> Env -> Text
toTextParam Env
env

-- | Note that this should only include things that test(1) and
-- shell built-in test commands support portably.
data Test where
	TNot :: Test -> Test -- negation
	TAnd :: Test -> Test -> Test -- 'and'
	TOr :: Test -> Test -> Test -- 'or'
	TEmpty :: (Param p) => p -> Test
	-- Does the param expand to an empty string?
	TNonEmpty :: (Param p) => p -> Test
	TStrEqual :: (Param p, Param q) => p -> q -> Test
	-- Do the parameters expand to the same string?
	TStrNotEqual :: (Param p, Param q) => p -> q -> Test
	TEqual :: (Integral p, Integral q) => Term Var p -> Term Var q -> Test
	-- Are the Vars equal? (Compares integer to integer, not string-wise.)
	TNotEqual :: (Integral p, Integral q) => Term Var p -> Term Var q -> Test 
	TGT :: (Integral p, Integral q) => Term Var p -> Term Var q -> Test -- '>'
	TLT :: (Integral p, Integral q) => Term Var p -> Term Var q -> Test -- '<'
	TGE :: (Integral p, Integral q) => Term Var p -> Term Var q -> Test -- '>='
	TLE :: (Integral p, Integral q) => Term Var p -> Term Var q -> Test -- '<='
	TFileEqual :: (Param p, Param q) => p -> q -> Test
	-- Are the files equal? (Compares the files' device and inode numbers).
	TFileNewer :: (Param p, Param q) => p -> q -> Test
	-- Does the first file have a newer modification date?
	TFileOlder :: (Param p, Param q) => p -> q -> Test
	TBlockExists :: (Param p) => p -> Test
	-- Does the block device exist?
	TCharExists :: (Param p) => p -> Test
	-- Does the char device exist?
	TDirExists :: (Param p) => p -> Test
	-- Does the directory exist?
	TFileExists :: (Param p) => p -> Test
	-- Does the file exist?
	TRegularFileExists :: (Param p) => p -> Test
	-- Does the file exist and is it a regular file?
	TSymlinkExists :: (Param p) => p -> Test
	-- Does the symlink exist?
	TFileNonEmpty :: (Param p) => p -> Test
	-- Does the file exist and is not empty?
	TFileExecutable :: (Param p) => p -> Test
	-- Does the file exist and is executable?

instance (Show a, Num a) => Num (Term Static a) where
	fromInteger :: Integer -> Term Static a
fromInteger = forall t. Quotable (Val t) => t -> Term Static t
static forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Integer -> a
fromInteger
	(StaticTerm a
a) + :: Term Static a -> Term Static a -> Term Static a
+ (StaticTerm a
b) = forall t. Quotable (Val t) => t -> Term Static t
StaticTerm (a
a forall a. Num a => a -> a -> a
+ a
b)
	(StaticTerm a
a) * :: Term Static a -> Term Static a -> Term Static a
* (StaticTerm a
b) = forall t. Quotable (Val t) => t -> Term Static t
StaticTerm (a
a forall a. Num a => a -> a -> a
* a
b)
	(StaticTerm a
a) - :: Term Static a -> Term Static a -> Term Static a
- (StaticTerm a
b) = forall t. Quotable (Val t) => t -> Term Static t
StaticTerm (a
a forall a. Num a => a -> a -> a
- a
b)
	abs :: Term Static a -> Term Static a
abs (StaticTerm a
a) = forall t. Quotable (Val t) => t -> Term Static t
StaticTerm (forall a. Num a => a -> a
abs a
a)
	signum :: Term Static a -> Term Static a
signum (StaticTerm a
a) = forall t. Quotable (Val t) => t -> Term Static t
StaticTerm (forall a. Num a => a -> a
signum a
a)

-- | Lifts a Term to Arith.
val :: Term t Integer -> Arith
val :: forall t. Term t Integer -> Arith
val t :: Term t Integer
t@(VarTerm UntypedVar
_) = Term Var Integer -> Arith
AVar Term t Integer
t
val t :: Term t Integer
t@(StaticTerm Integer
_) = Term Static Integer -> Arith
AStatic Term t Integer
t

-- | This data type represents shell Arithmetic Expressions.
--
-- Note that in shell arithmetic, expressions that would evaluate to a
-- Bool, such as ANot and AEqual instead evaluate to 1 for True and 0 for
-- False.
-- 
data Arith
	= ANum Integer
	| AVar (Term Var Integer)
	| AStatic (Term Static Integer)
	| ANegate Arith -- ^ negation
	| APlus Arith Arith -- ^ '+'
	| AMinus Arith Arith -- ^ '-'
	| AMult Arith Arith -- ^ '*'
	| ADiv Arith Arith -- ^ '/'
	| AMod Arith Arith -- ^ 'mod'
	| ANot Arith -- ^ 'not'
	| AOr Arith Arith -- ^ 'or'
	| AAnd Arith Arith -- ^ 'and'
	| AEqual Arith Arith -- ^ '=='
	| ANotEqual Arith Arith -- ^ '/='
	| ALT Arith Arith -- ^ '<'
	| AGT Arith Arith -- ^ '>'
	| ALE Arith Arith -- ^ '<='
	| AGE Arith Arith -- ^ '>='
	| ABitOr Arith Arith -- ^ OR of the bits of the two arguments
	| ABitXOr Arith Arith -- ^ XOR of the bits of the two arguments
	| ABitAnd Arith Arith -- ^ AND of the bits of the two arguments
	| AShiftLeft Arith Arith -- ^ shift left (first argument's bits are shifted by the value of the second argument)
	| AShiftRight Arith Arith -- ^ shift right
	| AIf Arith (Arith, Arith) -- ^ if the first argument is non-zero, the result is the second, else the result is the third

fmtArith :: Env -> Arith -> L.Text
fmtArith :: Env -> Arith -> Text
fmtArith Env
env Arith
arith = Text
"$(( " forall a. Semigroup a => a -> a -> a
<> Arith -> Text
go Arith
arith forall a. Semigroup a => a -> a -> a
<> Text
" ))"
  where
	go :: Arith -> Text
go (ANum Integer
i) = String -> Text
L.pack (forall a. Show a => a -> String
show Integer
i)
	-- shell variable must be expanded without quotes
	go (AVar (VarTerm UntypedVar
v)) = forall a. Quoted a -> a
getQ forall a b. (a -> b) -> a -> b
$ UntypedVar -> Env -> VarName -> Quoted Text
expandVar UntypedVar
v Env
env (UntypedVar -> VarName
varName UntypedVar
v)
	go (AStatic (StaticTerm Integer
v)) = forall a. Quoted a -> a
getQ forall a b. (a -> b) -> a -> b
$ forall t. Quotable t => t -> Quoted Text
quote forall a b. (a -> b) -> a -> b
$ forall v. v -> Val v
Val Integer
v
	go (ANegate Arith
v) = Text -> Arith -> Text
unop Text
"-" Arith
v
	go (APlus Arith
a Arith
b) = Arith -> Text -> Arith -> Text
binop Arith
a Text
"+" Arith
b
	go (AMinus Arith
a Arith
b) = Arith -> Text -> Arith -> Text
binop Arith
a Text
"-" Arith
b
	go (AMult Arith
a Arith
b) = Arith -> Text -> Arith -> Text
binop Arith
a Text
"*" Arith
b
	go (ADiv Arith
a Arith
b) = Arith -> Text -> Arith -> Text
binop Arith
a Text
"/" Arith
b
	go (AMod Arith
a Arith
b) = Arith -> Text -> Arith -> Text
binop Arith
a Text
"%" Arith
b
	go (ANot Arith
v) = Text -> Arith -> Text
unop Text
"!" Arith
v
	go (AOr Arith
a Arith
b) = Arith -> Text -> Arith -> Text
binop Arith
a Text
"||" Arith
b
	go (AAnd Arith
a Arith
b) = Arith -> Text -> Arith -> Text
binop Arith
a Text
"&&" Arith
b
	go (AEqual Arith
a Arith
b) = Arith -> Text -> Arith -> Text
binop Arith
a Text
"==" Arith
b
	go (ANotEqual Arith
a Arith
b) = Arith -> Text -> Arith -> Text
binop Arith
a Text
"!=" Arith
b
	go (ALT Arith
a Arith
b) = Arith -> Text -> Arith -> Text
binop Arith
a Text
"<" Arith
b
	go (AGT Arith
a Arith
b) = Arith -> Text -> Arith -> Text
binop Arith
a Text
">" Arith
b
	go (ALE Arith
a Arith
b) = Arith -> Text -> Arith -> Text
binop Arith
a Text
"<=" Arith
b
	go (AGE Arith
a Arith
b) = Arith -> Text -> Arith -> Text
binop Arith
a Text
">=" Arith
b
	go (ABitOr Arith
a Arith
b) = Arith -> Text -> Arith -> Text
binop Arith
a Text
"|" Arith
b
	go (ABitXOr Arith
a Arith
b) = Arith -> Text -> Arith -> Text
binop Arith
a Text
"^" Arith
b
	go (ABitAnd Arith
a Arith
b) = Arith -> Text -> Arith -> Text
binop Arith
a Text
"&" Arith
b
	go (AShiftLeft Arith
a Arith
b) = Arith -> Text -> Arith -> Text
binop Arith
a Text
"<<" Arith
b
	go (AShiftRight Arith
a Arith
b) = Arith -> Text -> Arith -> Text
binop Arith
a Text
">>" Arith
b
	go (AIf Arith
c (Arith
a, Arith
b)) = forall {a}. (Semigroup a, IsString a) => a -> a
paren forall a b. (a -> b) -> a -> b
$ Arith -> Text
go Arith
c forall a. Semigroup a => a -> a -> a
<> Text
" ? " forall a. Semigroup a => a -> a -> a
<> Arith -> Text
go Arith
a forall a. Semigroup a => a -> a -> a
<> Text
" : " forall a. Semigroup a => a -> a -> a
<> Arith -> Text
go Arith
b

	paren :: a -> a
paren a
t = a
"(" forall a. Semigroup a => a -> a -> a
<> a
t forall a. Semigroup a => a -> a -> a
<> a
")"

	binop :: Arith -> Text -> Arith -> Text
binop Arith
a Text
o Arith
b = forall {a}. (Semigroup a, IsString a) => a -> a
paren forall a b. (a -> b) -> a -> b
$ Arith -> Text
go Arith
a forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
o forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Arith -> Text
go Arith
b
	unop :: Text -> Arith -> Text
unop Text
o Arith
v = forall {a}. (Semigroup a, IsString a) => a -> a
paren forall a b. (a -> b) -> a -> b
$ Text
o forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Arith -> Text
go Arith
v

-- | Arith is an instance of Num, which allows you to write expressions
-- like this with shell variables, that generate Arithmetic Expressions.
--
-- > val x * (100 + val y)
instance Num Arith where
	fromInteger :: Integer -> Arith
fromInteger = Integer -> Arith
ANum
	+ :: Arith -> Arith -> Arith
(+) = Arith -> Arith -> Arith
APlus
	* :: Arith -> Arith -> Arith
(*) = Arith -> Arith -> Arith
AMult
	(-) = Arith -> Arith -> Arith
AMinus
	negate :: Arith -> Arith
negate = Arith -> Arith
ANegate
	abs :: Arith -> Arith
abs Arith
v = Arith -> (Arith, Arith) -> Arith
AIf (Arith
v Arith -> Arith -> Arith
`ALT` Integer -> Arith
ANum Integer
0)
		( Arith -> Arith -> Arith
AMult Arith
v (Integer -> Arith
ANum (-Integer
1))
		, Arith
v
		)
	signum :: Arith -> Arith
signum Arith
v = 
		Arith -> (Arith, Arith) -> Arith
AIf (Arith
v Arith -> Arith -> Arith
`ALT` Integer -> Arith
ANum Integer
0)
			( Integer -> Arith
ANum (-Integer
1)
			, Arith -> (Arith, Arith) -> Arith
AIf (Arith
v Arith -> Arith -> Arith
`AGT` Integer -> Arith
ANum Integer
0)
				( Integer -> Arith
ANum Integer
1
				, Integer -> Arith
ANum Integer
0
				)
			)

-- | Note that 'fromEnum', 'enumFromTo', and 'enumFromThenTo' cannot be used
-- with Arith.
instance Enum Arith where
	succ :: Arith -> Arith
succ Arith
a = Arith -> Arith -> Arith
APlus Arith
a (Integer -> Arith
ANum Integer
1)
	pred :: Arith -> Arith
pred Arith
a = Arith -> Arith -> Arith
AMinus Arith
a (Integer -> Arith
ANum Integer
1)
	toEnum :: Indent -> Arith
toEnum = Integer -> Arith
ANum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
	enumFrom :: Arith -> [Arith]
enumFrom Arith
a = Arith
a forall a. a -> [a] -> [a]
: forall a. Enum a => a -> [a]
enumFrom (forall a. Enum a => a -> a
succ Arith
a)
	enumFromThen :: Arith -> Arith -> [Arith]
enumFromThen Arith
a Arith
b = Arith
a forall a. a -> [a] -> [a]
: forall a. Enum a => a -> a -> [a]
enumFromThen Arith
b ((Arith
b Arith -> Arith -> Arith
`AMult` Integer -> Arith
ANum Integer
2) Arith -> Arith -> Arith
`AMinus` Arith
a)
	fromEnum :: Arith -> Indent
fromEnum = forall a. HasCallStack => String -> a
error String
"fromEnum not implemented for Arith"
	enumFromTo :: Arith -> Arith -> [Arith]
enumFromTo = forall a. HasCallStack => String -> a
error String
"enumFromTo not implemented for Arith"
	enumFromThenTo :: Arith -> Arith -> Arith -> [Arith]
enumFromThenTo = forall a. HasCallStack => String -> a
error String
"enumFromToThen not implemented for Arith"