-- | 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
(VarName -> VarName -> Bool)
-> (VarName -> VarName -> Bool) -> Eq VarName
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
Eq VarName
-> (VarName -> VarName -> Ordering)
-> (VarName -> VarName -> Bool)
-> (VarName -> VarName -> Bool)
-> (VarName -> VarName -> Bool)
-> (VarName -> VarName -> Bool)
-> (VarName -> VarName -> VarName)
-> (VarName -> VarName -> VarName)
-> Ord 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
$cp1Ord :: Eq VarName
Ord, Int -> VarName -> ShowS
[VarName] -> ShowS
VarName -> String
(Int -> VarName -> ShowS)
-> (VarName -> String) -> ([VarName] -> ShowS) -> Show VarName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VarName] -> ShowS
$cshowList :: [VarName] -> ShowS
show :: VarName -> String
$cshow :: VarName -> String
showsPrec :: Int -> VarName -> ShowS
$cshowsPrec :: Int -> VarName -> ShowS
Show)

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

simpleVar' :: VarName -> UntypedVar
simpleVar' :: VarName -> UntypedVar
simpleVar' VarName
name = V :: VarName -> (Env -> VarName -> Quoted Text) -> UntypedVar
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) -> Text -> Quoted Text
forall a. a -> Quoted a
Q (Text
"$" Text -> Text -> 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 = Text -> Quoted Text
forall a. a -> Quoted a
Q (Text -> Quoted Text) -> (Text -> Text) -> Text -> Quoted Text
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 Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"*?[!-:]\\" :: String) = Char -> Text
L.singleton Char
c
		| Bool
otherwise = Text
"\\" Text -> Text -> 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
(Func -> Func -> Bool) -> (Func -> Func -> Bool) -> Eq Func
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
Eq Func
-> (Func -> Func -> Ordering)
-> (Func -> Func -> Bool)
-> (Func -> Func -> Bool)
-> (Func -> Func -> Bool)
-> (Func -> Func -> Bool)
-> (Func -> Func -> Func)
-> (Func -> Func -> Func)
-> Ord 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
$cp1Ord :: Eq Func
Ord, Int -> Func -> ShowS
[Func] -> ShowS
Func -> String
(Int -> Func -> ShowS)
-> (Func -> String) -> ([Func] -> ShowS) -> Show Func
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Func] -> ShowS
$cshowList :: [Func] -> ShowS
show :: Func -> String
$cshow :: Func -> String
showsPrec :: Int -> Func -> ShowS
$cshowsPrec :: Int -> 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) = UntypedVar -> Text
forall t. Named t => t -> Text
getName UntypedVar
v

instance Named UntypedVar where
	getName :: UntypedVar -> Text
getName = VarName -> Text
forall t. Named t => t -> Text
getName (VarName -> Text) -> (UntypedVar -> VarName) -> UntypedVar -> Text
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 Int
i [LocalEnv]
localenvs Text
t) = Int -> [LocalEnv] -> Text -> Expr
Cmd (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [LocalEnv]
localenvs Text
t
indent (Raw Int
i Text
t) = Int -> Text -> Expr
Raw (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
t
indent (EnvWrap Int
i Text
n [LocalEnv]
localenvs [Expr]
e) = Int -> Text -> [LocalEnv] -> [Expr] -> Expr
EnvWrap (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
n [LocalEnv]
localenvs ((Expr -> Expr) -> [Expr] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> Expr
indent [Expr]
e)
indent (Comment Text
t) = Text -> Expr
Comment (Text -> Expr) -> Text -> Expr
forall a b. (a -> b) -> a -> b
$ Text
"\t" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
indent (Subshell Text
i [Expr]
l) = Text -> [Expr] -> Expr
Subshell (Text
"\t" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
i) ((Expr -> Expr) -> [Expr] -> [Expr]
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" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
i) ((Expr -> Expr) -> [Expr] -> [Expr]
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 (a -> Script b -> Script a
(a -> b) -> Script a -> Script b
(forall a b. (a -> b) -> Script a -> Script b)
-> (forall a b. a -> Script b -> Script a) -> Functor Script
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
<$ :: a -> Script b -> Script a
$c<$ :: forall a b. a -> Script b -> Script a
fmap :: (a -> b) -> Script a -> Script b
$cfmap :: forall a b. (a -> b) -> Script a -> Script b
Functor)

instance Applicative Script where
	pure :: a -> Script a
pure a
a = (Env -> ([Expr], Env, a)) -> Script a
forall a. (Env -> ([Expr], Env, a)) -> Script a
Script ((Env -> ([Expr], Env, a)) -> Script a)
-> (Env -> ([Expr], Env, a)) -> Script a
forall a b. (a -> b) -> a -> b
$ \Env
env -> ([], Env
env, a
a)
	Script Env -> ([Expr], Env, a -> b)
f <*> :: Script (a -> b) -> Script a -> Script b
<*> Script Env -> ([Expr], Env, a)
a = (Env -> ([Expr], Env, b)) -> Script b
forall a. (Env -> ([Expr], Env, a)) -> Script a
Script ((Env -> ([Expr], Env, b)) -> Script b)
-> (Env -> ([Expr], Env, b)) -> Script b
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 [Expr] -> [Expr] -> [Expr]
forall a. Semigroup a => a -> a -> a
<> [Expr]
expr2, Env
env2, a -> b
f' a
a')

instance Monad Script where
	Script a
a >>= :: Script a -> (a -> Script b) -> Script b
>>= a -> Script b
b = (Env -> ([Expr], Env, b)) -> Script b
forall a. (Env -> ([Expr], Env, a)) -> Script a
Script ((Env -> ([Expr], Env, b)) -> Script b)
-> (Env -> ([Expr], Env, b)) -> Script b
forall a b. (a -> b) -> a -> b
$ \Env
start -> let
		([Expr]
left, Env
mid, a
v) = Script a -> Env -> ([Expr], Env, a)
forall f. Script f -> Env -> ([Expr], Env, f)
call Script a
a Env
start
		([Expr]
right, Env
end, b
ret) = Script b -> Env -> ([Expr], Env, b)
forall f. Script f -> Env -> ([Expr], Env, f)
call (a -> Script b
b a
v) Env
mid
		in ([Expr]
left [Expr] -> [Expr] -> [Expr]
forall a. [a] -> [a] -> [a]
++ [Expr]
right, Env
end, b
ret)
	  where
		call :: Script f -> Env -> ([Expr], Env, f)
		call :: 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 Set VarName -> Set VarName -> Set VarName
forall a. Semigroup a => a -> a -> a
<> Env -> Set VarName
envVars Env
b) (Env -> Set Func
envFuncs Env
a Set Func -> Set Func -> Set Func
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 Set VarName
forall a. Monoid a => a
mempty Set Func
forall a. Monoid a => a
mempty

getEnv :: Script Env
getEnv :: Script Env
getEnv = (Env -> ([Expr], Env, Env)) -> Script Env
forall a. (Env -> ([Expr], Env, a)) -> Script a
Script ((Env -> ([Expr], Env, Env)) -> Script Env)
-> (Env -> ([Expr], Env, Env)) -> Script Env
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 :: Script f -> [Expr]
gen = ([Expr], Env) -> [Expr]
forall a b. (a, b) -> a
fst (([Expr], Env) -> [Expr])
-> (Script f -> ([Expr], Env)) -> Script f -> [Expr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env -> Script f -> ([Expr], Env)
forall f. Env -> Script f -> ([Expr], Env)
runScript Env
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 :: 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 = (Env -> ([Expr], Env, [Expr])) -> Script [Expr]
forall a. (Env -> ([Expr], Env, a)) -> Script a
Script ((Env -> ([Expr], Env, [Expr])) -> Script [Expr])
-> (Env -> ([Expr], Env, [Expr])) -> Script [Expr]
forall a b. (a -> b) -> a -> b
$ \Env
env -> 
	let ([Expr]
r, Env
env') = Env -> Script () -> ([Expr], 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 :: Script f -> Text
script = (Text -> Text -> Text) -> Text -> Text -> Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend Text
"\n" (Text -> Text) -> (Script f -> Text) -> Script f -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
L.intercalate Text
"\n" ([Text] -> Text) -> (Script f -> [Text]) -> Script f -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
	(Text
"#!/bin/sh"Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:) ([Text] -> [Text]) -> (Script f -> [Text]) -> Script f -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expr -> Text) -> [Expr] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Expr -> Text
fmt Bool
True) ([Expr] -> [Text]) -> (Script f -> [Expr]) -> Script f -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script f -> [Expr]
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
" " ([Text] -> Text) -> ([LocalEnv] -> [Text]) -> [LocalEnv] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LocalEnv -> Text) -> [LocalEnv] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
k, Text
v) -> Text
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
v)

	go :: Expr -> Text
go (Cmd Int
i [] Text
t) = String -> Text
L.pack (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
i Char
'\t') Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
	go (Cmd Int
i [LocalEnv]
localenvs Text
t) = String -> Text
L.pack (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
i Char
'\t') Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [LocalEnv] -> Text
fmtlocalenvs [LocalEnv]
localenvs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
	go (Raw Int
i Text
t) = String -> Text
L.pack (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
i Char
'\t') Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
	go (EnvWrap Int
i Text
n [LocalEnv]
localenvs [Expr]
e) =
		let (Text
lp, Text
sep) = if Bool
multiline
			then (String -> Text
L.pack (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
i Char
'\t'), Text
"\n")
			else (Text
"", Text
";")
		in Text
lp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"() { : " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sep
		   Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
L.intercalate Text
sep ((Expr -> Text) -> [Expr] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Expr -> Text
go (Expr -> Text) -> (Expr -> Expr) -> Expr -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Expr
indent) [Expr]
e) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sep
		   Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
lp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sep
		   Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
lp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [LocalEnv] -> Text
fmtlocalenvs [LocalEnv]
localenvs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> 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
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Quoted Text -> Text
forall a. Quoted a -> a
getQ (Text -> Quoted Text
forall t. Quotable t => t -> Quoted Text
quote ((Char -> Bool) -> Text -> Text
L.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') Text
t))
	go (Subshell Text
i []) = Text
i Text -> Text -> Text
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 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
wrap Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
L.intercalate Text
sep ((Expr -> Text) -> [Expr] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Expr -> Text
go (Expr -> Text) -> (Expr -> Expr) -> Expr -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Expr
indent) [Expr]
l) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
wrap Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
i Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
	go (Group Text
i []) = Text
i Text -> Text -> Text
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 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
wrap Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
L.intercalate Text
sep ((Expr -> Text) -> [Expr] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Expr -> Text
go (Expr -> Text) -> (Expr -> Expr) -> Expr -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Expr
indent) [Expr]
l) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
end Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
wrap Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
i Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
	go (Pipe Expr
e1 Expr
e2) = Expr -> Text
go Expr
e1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" | " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr -> Text
go Expr
e2
	go (And Expr
e1 Expr
e2) = Expr -> Text
go Expr
e1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" && " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr -> Text
go Expr
e2
	go (Or Expr
e1 Expr
e2) = Expr -> Text
go Expr
e1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" || " Text -> Text -> 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 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t in case RedirSpec
r of
		(RedirToFile Fd
fd String
f) ->
			Text -> Text
use (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Fd -> Maybe Fd -> Text
redirFd Fd
fd (Fd -> Maybe Fd
forall a. a -> Maybe a
Just Fd
stdOutput) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"> " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Quoted Text -> Text
forall a. Quoted a -> a
getQ (Text -> Quoted Text
forall t. Quotable t => t -> Quoted Text
quote (String -> Text
L.pack String
f))
		(RedirToFileAppend Fd
fd String
f) ->
			Text -> Text
use (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Fd -> Maybe Fd -> Text
redirFd Fd
fd (Fd -> Maybe Fd
forall a. a -> Maybe a
Just Fd
stdOutput) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">> " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Quoted Text -> Text
forall a. Quoted a -> a
getQ (Text -> Quoted Text
forall t. Quotable t => t -> Quoted Text
quote (String -> Text
L.pack String
f))
		(RedirFromFile Fd
fd String
f) ->
			Text -> Text
use (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Fd -> Maybe Fd -> Text
redirFd Fd
fd (Fd -> Maybe Fd
forall a. a -> Maybe a
Just Fd
stdInput) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"< " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Quoted Text -> Text
forall a. Quoted a -> a
getQ (Text -> Quoted Text
forall t. Quotable t => t -> Quoted Text
quote (String -> Text
L.pack String
f))
		(RedirOutput Fd
fd1 Fd
fd2) ->
			Text -> Text
use (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Fd -> Maybe Fd -> Text
redirFd Fd
fd1 (Fd -> Maybe Fd
forall a. a -> Maybe a
Just Fd
stdOutput) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">&" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Fd -> Text
showFd Fd
fd2
		(RedirInput Fd
fd1 Fd
fd2) ->
			Text -> Text
use (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Fd -> Maybe Fd -> Text
redirFd Fd
fd1 (Fd -> Maybe Fd
forall a. a -> Maybe a
Just Fd
stdInput) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"<&" Text -> Text -> 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 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
"<<" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
myEOF Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
					Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t 
					Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" 
					Text -> Text -> Text
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 ([Expr] -> Expr) -> [Expr] -> Expr
forall a b. (a -> b) -> a -> b
$
					((Text -> Expr) -> [Text] -> [Expr])
-> [Text] -> (Text -> Expr) -> [Expr]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Text -> Expr) -> [Text] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> [Text]
L.lines Text
t) ((Text -> Expr) -> [Expr]) -> (Text -> Expr) -> [Expr]
forall a b. (a -> b) -> a -> b
$ \Text
l -> Text -> Expr
raw (Text -> Expr) -> Text -> Expr
forall a b. (a -> b) -> a -> b
$ 
						Text
"echo " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Quoted Text -> Text
forall a. Quoted a -> a
getQ (Text -> Quoted Text
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
	| Fd -> Maybe Fd
forall a. a -> Maybe a
Just Fd
fd Maybe Fd -> Maybe Fd -> Bool
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 (String -> Text) -> (Fd -> String) -> Fd -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fd -> String
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" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 then Text
"" else String -> Text
L.pack (Integer -> String
forall a. Show a => a -> String
show Integer
n)
		in if Text
marker Text -> Text -> Bool
`L.isInfixOf` Text
t
			then Integer -> Text
go (Integer -> Integer
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 :: Script f -> Text
linearScript = [Expr] -> Text
toLinearScript ([Expr] -> Text) -> (Script f -> [Expr]) -> Script f -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script f -> [Expr]
forall f. Script f -> [Expr]
gen

toLinearScript :: [Expr] -> L.Text
toLinearScript :: [Expr] -> Text
toLinearScript = Text -> [Text] -> Text
L.intercalate Text
"; " ([Text] -> Text) -> ([Expr] -> [Text]) -> [Expr] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expr -> Text) -> [Expr] -> [Text]
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 (Expr -> Script ()) -> Expr -> Script ()
forall a b. (a -> b) -> a -> b
$ Text -> Expr
newCmd (Text -> Expr) -> Text -> Expr
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
L.intercalate Text
" " ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Quoted Text -> Text
forall a. Quoted a -> a
getQ (Quoted Text -> Text) -> (Text -> Quoted Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Quoted Text
forall t. Quotable t => t -> Quoted Text
quote) (Text
cText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
ps))

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

raw :: L.Text -> Expr
raw :: Text -> Expr
raw Text
l = Int -> Text -> Expr
Raw Int
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 :: command -> params
cmd command
c = (Env -> Text) -> [Env -> Text] -> params
forall t. CmdParams t => (Env -> Text) -> [Env -> Text] -> t
cmdAll (command -> Env -> Text
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 = Text -> Env -> Text
forall a b. a -> b -> a
const (Text -> Env -> Text) -> (Text -> Text) -> Text -> Env -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Quoted Text -> Text
forall a. Quoted a -> a
getQ (Quoted Text -> Text) -> (Text -> Quoted Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Quoted Text
forall t. Quotable t => t -> Quoted Text
quote

-- | String arguments are automatically quoted.
instance Param String where
	toTextParam :: String -> Env -> Text
toTextParam = Text -> Env -> Text
forall a. Param a => a -> Env -> Text
toTextParam (Text -> Env -> Text) -> (String -> Text) -> String -> Env -> Text
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
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Quoted Text -> Text
forall a. Quoted a -> a
getQ (UntypedVar -> Env -> VarName -> Quoted Text
expandVar UntypedVar
v Env
env (UntypedVar -> VarName
varName UntypedVar
v)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""

instance Param (Term Var a) where
	toTextParam :: Term Var a -> Env -> Text
toTextParam (VarTerm UntypedVar
v) = UntypedVar -> Env -> Text
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) = Quoted Text -> Env -> Text
forall a. Param a => a -> Env -> Text
toTextParam (Quoted Text -> Env -> Text) -> Quoted Text -> Env -> Text
forall a b. (a -> b) -> a -> b
$ Val a -> Quoted Text
forall t. Quotable t => t -> Quoted Text
quote (Val a -> Quoted Text) -> Val a -> Quoted Text
forall a b. (a -> b) -> a -> b
$ a -> Val a
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) = Quoted Text -> Text
forall a. Quoted a -> a
getQ (Quoted Text -> Text) -> (Env -> Quoted Text) -> Env -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Quoted Text -> Quoted Text
f (Quoted Text -> Quoted Text)
-> (Env -> Quoted Text) -> Env -> Quoted Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Quoted Text
forall a. a -> Quoted a
Q (Text -> Quoted Text) -> (Env -> Text) -> Env -> Quoted Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term Var a -> Env -> Text
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) = Text -> Env -> Text
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 ([Expr] -> Text) -> [Expr] -> Text
forall a b. (a -> b) -> a -> b
$ ([Expr], Env) -> [Expr]
forall a b. (a, b) -> a
fst (([Expr], Env) -> [Expr]) -> ([Expr], Env) -> [Expr]
forall a b. (a -> b) -> a -> b
$ Env -> Script () -> ([Expr], Env)
forall f. Env -> Script f -> ([Expr], Env)
runScript Env
env Script ()
s
		in Text
"\"$(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
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
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
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 = (Env -> Text) -> [Env -> Text] -> result
forall t. CmdParams t => (Env -> Text) -> [Env -> Text] -> t
cmdAll Env -> Text
c (arg -> Env -> Text
forall a. Param a => a -> Env -> Text
toTextParam arg
x (Env -> Text) -> [Env -> Text] -> [Env -> Text]
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 = (Env -> ([Expr], Env, ())) -> Script ()
forall a. (Env -> ([Expr], Env, a)) -> Script a
Script ((Env -> ([Expr], Env, ())) -> Script ())
-> (Env -> ([Expr], Env, ())) -> Script ()
forall a b. (a -> b) -> a -> b
$ \Env
env -> 
		let ps :: [Text]
ps = ((Env -> Text) -> Text) -> [Env -> Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\Env -> Text
f -> Env -> Text
f Env
env) (Env -> Text
c (Env -> Text) -> [Env -> Text] -> [Env -> Text]
forall a. a -> [a] -> [a]
: [Env -> Text] -> [Env -> Text]
forall a. [a] -> [a]
reverse [Env -> Text]
acc)
		in ([Text -> Expr
newCmd (Text -> Expr) -> Text -> Expr
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 = (Env -> ([Expr], Env, ())) -> Script ()
forall a. (Env -> ([Expr], Env, a)) -> Script a
Script ((Env -> ([Expr], Env, ())) -> Script ())
-> (Env -> ([Expr], Env, ())) -> 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 (Expr -> Script ()) -> (Text -> Expr) -> Text -> Script ()
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 :: (Maybe Text -> a) -> () -> a
hinted Maybe Text -> a
f ()
_ = Maybe Text -> a
f Maybe Text
forall a. Maybe a
Nothing

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

instance NameHinted (Maybe L.Text) where
	hinted :: (Maybe Text -> a) -> Maybe Text -> a
hinted = (Maybe Text -> a) -> Maybe Text -> a
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 :: t -> Term Static t
static = t -> Term Static t
forall a. Quotable (Val a) => a -> Term Static a
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 a. namehint -> Script (Term Var a)
newVar = Text -> namehint -> Script (Term Var a)
forall namehint t.
NameHinted namehint =>
Text -> namehint -> Script (Term Var t)
newVarContaining' Text
""

newVarContaining' :: (NameHinted namehint) => L.Text -> namehint -> Script (Term Var t)
newVarContaining' :: Text -> namehint -> Script (Term Var t)
newVarContaining' Text
value = (Maybe Text -> Script (Term Var t))
-> namehint -> Script (Term Var t)
forall h a. NameHinted h => (Maybe Text -> a) -> h -> a
hinted ((Maybe Text -> Script (Term Var t))
 -> namehint -> Script (Term Var t))
-> (Maybe Text -> Script (Term Var t))
-> namehint
-> Script (Term Var t)
forall a b. (a -> b) -> a -> b
$ \Maybe Text
namehint -> do
	Term Var t
v <- Maybe Text -> Script (Term Var t)
forall namehint a.
NameHinted namehint =>
namehint -> Script (Term Var a)
newVarUnsafe Maybe Text
namehint
	(Env -> ([Expr], Env, Term Var t)) -> Script (Term Var t)
forall a. (Env -> ([Expr], Env, a)) -> Script a
Script ((Env -> ([Expr], Env, Term Var t)) -> Script (Term Var t))
-> (Env -> ([Expr], Env, Term Var t)) -> Script (Term Var t)
forall a b. (a -> b) -> a -> b
$ \Env
env -> ([Text -> Expr
raw (Term Var t -> Text
forall t. Named t => t -> Text
getName Term Var t
v Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=" Text -> Text -> 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 :: param -> namehint -> Script (Term Var t)
newVarFrom param
param namehint
namehint = do
	Term Var t
v <- namehint -> Script (Term Var t)
forall namehint a.
NameHinted namehint =>
namehint -> Script (Term Var a)
newVarUnsafe namehint
namehint
	(Env -> ([Expr], Env, Term Var t)) -> Script (Term Var t)
forall a. (Env -> ([Expr], Env, a)) -> Script a
Script ((Env -> ([Expr], Env, Term Var t)) -> Script (Term Var t))
-> (Env -> ([Expr], Env, Term Var t)) -> Script (Term Var t)
forall a b. (a -> b) -> a -> b
$ \Env
env ->
		([Text -> Expr
raw (Term Var t -> Text
forall t. Named t => t -> Text
getName Term Var t
v Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> param -> Env -> Text
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 :: t -> namehint -> Script (Term Var t)
newVarContaining = Text -> namehint -> Script (Term Var t)
forall namehint t.
NameHinted namehint =>
Text -> namehint -> Script (Term Var t)
newVarContaining' (Text -> namehint -> Script (Term Var t))
-> (t -> Text) -> t -> namehint -> Script (Term Var t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Quoted Text -> Text
forall a. Quoted a -> a
getQ (Quoted Text -> Text) -> (t -> Quoted Text) -> t -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Val t -> Quoted Text
forall t. Quotable t => t -> Quoted Text
quote (Val t -> Quoted Text) -> (t -> Val t) -> t -> Quoted Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Val t
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 a. Term Var a -> param -> Script ()
setVar Term Var a
v param
p = (Env -> ([Expr], Env, ())) -> Script ()
forall a. (Env -> ([Expr], Env, a)) -> Script a
Script ((Env -> ([Expr], Env, ())) -> Script ())
-> (Env -> ([Expr], Env, ())) -> Script ()
forall a b. (a -> b) -> a -> b
$ \Env
env -> 
	([Text -> Expr
raw (Term Var a -> Text
forall t. Named t => t -> Text
getName Term Var a
v Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> param -> Env -> Text
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 :: Text -> Script (Term Var a)
globalVar Text
name = (Env -> ([Expr], Env, Term Var a)) -> Script (Term Var a)
forall a. (Env -> ([Expr], Env, a)) -> Script a
Script ((Env -> ([Expr], Env, Term Var a)) -> Script (Term Var a))
-> (Env -> ([Expr], Env, Term Var a)) -> Script (Term Var a)
forall a b. (a -> b) -> a -> b
$ \Env
env ->
	let v :: Term Var a
v = VarName -> Term Var a
forall a. VarName -> Term Var a
simpleVar (Text -> VarName
VarName Text
name)
	in ([], Env -> (Set VarName -> Set VarName) -> Env
modifyEnvVars Env
env (VarName -> Set VarName -> Set VarName
forall a. Ord a => a -> Set a -> Set a
S.insert (Text -> VarName
VarName (Term Var a -> Text
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 :: Term Var a
positionalParameters = VarName -> Term Var a
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 a. namehint -> Script (Term Var a)
takeParameter = (Maybe Text -> Script (Term Var a))
-> namehint -> Script (Term Var a)
forall h a. NameHinted h => (Maybe Text -> a) -> h -> a
hinted ((Maybe Text -> Script (Term Var a))
 -> namehint -> Script (Term Var a))
-> (Maybe Text -> Script (Term Var a))
-> namehint
-> Script (Term Var a)
forall a b. (a -> b) -> a -> b
$ \Maybe Text
namehint -> do
	Term Var a
p <- Maybe Text -> Script (Term Var a)
forall namehint a.
NameHinted namehint =>
namehint -> Script (Term Var a)
newVarUnsafe Maybe Text
namehint
	(Env -> ([Expr], Env, Term Var a)) -> Script (Term Var a)
forall a. (Env -> ([Expr], Env, a)) -> Script a
Script ((Env -> ([Expr], Env, Term Var a)) -> Script (Term Var a))
-> (Env -> ([Expr], Env, Term Var a)) -> Script (Term Var a)
forall a b. (a -> b) -> a -> b
$ \Env
env -> ([Text -> Expr
raw (Term Var a -> Text
forall t. Named t => t -> Text
getName Term Var a
p Text -> Text -> Text
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 a. namehint -> Script (Term Var a)
newVarUnsafe namehint
hint = UntypedVar -> Term Var a
forall a. UntypedVar -> Term Var a
VarTerm (UntypedVar -> Term Var a)
-> Script UntypedVar -> Script (Term Var a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> namehint -> Script UntypedVar
forall namehint.
NameHinted namehint =>
namehint -> Script UntypedVar
newVarUnsafe' namehint
hint

newVarUnsafe' :: (NameHinted namehint) => namehint -> Script UntypedVar
newVarUnsafe' :: namehint -> Script UntypedVar
newVarUnsafe' = (Maybe Text -> Script UntypedVar) -> namehint -> Script UntypedVar
forall h a. NameHinted h => (Maybe Text -> a) -> h -> a
hinted ((Maybe Text -> Script UntypedVar)
 -> namehint -> Script UntypedVar)
-> (Maybe Text -> Script UntypedVar)
-> namehint
-> Script UntypedVar
forall a b. (a -> b) -> a -> b
$ \Maybe Text
namehint -> (Env -> ([Expr], Env, UntypedVar)) -> Script UntypedVar
forall a. (Env -> ([Expr], Env, a)) -> Script a
Script ((Env -> ([Expr], Env, UntypedVar)) -> Script UntypedVar)
-> (Env -> ([Expr], Env, UntypedVar)) -> Script UntypedVar
forall a b. (a -> b) -> a -> b
$ \Env
env ->
	let name :: VarName
name = Maybe Text -> Env -> Integer -> VarName
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 (VarName -> Set VarName -> Set VarName
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
		| VarName -> Set VarName -> Bool
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 (t -> t
forall a. Enum a => a -> a
succ t
x)
		| Bool
otherwise = VarName
name
	  where
		name :: VarName
name = Text -> VarName
VarName (Text -> VarName) -> Text -> VarName
forall a b. (a -> b) -> a -> b
$ Text
"_"
			Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe Text -> Text
genvarname Maybe Text
namehint
			Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if t
x t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 then Text
"" else String -> Text
L.pack (t -> String
forall a. Show a => a -> String
show (t
x t -> t -> t
forall a. Num a => a -> a -> a
+ t
1))
	
	genvarname :: Maybe Text -> Text
genvarname = Text -> (Text -> Text) -> Maybe Text -> Text
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 a. Term Var a -> param -> Script (Term Var a)
defaultVar = Text -> Term Var a -> param -> Script (Term Var a)
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 a. Term Var a -> param -> Script (Term Var a)
whenVar = Text -> Term Var a -> param -> Script (Term Var a)
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 a. Term Var a -> param -> Script (Term Var a)
errUnlessVar = Text -> Term Var a -> param -> Script (Term Var a)
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 :: Greediness
-> Direction
-> Term Var String
-> Quoted Text
-> Script (Term Var a)
trimVar Greediness
ShortestMatch Direction
FromBeginning = Text -> Term Var String -> Quoted Text -> Script (Term Var a)
forall param a b.
Param param =>
Text -> Term Var a -> param -> Script (Term Var b)
funcVar' Text
"#"
trimVar Greediness
LongestMatch Direction
FromBeginning = Text -> Term Var String -> Quoted Text -> Script (Term Var a)
forall param a b.
Param param =>
Text -> Term Var a -> param -> Script (Term Var b)
funcVar' Text
"##"
trimVar Greediness
ShortestMatch Direction
FromEnd = Text -> Term Var String -> Quoted Text -> Script (Term Var a)
forall param a b.
Param param =>
Text -> Term Var a -> param -> Script (Term Var b)
funcVar' Text
"%"
trimVar Greediness
LongestMatch Direction
FromEnd = Text -> Term Var String -> Quoted Text -> Script (Term Var a)
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 :: Term Var a -> Script (Term Var Integer)
lengthVar Term Var a
v
	| Term Var a -> Text
forall t. Named t => t -> Text
getName Term Var a
v Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"@" = Term Var Integer -> Script (Term Var Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Term Var Integer -> Script (Term Var Integer))
-> Term Var Integer -> Script (Term Var Integer)
forall a b. (a -> b) -> a -> b
$ VarName -> Term Var Integer
forall a. VarName -> Term Var a
simpleVar (Text -> VarName
VarName Text
"#")
	| Bool
otherwise = Term Var a -> (Text -> Text) -> Script (Term Var Integer)
forall a b. Term Var a -> (Text -> Text) -> Script (Term Var b)
funcVar Term Var a
v (Text
"#" Text -> Text -> 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 :: Term Var a -> (Text -> Text) -> Script (Term Var b)
funcVar Term Var a
orig Text -> Text
transform = do
	UntypedVar
v <- NamedLike -> Script UntypedVar
forall namehint.
NameHinted namehint =>
namehint -> Script UntypedVar
newVarUnsafe' NamedLike
shortname
	Script ()
f <- Term Var () -> Script (Script ())
mkFunc (UntypedVar -> Term Var ()
forall a. UntypedVar -> Term Var a
VarTerm UntypedVar
v)
	Term Var b -> Script (Term Var b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Term Var b -> Script (Term Var b))
-> Term Var b -> Script (Term Var b)
forall a b. (a -> b) -> a -> b
$ UntypedVar -> Term Var b
forall a. UntypedVar -> Term Var a
VarTerm (UntypedVar -> Term Var b) -> UntypedVar -> Term Var b
forall a b. (a -> b) -> a -> b
$ UntypedVar
v
		{ expandVar :: Env -> VarName -> Quoted Text
expandVar = \Env
env VarName
_ -> Text -> Quoted Text
forall a. a -> Quoted a
Q (Text -> Quoted Text) -> Text -> Quoted Text
forall a b. (a -> b) -> a -> b
$
			Text
"$(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Expr] -> Text
toLinearScript (([Expr], Env) -> [Expr]
forall a b. (a, b) -> a
fst (Env -> Script () -> ([Expr], Env)
forall f. Env -> Script f -> ([Expr], Env)
runScript Env
env Script ()
f)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
		}
  where
	mkFunc :: Term Var () -> Script (Script ())
	mkFunc :: Term Var () -> Script (Script ())
mkFunc Term Var ()
tmp = NamedLike -> Script () -> Script (Script ())
forall namehint callfunc.
(NameHinted namehint, CmdParams callfunc) =>
namehint -> Script () -> Script callfunc
func NamedLike
shortname (Script () -> Script (Script ()))
-> Script () -> Script (Script ())
forall a b. (a -> b) -> a -> b
$ do
		Term Var () -> Term Var a -> Script ()
forall param a. Param param => Term Var a -> param -> Script ()
setVar Term Var ()
tmp Term Var a
orig
		Text -> Quoted Text -> Script ()
forall command params.
(Param command, CmdParams params) =>
command -> params
cmd (Text
"echo" :: L.Text) (Quoted Text -> Script ()) -> Quoted Text -> Script ()
forall a b. (a -> b) -> a -> b
$ Text -> Quoted Text
forall a. a -> Quoted a
Q (Text -> Quoted Text) -> Text -> Quoted Text
forall a b. (a -> b) -> a -> b
$
			Text
"\"${" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
transform (Term Var () -> Text
forall t. Named t => t -> Text
getName Term Var ()
tmp) Text -> Text -> Text
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 a b. Text -> Term Var a -> param -> Script (Term Var b)
funcVar' Text
op Term Var a
v param
p = do
	Text
t <- param -> Env -> Text
forall a. Param a => a -> Env -> Text
toTextParam param
p (Env -> Text) -> Script Env -> Script Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Script Env
getEnv
	Term Var a -> (Text -> Text) -> Script (Term Var b)
forall a b. Term Var a -> (Text -> Text) -> Script (Term Var b)
funcVar Term Var a
v (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
op Text -> Text -> Text
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 :: namehint -> Script () -> Script callfunc
func namehint
h Script ()
s = ((Maybe Text -> Script callfunc) -> namehint -> Script callfunc)
-> namehint -> (Maybe Text -> Script callfunc) -> Script callfunc
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Maybe Text -> Script callfunc) -> namehint -> Script callfunc
forall h a. NameHinted h => (Maybe Text -> a) -> h -> a
hinted namehint
h ((Maybe Text -> Script callfunc) -> Script callfunc)
-> (Maybe Text -> Script callfunc) -> Script callfunc
forall a b. (a -> b) -> a -> b
$ \Maybe Text
namehint -> (Env -> ([Expr], Env, callfunc)) -> Script callfunc
forall a. (Env -> ([Expr], Env, a)) -> Script a
Script ((Env -> ([Expr], Env, callfunc)) -> Script callfunc)
-> (Env -> ([Expr], Env, callfunc)) -> Script callfunc
forall a b. (a -> b) -> a -> b
$ \Env
env ->
	let f :: Func
f = Text -> Env -> Integer -> Func
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 (Func -> Set Func -> Set Func
forall a. Ord a => a -> Set a -> Set a
S.insert Func
f)
	    ([Expr]
ls, Env
env'') = Env -> Script () -> ([Expr], Env)
forall f. Env -> Script f -> ([Expr], Env)
runScript Env
env' Script ()
s
	in (Func -> [Expr] -> [Expr]
definefunc Func
f [Expr]
ls, Env
env'', Func -> callfunc
forall params. CmdParams params => Func -> params
callfunc Func
f)
  where
	go :: Text -> Env -> t -> Func
go Text
basename Env
env t
x
		| Func -> Set Func -> Bool
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 (t -> t
forall a. Enum a => a -> a
succ t
x)
		| Bool
otherwise = Func
f
	  where
		f :: Func
f = Text -> Func
Func (Text -> Func) -> Text -> Func
forall a b. (a -> b) -> a -> b
$ Text
"_"
			Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
basename
			Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if t
x t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 then Text
"" else String -> Text
L.pack (t -> String
forall a. Show a => a -> String
show (t
x t -> t -> t
forall a. Num a => a -> a -> a
+ t
1))
	
	genfuncname :: Maybe Text -> Text
genfuncname = Text -> (Text -> Text) -> Maybe Text -> Text
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 (Text -> Expr) -> Text -> Expr
forall a b. (a -> b) -> a -> b
$ Text
f Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" () { :") Expr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
: (Expr -> Expr) -> [Expr] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> Expr
indent [Expr]
ls [Expr] -> [Expr] -> [Expr]
forall a. [a] -> [a] -> [a]
++ [ Text -> Expr
raw Text
"}" ]

	callfunc :: Func -> params
callfunc (Func Text
f) = Text -> params
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 :: Script () -> (Term Var a -> Script ()) -> Script ()
forCmd Script ()
c Term Var a -> Script ()
a = do
	Term Var a
v <- NamedLike -> Script (Term Var a)
forall namehint a.
NameHinted namehint =>
namehint -> Script (Term Var a)
newVarUnsafe (Text -> NamedLike
NamedLike Text
"x")
	Text
s <- [Expr] -> Text
toLinearScript ([Expr] -> Text) -> Script [Expr] -> Script Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Script () -> Script [Expr]
runM Script ()
c
	Expr -> Script ()
add (Expr -> Script ()) -> Expr -> Script ()
forall a b. (a -> b) -> a -> b
$ Text -> Expr
raw (Text -> Expr) -> Text -> Expr
forall a b. (a -> b) -> a -> b
$ Text
"for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Term Var a -> Text
forall t. Named t => t -> Text
getName Term Var a
v Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in $(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s Text -> Text -> Text
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 (Expr -> Script ()) -> Expr -> Script ()
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 ([Expr] -> Text) -> Script [Expr] -> Script Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Script () -> Script [Expr]
runM Script ()
c
	Expr -> Script ()
add (Expr -> Script ()) -> Expr -> Script ()
forall a b. (a -> b) -> a -> b
$ Text -> Expr
raw (Text -> Expr) -> Text -> Expr
forall a b. (a -> b) -> a -> b
$ Text
"while $(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
	Text -> Script () -> Script ()
block Text
"do" Script ()
a
	Expr -> Script ()
add (Expr -> Script ()) -> Expr -> Script ()
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' Text -> Text
forall a. a -> a
id Script ()
cond (Script () -> Script ()) -> Script () -> Script ()
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 (Expr -> Script ()) -> Expr -> Script ()
forall a b. (a -> b) -> a -> b
$ Text -> Expr
raw (Text -> Expr) -> Text -> Expr
forall a b. (a -> b) -> a -> b
$ Text
"if " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
condf ([Expr] -> Text
singleline [Expr]
condl)
	Script ()
body
	Expr -> Script ()
add (Expr -> Script ()) -> Expr -> Script ()
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' Text -> Text
forall a. a -> a
id Script ()
cond (Script () -> Script ()) -> Script () -> Script ()
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
"! " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) Script ()
cond (Script () -> Script ()) -> Script () -> Script ()
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 :: Term Var a -> [(Quoted Text, Script ())] -> Script ()
caseOf Term Var a
_ [] = () -> Script ()
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 (Expr -> Script ()) -> Expr -> Script ()
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 " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Term Var a -> Env -> Text
forall a. Param a => a -> Env -> Text
toTextParam Term Var a
v Env
env Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in "
			else Text
": ;; "
		Expr -> Script ()
add (Expr -> Script ()) -> Expr -> Script ()
forall a b. (a -> b) -> a -> b
$ Text -> Expr
raw (Text -> Expr) -> Text -> Expr
forall a b. (a -> b) -> a -> b
$ Text
leader Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Quoted Text -> Text
forall a. Quoted a -> a
getQ Quoted Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") :"
		(Expr -> Script ()) -> [Expr] -> Script ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Expr -> Script ()
add (Expr -> Script ()) -> (Expr -> Expr) -> Expr -> Script ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Expr
indent) ([Expr] -> Script ()) -> Script [Expr] -> Script ()
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 (Expr -> Script ()) -> Expr -> Script ()
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 (Expr -> Script ()) -> Expr -> Script ()
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 :: Text -> value -> Script () -> Script ()
withEnv Text
n value
v (Script Env -> ([Expr], Env, ())
f) = (Env -> ([Expr], Env, ())) -> Script ()
forall a. (Env -> ([Expr], Env, a)) -> Script a
Script ((Env -> ([Expr], Env, ())) -> Script ())
-> (Env -> ([Expr], Env, ())) -> Script ()
forall a b. (a -> b) -> a -> b
$ ([Expr], Env, ()) -> ([Expr], Env, ())
addEnv (([Expr], Env, ()) -> ([Expr], Env, ()))
-> (Env -> ([Expr], Env, ())) -> Env -> ([Expr], Env, ())
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, value -> Env -> Text
forall a. Param a => a -> Env -> Text
toTextParam value
v Env
env)
		in case [Expr]
e of
			[Cmd Int
i [LocalEnv]
localenvs Text
l] -> ([Int -> [LocalEnv] -> Text -> Expr
Cmd Int
i (LocalEnv
localenv LocalEnv -> [LocalEnv] -> [LocalEnv]
forall a. a -> [a] -> [a]
: [LocalEnv]
localenvs) Text
l], Env
env, ())
			[EnvWrap Int
i Text
envName [LocalEnv]
localenvs [Expr]
e'] -> ([Int -> Text -> [LocalEnv] -> [Expr] -> Expr
EnvWrap Int
i Text
envName (LocalEnv
localenv LocalEnv -> [LocalEnv] -> [LocalEnv]
forall a. a -> [a] -> [a]
: [LocalEnv]
localenvs) [Expr]
e'], Env
env, ())
			[Expr]
l -> ([Int -> Text -> [LocalEnv] -> [Expr] -> Expr
EnvWrap Int
0 (UntypedVar -> Text
forall t. Named t => t -> Text
getName UntypedVar
name) [LocalEnv
localenv] [Expr]
l], Env
env', ())
	  where
		(Script Env -> ([Expr], Env, UntypedVar)
nameFn) = NamedLike -> Script UntypedVar
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 (Expr -> Script ()) -> Expr -> Script ()
forall a b. (a -> b) -> a -> b
$ Text -> Expr
raw (Text -> Expr) -> Text -> Expr
forall a b. (a -> b) -> a -> b
$ Text
word Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" :"
	(Expr -> Script ()) -> [Expr] -> Script ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Expr -> Script ()
add (Expr -> Script ()) -> (Expr -> Expr) -> Expr -> Script ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Expr
indent) ([Expr] -> Script ()) -> Script [Expr] -> Script ()
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 (Expr -> Script ()) -> Expr -> Script ()
forall a b. (a -> b) -> a -> b
$ Text -> Expr
newCmd (Text -> Expr) -> Text -> Expr
forall a b. (a -> b) -> a -> b
$ Text
"read " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Quoted Text -> Text
forall a. Quoted a -> a
getQ (Text -> Quoted Text
forall t. Quotable t => t -> Quoted Text
quote (Term Var String -> Text
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 (Expr -> Script ()) -> Expr -> Script ()
forall a b. (a -> b) -> a -> b
$ Text -> Expr
raw (Text -> Expr) -> Text -> Expr
forall a b. (a -> b) -> a -> b
$ Text
"set " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if Bool
b then Text
"-" else Text
"+") Text -> Text -> 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 Script [Expr] -> ([Expr] -> Script ()) -> Script ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Expr -> Script ()) -> [Expr] -> Script ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Expr -> Script ()
add (Expr -> Script ()) -> (Expr -> Expr) -> Expr -> Script ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Expr
go)
  where
	go :: Expr -> Expr
go c :: Expr
c@(Cmd Int
_ [LocalEnv]
_ Text
_) = Expr -> Expr -> Expr
Or Expr
c Expr
true
	go c :: Expr
c@(Raw Int
_ Text
_) = Expr -> Expr -> Expr
Or Expr
c Expr
true
	go c :: Expr
c@(Comment Text
_) = Expr
c
	go (EnvWrap Int
i Text
n [LocalEnv]
localenvs [Expr]
e) = Int -> Text -> [LocalEnv] -> [Expr] -> Expr
EnvWrap Int
i Text
n [LocalEnv]
localenvs ((Expr -> Expr) -> [Expr] -> [Expr]
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 ((Expr -> Expr) -> [Expr] -> [Expr]
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 ((Expr -> Expr) -> [Expr] -> [Expr]
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 (Expr -> Script ()) -> Expr -> Script ()
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 ([Expr] -> Expr) -> Script [Expr] -> Script Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Script () -> Script [Expr]
runM Script ()
s
	Expr -> Script ()
add (Expr -> Script ()) -> Expr -> Script ()
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 = ((Fd, String) -> (Fd, String))
-> Fd -> (Fd, String) -> (Fd, String)
forall a b. a -> b -> a
const (Fd, String) -> (Fd, String)
forall a. a -> a
id

fileRedir :: RedirFile f => f -> Fd -> (Fd -> FilePath -> RedirSpec) -> RedirSpec
fileRedir :: f -> Fd -> (Fd -> String -> RedirSpec) -> RedirSpec
fileRedir f
f Fd
deffd Fd -> String -> RedirSpec
c = (Fd -> String -> RedirSpec) -> (Fd, String) -> RedirSpec
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Fd -> String -> RedirSpec
c (Fd -> f -> (Fd, String)
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 |> :: Script () -> f -> Script ()
|> f
f = Script () -> RedirSpec -> Script ()
redir Script ()
s (f -> Fd -> (Fd -> String -> RedirSpec) -> RedirSpec
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 |>> :: Script () -> f -> Script ()
|>> f
f = Script () -> RedirSpec -> Script ()
redir Script ()
s (f -> Fd -> (Fd -> String -> RedirSpec) -> RedirSpec
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 |< :: Script () -> f -> Script ()
|< f
f = Script () -> RedirSpec -> Script ()
redir Script ()
s (f -> Fd -> (Fd -> String -> RedirSpec) -> RedirSpec
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 = (Env -> ([Expr], Env, ())) -> Script ()
forall a. (Env -> ([Expr], Env, a)) -> Script a
Script ((Env -> ([Expr], Env, ())) -> Script ())
-> (Env -> ([Expr], Env, ())) -> Script ()
forall a b. (a -> b) -> a -> b
$ \Env
env -> ([Text -> Expr
newCmd (Text -> Expr) -> Text -> Expr
forall a b. (a -> b) -> a -> b
$ Text
"test " Text -> Text -> Text
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) = Text -> Text -> Text
forall a. (Semigroup a, IsString a) => a -> a -> a
unop Text
"!" (Test -> Text
go Test
t)
	go (TAnd Test
t1 Test
t2) = Text -> Text -> Text -> Text
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) = Text -> Text -> Text -> Text
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) = Text -> Text -> Text
forall a. (Semigroup a, IsString a) => a -> a -> a
unop Text
"-z" (p -> Text
forall p. Param p => p -> Text
pv p
p)
	go (TNonEmpty p
p) = Text -> Text -> Text
forall a. (Semigroup a, IsString a) => a -> a -> a
unop Text
"-n" (p -> Text
forall p. Param p => p -> Text
pv p
p)
	go (TStrEqual p
p1 q
p2) = Text -> Text -> Text -> Text
forall a. (Semigroup a, IsString a) => a -> a -> a -> a
binop (p -> Text
forall p. Param p => p -> Text
pv p
p1) Text
"=" (q -> Text
forall p. Param p => p -> Text
pv q
p2)
	go (TStrNotEqual p
p1 q
p2) = Text -> Text -> Text -> Text
forall a. (Semigroup a, IsString a) => a -> a -> a -> a
binop (p -> Text
forall p. Param p => p -> Text
pv p
p1) Text
"!=" (q -> Text
forall p. Param p => p -> Text
pv q
p2)
	go (TEqual Term Var p
p1 Term Var q
p2) = Text -> Text -> Text -> Text
forall a. (Semigroup a, IsString a) => a -> a -> a -> a
binop (Term Var p -> Text
forall p. Param p => p -> Text
pv Term Var p
p1) Text
"-eq" (Term Var q -> Text
forall p. Param p => p -> Text
pv Term Var q
p2)
	go (TNotEqual Term Var p
p1 Term Var q
p2) = Text -> Text -> Text -> Text
forall a. (Semigroup a, IsString a) => a -> a -> a -> a
binop (Term Var p -> Text
forall p. Param p => p -> Text
pv Term Var p
p1) Text
"-ne" (Term Var q -> Text
forall p. Param p => p -> Text
pv Term Var q
p2)
	go (TGT Term Var p
p1 Term Var q
p2) = Text -> Text -> Text -> Text
forall a. (Semigroup a, IsString a) => a -> a -> a -> a
binop (Term Var p -> Text
forall p. Param p => p -> Text
pv Term Var p
p1) Text
"-gt" (Term Var q -> Text
forall p. Param p => p -> Text
pv Term Var q
p2)
	go (TLT Term Var p
p1 Term Var q
p2) = Text -> Text -> Text -> Text
forall a. (Semigroup a, IsString a) => a -> a -> a -> a
binop (Term Var p -> Text
forall p. Param p => p -> Text
pv Term Var p
p1) Text
"-lt" (Term Var q -> Text
forall p. Param p => p -> Text
pv Term Var q
p2)
	go (TGE Term Var p
p1 Term Var q
p2) = Text -> Text -> Text -> Text
forall a. (Semigroup a, IsString a) => a -> a -> a -> a
binop (Term Var p -> Text
forall p. Param p => p -> Text
pv Term Var p
p1) Text
"-ge" (Term Var q -> Text
forall p. Param p => p -> Text
pv Term Var q
p2)
	go (TLE Term Var p
p1 Term Var q
p2) = Text -> Text -> Text -> Text
forall a. (Semigroup a, IsString a) => a -> a -> a -> a
binop (Term Var p -> Text
forall p. Param p => p -> Text
pv Term Var p
p1) Text
"-le" (Term Var q -> Text
forall p. Param p => p -> Text
pv Term Var q
p2)
	go (TFileEqual p
p1 q
p2) = Text -> Text -> Text -> Text
forall a. (Semigroup a, IsString a) => a -> a -> a -> a
binop (p -> Text
forall p. Param p => p -> Text
pv p
p1) Text
"-ef" (q -> Text
forall p. Param p => p -> Text
pv q
p2)
	go (TFileNewer p
p1 q
p2) = Text -> Text -> Text -> Text
forall a. (Semigroup a, IsString a) => a -> a -> a -> a
binop (p -> Text
forall p. Param p => p -> Text
pv p
p1) Text
"-nt" (q -> Text
forall p. Param p => p -> Text
pv q
p2)
	go (TFileOlder p
p1 q
p2) = Text -> Text -> Text -> Text
forall a. (Semigroup a, IsString a) => a -> a -> a -> a
binop (p -> Text
forall p. Param p => p -> Text
pv p
p1) Text
"-ot" (q -> Text
forall p. Param p => p -> Text
pv q
p2)
	go (TBlockExists p
p) = Text -> Text -> Text
forall a. (Semigroup a, IsString a) => a -> a -> a
unop Text
"-b" (p -> Text
forall p. Param p => p -> Text
pv p
p)
	go (TCharExists p
p) = Text -> Text -> Text
forall a. (Semigroup a, IsString a) => a -> a -> a
unop Text
"-c" (p -> Text
forall p. Param p => p -> Text
pv p
p)
	go (TDirExists p
p) = Text -> Text -> Text
forall a. (Semigroup a, IsString a) => a -> a -> a
unop Text
"-d" (p -> Text
forall p. Param p => p -> Text
pv p
p)
	go (TFileExists p
p) = Text -> Text -> Text
forall a. (Semigroup a, IsString a) => a -> a -> a
unop Text
"-e" (p -> Text
forall p. Param p => p -> Text
pv p
p)
	go (TRegularFileExists p
p) = Text -> Text -> Text
forall a. (Semigroup a, IsString a) => a -> a -> a
unop Text
"-f" (p -> Text
forall p. Param p => p -> Text
pv p
p)
	go (TSymlinkExists p
p) = Text -> Text -> Text
forall a. (Semigroup a, IsString a) => a -> a -> a
unop Text
"-L" (p -> Text
forall p. Param p => p -> Text
pv p
p)
	go (TFileNonEmpty p
p) = Text -> Text -> Text
forall a. (Semigroup a, IsString a) => a -> a -> a
unop Text
"-s" (p -> Text
forall p. Param p => p -> Text
pv p
p)
	go (TFileExecutable p
p) = Text -> Text -> Text
forall a. (Semigroup a, IsString a) => a -> a -> a
unop Text
"-x" (p -> Text
forall p. Param p => p -> Text
pv p
p)

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

	pv :: (Param p) => p -> L.Text
	pv :: p -> Text
pv = (p -> Env -> Text) -> Env -> p -> Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip p -> Env -> Text
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 = a -> Term Static a
forall a. Quotable (Val a) => a -> Term Static a
static (a -> Term Static a) -> (Integer -> a) -> Integer -> Term Static a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
forall a. Num a => Integer -> a
fromInteger
	(StaticTerm a
a) + :: Term Static a -> Term Static a -> Term Static a
+ (StaticTerm a
b) = a -> Term Static a
forall a. Quotable (Val a) => a -> Term Static a
StaticTerm (a
a a -> 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) = a -> Term Static a
forall a. Quotable (Val a) => a -> Term Static a
StaticTerm (a
a a -> 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) = a -> Term Static a
forall a. Quotable (Val a) => a -> Term Static a
StaticTerm (a
a a -> a -> a
forall a. Num a => a -> a -> a
- a
b)
	abs :: Term Static a -> Term Static a
abs (StaticTerm a
a) = a -> Term Static a
forall a. Quotable (Val a) => a -> Term Static a
StaticTerm (a -> a
forall a. Num a => a -> a
abs a
a)
	signum :: Term Static a -> Term Static a
signum (StaticTerm a
a) = a -> Term Static a
forall a. Quotable (Val a) => a -> Term Static a
StaticTerm (a -> a
forall a. Num a => a -> a
signum a
a)

-- | Lifts a Term to Arith.
val :: Term t Integer -> Arith
val :: Term t Integer -> Arith
val t :: Term t Integer
t@(VarTerm UntypedVar
_) = Term Var Integer -> Arith
AVar Term t Integer
Term Var Integer
t
val t :: Term t Integer
t@(StaticTerm Integer
_) = Term Static Integer -> Arith
AStatic Term t Integer
Term Static 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
"$(( " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Arith -> Text
go Arith
arith Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ))"
  where
	go :: Arith -> Text
go (ANum Integer
i) = String -> Text
L.pack (Integer -> String
forall a. Show a => a -> String
show Integer
i)
	-- shell variable must be expanded without quotes
	go (AVar (VarTerm UntypedVar
v)) = Quoted Text -> Text
forall a. Quoted a -> a
getQ (Quoted Text -> Text) -> Quoted Text -> Text
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)) = Quoted Text -> Text
forall a. Quoted a -> a
getQ (Quoted Text -> Text) -> Quoted Text -> Text
forall a b. (a -> b) -> a -> b
$ Val Integer -> Quoted Text
forall t. Quotable t => t -> Quoted Text
quote (Val Integer -> Quoted Text) -> Val Integer -> Quoted Text
forall a b. (a -> b) -> a -> b
$ Integer -> Val Integer
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)) = Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
paren (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Arith -> Text
go Arith
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ? " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Arith -> Text
go Arith
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" : " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Arith -> Text
go Arith
b

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

	binop :: Arith -> Text -> Arith -> Text
binop Arith
a Text
o Arith
b = Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
paren (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Arith -> Text
go Arith
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
o Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Arith -> Text
go Arith
b
	unop :: Text -> Arith -> Text
unop Text
o Arith
v = Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
paren (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
o Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> 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 :: Int -> Arith
toEnum = Integer -> Arith
ANum (Integer -> Arith) -> (Int -> Integer) -> Int -> Arith
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
	enumFrom :: Arith -> [Arith]
enumFrom Arith
a = Arith
a Arith -> [Arith] -> [Arith]
forall a. a -> [a] -> [a]
: Arith -> [Arith]
forall a. Enum a => a -> [a]
enumFrom (Arith -> Arith
forall a. Enum a => a -> a
succ Arith
a)
	enumFromThen :: Arith -> Arith -> [Arith]
enumFromThen Arith
a Arith
b = Arith
a Arith -> [Arith] -> [Arith]
forall a. a -> [a] -> [a]
: Arith -> Arith -> [Arith]
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 -> Int
fromEnum = String -> Arith -> Int
forall a. HasCallStack => String -> a
error String
"fromEnum not implemented for Arith"
	enumFromTo :: Arith -> Arith -> [Arith]
enumFromTo = String -> Arith -> Arith -> [Arith]
forall a. HasCallStack => String -> a
error String
"enumFromTo not implemented for Arith"
	enumFromThenTo :: Arith -> Arith -> Arith -> [Arith]
enumFromThenTo = String -> Arith -> Arith -> Arith -> [Arith]
forall a. HasCallStack => String -> a
error String
"enumFromToThen not implemented for Arith"