{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE EmptyDataDecls #-}
module Control.Monad.Shell (
Script,
script,
linearScript,
Term,
Var,
Static,
Quoted,
Quotable(..),
glob,
run,
cmd,
Param,
CmdParams,
Output(..),
NamedLike(..),
NameHinted,
static,
newVar,
newVarFrom,
newVarContaining,
setVar,
globalVar,
positionalParameters,
takeParameter,
defaultVar,
whenVar,
lengthVar,
trimVar,
Greediness(..),
Direction(..),
WithVar(..),
func,
forCmd,
whileCmd,
ifCmd,
whenCmd,
unlessCmd,
caseOf,
subshell,
group,
withEnv,
(-|-),
(-&&-),
(-||-),
RedirFile,
(|>),
(|>>),
(|<),
toStderr,
(>&),
(<&),
(&),
hereDocument,
stopOnFailure,
ignoreFailure,
errUnlessVar,
test,
Test(..),
val,
Arith(..),
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
data Term t a where
VarTerm :: UntypedVar -> Term Var a
StaticTerm :: (Quotable (Val a)) => a -> Term Static a
data Var
data Static
data UntypedVar = V
{ UntypedVar -> VarName
varName :: VarName
, UntypedVar -> Env -> VarName -> Quoted Text
expandVar :: Env -> VarName -> Quoted L.Text
}
newtype VarName = VarName L.Text
deriving (VarName -> VarName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VarName -> VarName -> Bool
$c/= :: VarName -> VarName -> Bool
== :: VarName -> VarName -> Bool
$c== :: VarName -> VarName -> Bool
Eq, Eq VarName
VarName -> VarName -> Bool
VarName -> VarName -> Ordering
VarName -> VarName -> VarName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: VarName -> VarName -> VarName
$cmin :: VarName -> VarName -> VarName
max :: VarName -> VarName -> VarName
$cmax :: VarName -> VarName -> VarName
>= :: VarName -> VarName -> Bool
$c>= :: VarName -> VarName -> Bool
> :: VarName -> VarName -> Bool
$c> :: VarName -> VarName -> Bool
<= :: VarName -> VarName -> Bool
$c<= :: VarName -> VarName -> Bool
< :: VarName -> VarName -> Bool
$c< :: VarName -> VarName -> Bool
compare :: VarName -> VarName -> Ordering
$ccompare :: VarName -> VarName -> Ordering
Ord, Indent -> VarName -> ShowS
[VarName] -> ShowS
VarName -> String
forall a.
(Indent -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VarName] -> ShowS
$cshowList :: [VarName] -> ShowS
show :: VarName -> String
$cshow :: VarName -> String
showsPrec :: Indent -> VarName -> ShowS
$cshowsPrec :: Indent -> VarName -> ShowS
Show)
simpleVar :: forall a. VarName -> Term Var a
simpleVar :: forall a. VarName -> Term Var a
simpleVar = forall a. UntypedVar -> Term Var a
VarTerm forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarName -> UntypedVar
simpleVar'
simpleVar' :: VarName -> UntypedVar
simpleVar' :: VarName -> UntypedVar
simpleVar' VarName
name = V
{ varName :: VarName
varName = VarName
name
, expandVar :: Env -> VarName -> Quoted Text
expandVar = \Env
_ (VarName Text
n) -> forall a. a -> Quoted a
Q (Text
"$" forall a. Semigroup a => a -> a -> a
<> Text
n)
}
glob :: L.Text -> Quoted L.Text
glob :: Text -> Quoted Text
glob = forall a. a -> Quoted a
Q forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Text) -> Text -> Text
L.concatMap Char -> Text
escape
where
escape :: Char -> Text
escape Char
c
| Char -> Bool
isAlphaNum Char
c = Char -> Text
L.singleton Char
c
| Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"*?[!-:]\\" :: String) = Char -> Text
L.singleton Char
c
| Bool
otherwise = Text
"\\" forall a. Semigroup a => a -> a -> a
<> Char -> Text
L.singleton Char
c
newtype Func = Func L.Text
deriving (Func -> Func -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Func -> Func -> Bool
$c/= :: Func -> Func -> Bool
== :: Func -> Func -> Bool
$c== :: Func -> Func -> Bool
Eq, Eq Func
Func -> Func -> Bool
Func -> Func -> Ordering
Func -> Func -> Func
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Func -> Func -> Func
$cmin :: Func -> Func -> Func
max :: Func -> Func -> Func
$cmax :: Func -> Func -> Func
>= :: Func -> Func -> Bool
$c>= :: Func -> Func -> Bool
> :: Func -> Func -> Bool
$c> :: Func -> Func -> Bool
<= :: Func -> Func -> Bool
$c<= :: Func -> Func -> Bool
< :: Func -> Func -> Bool
$c< :: Func -> Func -> Bool
compare :: Func -> Func -> Ordering
$ccompare :: Func -> Func -> Ordering
Ord, Indent -> Func -> ShowS
[Func] -> ShowS
Func -> String
forall a.
(Indent -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Func] -> ShowS
$cshowList :: [Func] -> ShowS
show :: Func -> String
$cshow :: Func -> String
showsPrec :: Indent -> Func -> ShowS
$cshowsPrec :: Indent -> Func -> ShowS
Show)
class Named t where
getName :: t -> L.Text
instance Named (Term Var t) where
getName :: Term Var t -> Text
getName (VarTerm UntypedVar
v) = forall t. Named t => t -> Text
getName UntypedVar
v
instance Named UntypedVar where
getName :: UntypedVar -> Text
getName = forall t. Named t => t -> Text
getName forall b c a. (b -> c) -> (a -> b) -> a -> c
. UntypedVar -> VarName
varName
instance Named VarName where
getName :: VarName -> Text
getName (VarName Text
n) = Text
n
instance Named Func where
getName :: Func -> Text
getName (Func Text
n) = Text
n
type Indent = Int
type LocalEnv = (L.Text, L.Text)
data Expr
= Cmd Indent [LocalEnv] L.Text
| Raw Indent L.Text
| EnvWrap Indent L.Text [LocalEnv] [Expr]
| L.Text
| Subshell L.Text [Expr]
| Group L.Text [Expr]
| Pipe Expr Expr
| And Expr Expr
| Or Expr Expr
| Redir Expr RedirSpec
indent :: Expr -> Expr
indent :: Expr -> Expr
indent (Cmd Indent
i [LocalEnv]
localenvs Text
t) = Indent -> [LocalEnv] -> Text -> Expr
Cmd (Indent
i forall a. Num a => a -> a -> a
+ Indent
1) [LocalEnv]
localenvs Text
t
indent (Raw Indent
i Text
t) = Indent -> Text -> Expr
Raw (Indent
i forall a. Num a => a -> a -> a
+ Indent
1) Text
t
indent (EnvWrap Indent
i Text
n [LocalEnv]
localenvs [Expr]
e) = Indent -> Text -> [LocalEnv] -> [Expr] -> Expr
EnvWrap (Indent
i forall a. Num a => a -> a -> a
+ Indent
1) Text
n [LocalEnv]
localenvs (forall a b. (a -> b) -> [a] -> [b]
map Expr -> Expr
indent [Expr]
e)
indent (Comment Text
t) = Text -> Expr
Comment forall a b. (a -> b) -> a -> b
$ Text
"\t" forall a. Semigroup a => a -> a -> a
<> Text
t
indent (Subshell Text
i [Expr]
l) = Text -> [Expr] -> Expr
Subshell (Text
"\t" forall a. Semigroup a => a -> a -> a
<> Text
i) (forall a b. (a -> b) -> [a] -> [b]
map Expr -> Expr
indent [Expr]
l)
indent (Group Text
i [Expr]
l) = Text -> [Expr] -> Expr
Group (Text
"\t" forall a. Semigroup a => a -> a -> a
<> Text
i) (forall a b. (a -> b) -> [a] -> [b]
map Expr -> Expr
indent [Expr]
l)
indent (Pipe Expr
e1 Expr
e2) = Expr -> Expr -> Expr
Pipe (Expr -> Expr
indent Expr
e1) (Expr -> Expr
indent Expr
e2)
indent (Redir Expr
e RedirSpec
r) = Expr -> RedirSpec -> Expr
Redir (Expr -> Expr
indent Expr
e) RedirSpec
r
indent (And Expr
e1 Expr
e2) = Expr -> Expr -> Expr
And (Expr -> Expr
indent Expr
e1) (Expr -> Expr
indent Expr
e2)
indent (Or Expr
e1 Expr
e2) = Expr -> Expr -> Expr
Or (Expr -> Expr
indent Expr
e1) (Expr -> Expr
indent Expr
e2)
data RedirSpec
= RedirToFile Fd FilePath
| RedirToFileAppend Fd FilePath
| RedirFromFile Fd FilePath
| RedirOutput Fd Fd
| RedirInput Fd Fd
| RedirHereDoc L.Text
newtype Script a = Script (Env -> ([Expr], Env, a))
deriving (forall a b. a -> Script b -> Script a
forall a b. (a -> b) -> Script a -> Script b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Script b -> Script a
$c<$ :: forall a b. a -> Script b -> Script a
fmap :: forall a b. (a -> b) -> Script a -> Script b
$cfmap :: forall a b. (a -> b) -> Script a -> Script b
Functor)
instance Applicative Script where
pure :: forall a. a -> Script a
pure a
a = forall a. (Env -> ([Expr], Env, a)) -> Script a
Script forall a b. (a -> b) -> a -> b
$ \Env
env -> ([], Env
env, a
a)
Script Env -> ([Expr], Env, a -> b)
f <*> :: forall a b. Script (a -> b) -> Script a -> Script b
<*> Script Env -> ([Expr], Env, a)
a = forall a. (Env -> ([Expr], Env, a)) -> Script a
Script forall a b. (a -> b) -> a -> b
$ \Env
env0 ->
let ([Expr]
expr1, Env
env1, a -> b
f') = Env -> ([Expr], Env, a -> b)
f Env
env0
([Expr]
expr2, Env
env2, a
a') = Env -> ([Expr], Env, a)
a Env
env1
in ([Expr]
expr1 forall a. Semigroup a => a -> a -> a
<> [Expr]
expr2, Env
env2, a -> b
f' a
a')
instance Monad Script where
Script a
a >>= :: forall a b. Script a -> (a -> Script b) -> Script b
>>= a -> Script b
b = forall a. (Env -> ([Expr], Env, a)) -> Script a
Script forall a b. (a -> b) -> a -> b
$ \Env
start -> let
([Expr]
left, Env
mid, a
v) = forall f. Script f -> Env -> ([Expr], Env, f)
call Script a
a Env
start
([Expr]
right, Env
end, b
ret) = forall f. Script f -> Env -> ([Expr], Env, f)
call (a -> Script b
b a
v) Env
mid
in ([Expr]
left forall a. [a] -> [a] -> [a]
++ [Expr]
right, Env
end, b
ret)
where
call :: Script f -> Env -> ([Expr], Env, f)
call :: forall f. Script f -> Env -> ([Expr], Env, f)
call (Script Env -> ([Expr], Env, f)
f) = Env -> ([Expr], Env, f)
f
data Env = Env
{ Env -> Set VarName
envVars :: S.Set VarName
, Env -> Set Func
envFuncs :: S.Set Func
}
instance Semigroup Env where
<> :: Env -> Env -> Env
(<>) Env
a Env
b = Set VarName -> Set Func -> Env
Env (Env -> Set VarName
envVars Env
a forall a. Semigroup a => a -> a -> a
<> Env -> Set VarName
envVars Env
b) (Env -> Set Func
envFuncs Env
a forall a. Semigroup a => a -> a -> a
<> Env -> Set Func
envFuncs Env
b)
instance Monoid Env where
mempty :: Env
mempty = Set VarName -> Set Func -> Env
Env forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
getEnv :: Script Env
getEnv :: Script Env
getEnv = forall a. (Env -> ([Expr], Env, a)) -> Script a
Script forall a b. (a -> b) -> a -> b
$ \Env
env -> ([], Env
env, Env
env)
modifyEnvVars :: Env -> (S.Set VarName -> S.Set VarName) -> Env
modifyEnvVars :: Env -> (Set VarName -> Set VarName) -> Env
modifyEnvVars Env
env Set VarName -> Set VarName
f = Env
env { envVars :: Set VarName
envVars = Set VarName -> Set VarName
f (Env -> Set VarName
envVars Env
env) }
modifyEnvFuncs :: Env -> (S.Set Func -> S.Set Func) -> Env
modifyEnvFuncs :: Env -> (Set Func -> Set Func) -> Env
modifyEnvFuncs Env
env Set Func -> Set Func
f = Env
env { envFuncs :: Set Func
envFuncs = Set Func -> Set Func
f (Env -> Set Func
envFuncs Env
env) }
gen :: Script f -> [Expr]
gen :: forall f. Script f -> [Expr]
gen = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. Env -> Script f -> ([Expr], Env)
runScript forall a. Monoid a => a
mempty
runScript :: Env -> Script f -> ([Expr], Env)
runScript :: forall f. Env -> Script f -> ([Expr], Env)
runScript Env
env (Script Env -> ([Expr], Env, f)
f) = ([Expr]
code, Env
env') where ([Expr]
code, Env
env', f
_) = Env -> ([Expr], Env, f)
f Env
env
runM :: Script () -> Script [Expr]
runM :: Script () -> Script [Expr]
runM Script ()
s = forall a. (Env -> ([Expr], Env, a)) -> Script a
Script forall a b. (a -> b) -> a -> b
$ \Env
env ->
let ([Expr]
r, Env
env') = forall f. Env -> Script f -> ([Expr], Env)
runScript Env
env Script ()
s
in ([], Env
env', [Expr]
r)
script :: Script f -> L.Text
script :: forall f. Script f -> Text
script = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Monoid a => a -> a -> a
mappend Text
"\n" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
L.intercalate Text
"\n" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Text
"#!/bin/sh"forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Expr -> Text
fmt Bool
True) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. Script f -> [Expr]
gen
fmt :: Bool -> Expr -> L.Text
fmt :: Bool -> Expr -> Text
fmt Bool
multiline = Expr -> Text
go
where
fmtlocalenvs :: [LocalEnv] -> Text
fmtlocalenvs = Text -> [Text] -> Text
L.intercalate Text
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\(Text
k, Text
v) -> Text
k forall a. Semigroup a => a -> a -> a
<> Text
"=" forall a. Semigroup a => a -> a -> a
<> Text
v)
go :: Expr -> Text
go (Cmd Indent
i [] Text
t) = String -> Text
L.pack (forall a. Indent -> a -> [a]
replicate Indent
i Char
'\t') forall a. Semigroup a => a -> a -> a
<> Text
t
go (Cmd Indent
i [LocalEnv]
localenvs Text
t) = String -> Text
L.pack (forall a. Indent -> a -> [a]
replicate Indent
i Char
'\t') forall a. Semigroup a => a -> a -> a
<> [LocalEnv] -> Text
fmtlocalenvs [LocalEnv]
localenvs forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
t
go (Raw Indent
i Text
t) = String -> Text
L.pack (forall a. Indent -> a -> [a]
replicate Indent
i Char
'\t') forall a. Semigroup a => a -> a -> a
<> Text
t
go (EnvWrap Indent
i Text
n [LocalEnv]
localenvs [Expr]
e) =
let (Text
lp, Text
sep) = if Bool
multiline
then (String -> Text
L.pack (forall a. Indent -> a -> [a]
replicate Indent
i Char
'\t'), Text
"\n")
else (Text
"", Text
";")
in Text
lp forall a. Semigroup a => a -> a -> a
<> Text
n forall a. Semigroup a => a -> a -> a
<> Text
"() { : " forall a. Semigroup a => a -> a -> a
<> Text
sep
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
L.intercalate Text
sep (forall a b. (a -> b) -> [a] -> [b]
map (Expr -> Text
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Expr
indent) [Expr]
e) forall a. Semigroup a => a -> a -> a
<> Text
sep
forall a. Semigroup a => a -> a -> a
<> Text
lp forall a. Semigroup a => a -> a -> a
<> Text
"}" forall a. Semigroup a => a -> a -> a
<> Text
sep
forall a. Semigroup a => a -> a -> a
<> Text
lp forall a. Semigroup a => a -> a -> a
<> [LocalEnv] -> Text
fmtlocalenvs [LocalEnv]
localenvs forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
n
go (Comment Text
t) = Text
": " forall a. Semigroup a => a -> a -> a
<> forall a. Quoted a -> a
getQ (forall t. Quotable t => t -> Quoted Text
quote ((Char -> Bool) -> Text -> Text
L.filter (forall a. Eq a => a -> a -> Bool
/= Char
'\n') Text
t))
go (Subshell Text
i []) = Text
i forall a. Semigroup a => a -> a -> a
<> Text
"( : )"
go (Subshell Text
i [Expr]
l) =
let (Text
wrap, Text
sep) = if Bool
multiline then (Text
"\n", Text
"\n") else (Text
"", Text
";")
in Text
i forall a. Semigroup a => a -> a -> a
<> Text
"(" forall a. Semigroup a => a -> a -> a
<> Text
wrap forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
L.intercalate Text
sep (forall a b. (a -> b) -> [a] -> [b]
map (Expr -> Text
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Expr
indent) [Expr]
l) forall a. Semigroup a => a -> a -> a
<> Text
wrap forall a. Semigroup a => a -> a -> a
<> Text
i forall a. Semigroup a => a -> a -> a
<> Text
")"
go (Group Text
i []) = Text
i forall a. Semigroup a => a -> a -> a
<> Text
"{ :; }"
go (Group Text
i [Expr]
l) =
let (Text
wrap, Text
sep, Text
end) = if Bool
multiline then (Text
"\n", Text
"\n", Text
"") else (Text
"", Text
";", Text
";")
in Text
i forall a. Semigroup a => a -> a -> a
<> Text
"{" forall a. Semigroup a => a -> a -> a
<> Text
wrap forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
L.intercalate Text
sep (forall a b. (a -> b) -> [a] -> [b]
map (Expr -> Text
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Expr
indent) [Expr]
l) forall a. Semigroup a => a -> a -> a
<> Text
end forall a. Semigroup a => a -> a -> a
<> Text
wrap forall a. Semigroup a => a -> a -> a
<> Text
i forall a. Semigroup a => a -> a -> a
<> Text
"}"
go (Pipe Expr
e1 Expr
e2) = Expr -> Text
go Expr
e1 forall a. Semigroup a => a -> a -> a
<> Text
" | " forall a. Semigroup a => a -> a -> a
<> Expr -> Text
go Expr
e2
go (And Expr
e1 Expr
e2) = Expr -> Text
go Expr
e1 forall a. Semigroup a => a -> a -> a
<> Text
" && " forall a. Semigroup a => a -> a -> a
<> Expr -> Text
go Expr
e2
go (Or Expr
e1 Expr
e2) = Expr -> Text
go Expr
e1 forall a. Semigroup a => a -> a -> a
<> Text
" || " forall a. Semigroup a => a -> a -> a
<> Expr -> Text
go Expr
e2
go (Redir Expr
e RedirSpec
r) = let use :: Text -> Text
use Text
t = Expr -> Text
go Expr
e forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
t in case RedirSpec
r of
(RedirToFile Fd
fd String
f) ->
Text -> Text
use forall a b. (a -> b) -> a -> b
$ Fd -> Maybe Fd -> Text
redirFd Fd
fd (forall a. a -> Maybe a
Just Fd
stdOutput) forall a. Semigroup a => a -> a -> a
<> Text
"> " forall a. Semigroup a => a -> a -> a
<> forall a. Quoted a -> a
getQ (forall t. Quotable t => t -> Quoted Text
quote (String -> Text
L.pack String
f))
(RedirToFileAppend Fd
fd String
f) ->
Text -> Text
use forall a b. (a -> b) -> a -> b
$ Fd -> Maybe Fd -> Text
redirFd Fd
fd (forall a. a -> Maybe a
Just Fd
stdOutput) forall a. Semigroup a => a -> a -> a
<> Text
">> " forall a. Semigroup a => a -> a -> a
<> forall a. Quoted a -> a
getQ (forall t. Quotable t => t -> Quoted Text
quote (String -> Text
L.pack String
f))
(RedirFromFile Fd
fd String
f) ->
Text -> Text
use forall a b. (a -> b) -> a -> b
$ Fd -> Maybe Fd -> Text
redirFd Fd
fd (forall a. a -> Maybe a
Just Fd
stdInput) forall a. Semigroup a => a -> a -> a
<> Text
"< " forall a. Semigroup a => a -> a -> a
<> forall a. Quoted a -> a
getQ (forall t. Quotable t => t -> Quoted Text
quote (String -> Text
L.pack String
f))
(RedirOutput Fd
fd1 Fd
fd2) ->
Text -> Text
use forall a b. (a -> b) -> a -> b
$ Fd -> Maybe Fd -> Text
redirFd Fd
fd1 (forall a. a -> Maybe a
Just Fd
stdOutput) forall a. Semigroup a => a -> a -> a
<> Text
">&" forall a. Semigroup a => a -> a -> a
<> Fd -> Text
showFd Fd
fd2
(RedirInput Fd
fd1 Fd
fd2) ->
Text -> Text
use forall a b. (a -> b) -> a -> b
$ Fd -> Maybe Fd -> Text
redirFd Fd
fd1 (forall a. a -> Maybe a
Just Fd
stdInput) forall a. Semigroup a => a -> a -> a
<> Text
"<&" forall a. Semigroup a => a -> a -> a
<> Fd -> Text
showFd Fd
fd2
(RedirHereDoc Text
t)
| Bool
multiline ->
let myEOF :: Text
myEOF = Text -> Text
eofMarker Text
t
in Text -> Text
use forall a b. (a -> b) -> a -> b
$ Text
"<<" forall a. Semigroup a => a -> a -> a
<> Text
myEOF forall a. Semigroup a => a -> a -> a
<> Text
"\n"
forall a. Semigroup a => a -> a -> a
<> Text
t
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
forall a. Semigroup a => a -> a -> a
<> Text
myEOF
| Bool
otherwise ->
let heredoc :: Expr
heredoc = Text -> [Expr] -> Expr
Subshell Text
L.empty forall a b. (a -> b) -> a -> b
$
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map (Text -> [Text]
L.lines Text
t) forall a b. (a -> b) -> a -> b
$ \Text
l -> Text -> Expr
raw forall a b. (a -> b) -> a -> b
$
Text
"echo " forall a. Semigroup a => a -> a -> a
<> forall a. Quoted a -> a
getQ (forall t. Quotable t => t -> Quoted Text
quote Text
l)
in Expr -> Text
go (Expr -> Expr -> Expr
Pipe Expr
heredoc Expr
e)
redirFd :: Fd -> Maybe Fd -> L.Text
redirFd :: Fd -> Maybe Fd -> Text
redirFd Fd
fd Maybe Fd
deffd
| forall a. a -> Maybe a
Just Fd
fd forall a. Eq a => a -> a -> Bool
== Maybe Fd
deffd = Text
""
| Bool
otherwise = Fd -> Text
showFd Fd
fd
showFd :: Fd -> L.Text
showFd :: Fd -> Text
showFd = String -> Text
L.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
eofMarker :: L.Text -> L.Text
eofMarker :: Text -> Text
eofMarker Text
t = Integer -> Text
go (Integer
1 :: Integer)
where
go :: Integer -> Text
go Integer
n = let marker :: Text
marker = Text
"EOF" forall a. Semigroup a => a -> a -> a
<> if Integer
n forall a. Eq a => a -> a -> Bool
== Integer
1 then Text
"" else String -> Text
L.pack (forall a. Show a => a -> String
show Integer
n)
in if Text
marker Text -> Text -> Bool
`L.isInfixOf` Text
t
then Integer -> Text
go (forall a. Enum a => a -> a
succ Integer
n)
else Text
marker
linearScript :: Script f -> L.Text
linearScript :: forall f. Script f -> Text
linearScript = [Expr] -> Text
toLinearScript forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. Script f -> [Expr]
gen
toLinearScript :: [Expr] -> L.Text
toLinearScript :: [Expr] -> Text
toLinearScript = Text -> [Text] -> Text
L.intercalate Text
"; " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Expr -> Text
fmt Bool
False)
run :: L.Text -> [L.Text] -> Script ()
run :: Text -> [Text] -> Script ()
run Text
c [Text]
ps = Expr -> Script ()
add forall a b. (a -> b) -> a -> b
$ Text -> Expr
newCmd forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
L.intercalate Text
" " (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Quoted a -> a
getQ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Quotable t => t -> Quoted Text
quote) (Text
cforall a. a -> [a] -> [a]
:[Text]
ps))
newCmd :: L.Text -> Expr
newCmd :: Text -> Expr
newCmd Text
l = Indent -> [LocalEnv] -> Text -> Expr
Cmd Indent
0 [] Text
l
raw :: L.Text -> Expr
raw :: Text -> Expr
raw Text
l = Indent -> Text -> Expr
Raw Indent
0 Text
l
cmd :: (Param command, CmdParams params) => command -> params
cmd :: forall command params.
(Param command, CmdParams params) =>
command -> params
cmd command
c = forall t. CmdParams t => (Env -> Text) -> [Env -> Text] -> t
cmdAll (forall a. Param a => a -> Env -> Text
toTextParam command
c) []
class Param a where
toTextParam :: a -> Env -> L.Text
instance Param L.Text where
toTextParam :: Text -> Env -> Text
toTextParam = forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Quoted a -> a
getQ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Quotable t => t -> Quoted Text
quote
instance Param String where
toTextParam :: String -> Env -> Text
toTextParam = forall a. Param a => a -> Env -> Text
toTextParam forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
L.pack
instance Param UntypedVar where
toTextParam :: UntypedVar -> Env -> Text
toTextParam UntypedVar
v Env
env = Text
"\"" forall a. Semigroup a => a -> a -> a
<> forall a. Quoted a -> a
getQ (UntypedVar -> Env -> VarName -> Quoted Text
expandVar UntypedVar
v Env
env (UntypedVar -> VarName
varName UntypedVar
v)) forall a. Semigroup a => a -> a -> a
<> Text
"\""
instance Param (Term Var a) where
toTextParam :: Term Var a -> Env -> Text
toTextParam (VarTerm UntypedVar
v) = forall a. Param a => a -> Env -> Text
toTextParam UntypedVar
v
instance (Show a) => Param (Term Static a) where
toTextParam :: Term Static a -> Env -> Text
toTextParam (StaticTerm a
a) = forall a. Param a => a -> Env -> Text
toTextParam forall a b. (a -> b) -> a -> b
$ forall t. Quotable t => t -> Quoted Text
quote forall a b. (a -> b) -> a -> b
$ forall v. v -> Val v
Val a
a
instance Param (WithVar a) where
toTextParam :: WithVar a -> Env -> Text
toTextParam (WithVar Term Var a
v Quoted Text -> Quoted Text
f) = forall a. Quoted a -> a
getQ forall b c a. (b -> c) -> (a -> b) -> a -> c
. Quoted Text -> Quoted Text
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Quoted a
Q forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Param a => a -> Env -> Text
toTextParam Term Var a
v
instance Param (Quoted L.Text) where
toTextParam :: Quoted Text -> Env -> Text
toTextParam (Q Text
v) = forall a b. a -> b -> a
const Text
v
instance Param Output where
toTextParam :: Output -> Env -> Text
toTextParam (Output Script ()
s) Env
env =
let t :: Text
t = [Expr] -> Text
toLinearScript forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall f. Env -> Script f -> ([Expr], Env)
runScript Env
env Script ()
s
in Text
"\"$(" forall a. Semigroup a => a -> a -> a
<> Text
t forall a. Semigroup a => a -> a -> a
<> Text
")\""
instance Param Arith where
toTextParam :: Arith -> Env -> Text
toTextParam Arith
a Env
env =
let t :: Text
t = Env -> Arith -> Text
fmtArith Env
env Arith
a
in Text
"\"" forall a. Semigroup a => a -> a -> a
<> Text
t forall a. Semigroup a => a -> a -> a
<> Text
"\""
class CmdParams t where
cmdAll :: (Env -> L.Text) -> [Env -> L.Text] -> t
instance (Param arg, CmdParams result) => CmdParams (arg -> result) where
cmdAll :: (Env -> Text) -> [Env -> Text] -> arg -> result
cmdAll Env -> Text
c [Env -> Text]
acc arg
x = forall t. CmdParams t => (Env -> Text) -> [Env -> Text] -> t
cmdAll Env -> Text
c (forall a. Param a => a -> Env -> Text
toTextParam arg
x forall a. a -> [a] -> [a]
: [Env -> Text]
acc)
instance (f ~ ()) => CmdParams (Script f) where
cmdAll :: (Env -> Text) -> [Env -> Text] -> Script f
cmdAll Env -> Text
c [Env -> Text]
acc = forall a. (Env -> ([Expr], Env, a)) -> Script a
Script forall a b. (a -> b) -> a -> b
$ \Env
env ->
let ps :: [Text]
ps = forall a b. (a -> b) -> [a] -> [b]
map (\Env -> Text
f -> Env -> Text
f Env
env) (Env -> Text
c forall a. a -> [a] -> [a]
: forall a. [a] -> [a]
reverse [Env -> Text]
acc)
in ([Text -> Expr
newCmd forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
L.intercalate Text
" " [Text]
ps], Env
env, ())
newtype Output = Output (Script ())
data WithVar a = WithVar (Term Var a) (Quoted L.Text -> Quoted L.Text)
add :: Expr -> Script ()
add :: Expr -> Script ()
add Expr
expr = forall a. (Env -> ([Expr], Env, a)) -> Script a
Script forall a b. (a -> b) -> a -> b
$ \Env
env -> ([Expr
expr], Env
env, ())
comment :: L.Text -> Script ()
= Expr -> Script ()
add forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Expr
Comment
newtype NamedLike = NamedLike L.Text
class NameHinted h where
hinted :: (Maybe L.Text -> a) -> h -> a
instance NameHinted () where
hinted :: forall a. (Maybe Text -> a) -> () -> a
hinted Maybe Text -> a
f ()
_ = Maybe Text -> a
f forall a. Maybe a
Nothing
instance NameHinted NamedLike where
hinted :: forall a. (Maybe Text -> a) -> NamedLike -> a
hinted Maybe Text -> a
f (NamedLike Text
h) = Maybe Text -> a
f (forall a. a -> Maybe a
Just Text
h)
instance NameHinted (Maybe L.Text) where
hinted :: forall a. (Maybe Text -> a) -> Maybe Text -> a
hinted = forall a. a -> a
id
static :: (Quotable (Val t)) => t -> Term Static t
static :: forall t. Quotable (Val t) => t -> Term Static t
static = forall t. Quotable (Val t) => t -> Term Static t
StaticTerm
newVar :: (NameHinted namehint) => forall a. namehint -> Script (Term Var a)
newVar :: forall namehint a.
NameHinted namehint =>
namehint -> Script (Term Var a)
newVar = forall namehint t.
NameHinted namehint =>
Text -> namehint -> Script (Term Var t)
newVarContaining' Text
""
newVarContaining' :: (NameHinted namehint) => L.Text -> namehint -> Script (Term Var t)
newVarContaining' :: forall namehint t.
NameHinted namehint =>
Text -> namehint -> Script (Term Var t)
newVarContaining' Text
value = forall h a. NameHinted h => (Maybe Text -> a) -> h -> a
hinted forall a b. (a -> b) -> a -> b
$ \Maybe Text
namehint -> do
Term Var t
v <- forall namehint a.
NameHinted namehint =>
namehint -> Script (Term Var a)
newVarUnsafe Maybe Text
namehint
forall a. (Env -> ([Expr], Env, a)) -> Script a
Script forall a b. (a -> b) -> a -> b
$ \Env
env -> ([Text -> Expr
raw (forall t. Named t => t -> Text
getName Term Var t
v forall a. Semigroup a => a -> a -> a
<> Text
"=" forall a. Semigroup a => a -> a -> a
<> Text
value)], Env
env, Term Var t
v)
newVarFrom
:: (NameHinted namehint, Param param)
=> param -> namehint -> Script (Term Var t)
newVarFrom :: forall namehint param t.
(NameHinted namehint, Param param) =>
param -> namehint -> Script (Term Var t)
newVarFrom param
param namehint
namehint = do
Term Var t
v <- forall namehint a.
NameHinted namehint =>
namehint -> Script (Term Var a)
newVarUnsafe namehint
namehint
forall a. (Env -> ([Expr], Env, a)) -> Script a
Script forall a b. (a -> b) -> a -> b
$ \Env
env ->
([Text -> Expr
raw (forall t. Named t => t -> Text
getName Term Var t
v forall a. Semigroup a => a -> a -> a
<> Text
"=" forall a. Semigroup a => a -> a -> a
<> forall a. Param a => a -> Env -> Text
toTextParam param
param Env
env)], Env
env, Term Var t
v)
newVarContaining :: (NameHinted namehint, Quotable (Val t)) => t -> namehint -> Script (Term Var t)
newVarContaining :: forall namehint t.
(NameHinted namehint, Quotable (Val t)) =>
t -> namehint -> Script (Term Var t)
newVarContaining = forall namehint t.
NameHinted namehint =>
Text -> namehint -> Script (Term Var t)
newVarContaining' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Quoted a -> a
getQ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Quotable t => t -> Quoted Text
quote forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. v -> Val v
Val
setVar :: Param param => forall a. Term Var a -> param -> Script ()
setVar :: forall param a. Param param => Term Var a -> param -> Script ()
setVar Term Var a
v param
p = forall a. (Env -> ([Expr], Env, a)) -> Script a
Script forall a b. (a -> b) -> a -> b
$ \Env
env ->
([Text -> Expr
raw (forall t. Named t => t -> Text
getName Term Var a
v forall a. Semigroup a => a -> a -> a
<> Text
"=" forall a. Semigroup a => a -> a -> a
<> forall a. Param a => a -> Env -> Text
toTextParam param
p Env
env)], Env
env, ())
globalVar :: forall a. L.Text -> Script (Term Var a)
globalVar :: forall a. Text -> Script (Term Var a)
globalVar Text
name = forall a. (Env -> ([Expr], Env, a)) -> Script a
Script forall a b. (a -> b) -> a -> b
$ \Env
env ->
let v :: Term Var a
v = forall a. VarName -> Term Var a
simpleVar (Text -> VarName
VarName Text
name)
in ([], Env -> (Set VarName -> Set VarName) -> Env
modifyEnvVars Env
env (forall a. Ord a => a -> Set a -> Set a
S.insert (Text -> VarName
VarName (forall t. Named t => t -> Text
getName Term Var a
v))), Term Var a
v)
positionalParameters :: forall a. Term Var a
positionalParameters :: forall a. Term Var a
positionalParameters = forall a. VarName -> Term Var a
simpleVar (Text -> VarName
VarName Text
"@")
takeParameter :: (NameHinted namehint) => forall a. namehint -> Script (Term Var a)
takeParameter :: forall namehint a.
NameHinted namehint =>
namehint -> Script (Term Var a)
takeParameter = forall h a. NameHinted h => (Maybe Text -> a) -> h -> a
hinted forall a b. (a -> b) -> a -> b
$ \Maybe Text
namehint -> do
Term Var a
p <- forall namehint a.
NameHinted namehint =>
namehint -> Script (Term Var a)
newVarUnsafe Maybe Text
namehint
forall a. (Env -> ([Expr], Env, a)) -> Script a
Script forall a b. (a -> b) -> a -> b
$ \Env
env -> ([Text -> Expr
raw (forall t. Named t => t -> Text
getName Term Var a
p forall a. Semigroup a => a -> a -> a
<> Text
"=\"$1\""), Text -> Expr
raw Text
"shift"], Env
env, Term Var a
p)
newVarUnsafe :: (NameHinted namehint) => forall a. namehint -> Script (Term Var a)
newVarUnsafe :: forall namehint a.
NameHinted namehint =>
namehint -> Script (Term Var a)
newVarUnsafe namehint
hint = forall a. UntypedVar -> Term Var a
VarTerm forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall namehint.
NameHinted namehint =>
namehint -> Script UntypedVar
newVarUnsafe' namehint
hint
newVarUnsafe' :: (NameHinted namehint) => namehint -> Script UntypedVar
newVarUnsafe' :: forall namehint.
NameHinted namehint =>
namehint -> Script UntypedVar
newVarUnsafe' = forall h a. NameHinted h => (Maybe Text -> a) -> h -> a
hinted forall a b. (a -> b) -> a -> b
$ \Maybe Text
namehint -> forall a. (Env -> ([Expr], Env, a)) -> Script a
Script forall a b. (a -> b) -> a -> b
$ \Env
env ->
let name :: VarName
name = forall {t}.
(Eq t, Num t, Show t, Enum t) =>
Maybe Text -> Env -> t -> VarName
go Maybe Text
namehint Env
env (Integer
0 :: Integer)
in ([], Env -> (Set VarName -> Set VarName) -> Env
modifyEnvVars Env
env (forall a. Ord a => a -> Set a -> Set a
S.insert VarName
name), VarName -> UntypedVar
simpleVar' VarName
name)
where
go :: Maybe Text -> Env -> t -> VarName
go Maybe Text
namehint Env
env t
x
| forall a. Ord a => a -> Set a -> Bool
S.member VarName
name (Env -> Set VarName
envVars Env
env) =
Maybe Text -> Env -> t -> VarName
go Maybe Text
namehint Env
env (forall a. Enum a => a -> a
succ t
x)
| Bool
otherwise = VarName
name
where
name :: VarName
name = Text -> VarName
VarName forall a b. (a -> b) -> a -> b
$ Text
"_"
forall a. Semigroup a => a -> a -> a
<> Maybe Text -> Text
genvarname Maybe Text
namehint
forall a. Semigroup a => a -> a -> a
<> if t
x forall a. Eq a => a -> a -> Bool
== t
0 then Text
"" else String -> Text
L.pack (forall a. Show a => a -> String
show (t
x forall a. Num a => a -> a -> a
+ t
1))
genvarname :: Maybe Text -> Text
genvarname = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"v" ((Char -> Bool) -> Text -> Text
L.filter Char -> Bool
isAlpha)
defaultVar :: (Param param) => forall a. Term Var a -> param -> Script (Term Var a)
defaultVar :: forall param a.
Param param =>
Term Var a -> param -> Script (Term Var a)
defaultVar = forall param a b.
Param param =>
Text -> Term Var a -> param -> Script (Term Var b)
funcVar' Text
":-"
whenVar :: (Param param) => forall a. Term Var a -> param -> Script (Term Var a)
whenVar :: forall param a.
Param param =>
Term Var a -> param -> Script (Term Var a)
whenVar = forall param a b.
Param param =>
Text -> Term Var a -> param -> Script (Term Var b)
funcVar' Text
":+"
errUnlessVar :: (Param param) => forall a. Term Var a -> param -> Script (Term Var a)
errUnlessVar :: forall param a.
Param param =>
Term Var a -> param -> Script (Term Var a)
errUnlessVar = forall param a b.
Param param =>
Text -> Term Var a -> param -> Script (Term Var b)
funcVar' Text
":?"
trimVar :: forall a. Greediness -> Direction -> Term Var String -> Quoted L.Text -> Script (Term Var a)
trimVar :: forall a.
Greediness
-> Direction
-> Term Var String
-> Quoted Text
-> Script (Term Var a)
trimVar Greediness
ShortestMatch Direction
FromBeginning = forall param a b.
Param param =>
Text -> Term Var a -> param -> Script (Term Var b)
funcVar' Text
"#"
trimVar Greediness
LongestMatch Direction
FromBeginning = forall param a b.
Param param =>
Text -> Term Var a -> param -> Script (Term Var b)
funcVar' Text
"##"
trimVar Greediness
ShortestMatch Direction
FromEnd = forall param a b.
Param param =>
Text -> Term Var a -> param -> Script (Term Var b)
funcVar' Text
"%"
trimVar Greediness
LongestMatch Direction
FromEnd = forall param a b.
Param param =>
Text -> Term Var a -> param -> Script (Term Var b)
funcVar' Text
"%%"
data Greediness = ShortestMatch | LongestMatch
data Direction = FromBeginning | FromEnd
lengthVar :: forall a. Term Var a -> Script (Term Var Integer)
lengthVar :: forall a. Term Var a -> Script (Term Var Integer)
lengthVar Term Var a
v
| forall t. Named t => t -> Text
getName Term Var a
v forall a. Eq a => a -> a -> Bool
== Text
"@" = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. VarName -> Term Var a
simpleVar (Text -> VarName
VarName Text
"#")
| Bool
otherwise = forall a b. Term Var a -> (Text -> Text) -> Script (Term Var b)
funcVar Term Var a
v (Text
"#" forall a. Semigroup a => a -> a -> a
<>)
funcVar :: forall a b. Term Var a -> (L.Text -> L.Text) -> Script (Term Var b)
funcVar :: forall a b. Term Var a -> (Text -> Text) -> Script (Term Var b)
funcVar Term Var a
orig Text -> Text
transform = do
UntypedVar
v <- forall namehint.
NameHinted namehint =>
namehint -> Script UntypedVar
newVarUnsafe' NamedLike
shortname
Script ()
f <- Term Var () -> Script (Script ())
mkFunc (forall a. UntypedVar -> Term Var a
VarTerm UntypedVar
v)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. UntypedVar -> Term Var a
VarTerm forall a b. (a -> b) -> a -> b
$ UntypedVar
v
{ expandVar :: Env -> VarName -> Quoted Text
expandVar = \Env
env VarName
_ -> forall a. a -> Quoted a
Q forall a b. (a -> b) -> a -> b
$
Text
"$(" forall a. Semigroup a => a -> a -> a
<> [Expr] -> Text
toLinearScript (forall a b. (a, b) -> a
fst (forall f. Env -> Script f -> ([Expr], Env)
runScript Env
env Script ()
f)) forall a. Semigroup a => a -> a -> a
<> Text
")"
}
where
mkFunc :: Term Var () -> Script (Script ())
mkFunc :: Term Var () -> Script (Script ())
mkFunc Term Var ()
tmp = forall namehint callfunc.
(NameHinted namehint, CmdParams callfunc) =>
namehint -> Script () -> Script callfunc
func NamedLike
shortname forall a b. (a -> b) -> a -> b
$ do
forall param a. Param param => Term Var a -> param -> Script ()
setVar Term Var ()
tmp Term Var a
orig
forall command params.
(Param command, CmdParams params) =>
command -> params
cmd (Text
"echo" :: L.Text) forall a b. (a -> b) -> a -> b
$ forall a. a -> Quoted a
Q forall a b. (a -> b) -> a -> b
$
Text
"\"${" forall a. Semigroup a => a -> a -> a
<> Text -> Text
transform (forall t. Named t => t -> Text
getName Term Var ()
tmp) forall a. Semigroup a => a -> a -> a
<> Text
"}\""
shortname :: NamedLike
shortname = Text -> NamedLike
NamedLike Text
"v"
funcVar' :: (Param param) => forall a b. L.Text -> Term Var a -> param -> Script (Term Var b)
funcVar' :: forall param a b.
Param param =>
Text -> Term Var a -> param -> Script (Term Var b)
funcVar' Text
op Term Var a
v param
p = do
Text
t <- forall a. Param a => a -> Env -> Text
toTextParam param
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Script Env
getEnv
forall a b. Term Var a -> (Text -> Text) -> Script (Term Var b)
funcVar Term Var a
v (forall a. Semigroup a => a -> a -> a
<> Text
op forall a. Semigroup a => a -> a -> a
<> Text
t)
func
:: (NameHinted namehint, CmdParams callfunc)
=> namehint
-> Script ()
-> Script callfunc
func :: forall namehint callfunc.
(NameHinted namehint, CmdParams callfunc) =>
namehint -> Script () -> Script callfunc
func namehint
h Script ()
s = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall h a. NameHinted h => (Maybe Text -> a) -> h -> a
hinted namehint
h forall a b. (a -> b) -> a -> b
$ \Maybe Text
namehint -> forall a. (Env -> ([Expr], Env, a)) -> Script a
Script forall a b. (a -> b) -> a -> b
$ \Env
env ->
let f :: Func
f = forall {t}.
(Eq t, Num t, Show t, Enum t) =>
Text -> Env -> t -> Func
go (Maybe Text -> Text
genfuncname Maybe Text
namehint) Env
env (Integer
0 :: Integer)
env' :: Env
env' = Env -> (Set Func -> Set Func) -> Env
modifyEnvFuncs Env
env (forall a. Ord a => a -> Set a -> Set a
S.insert Func
f)
([Expr]
ls, Env
env'') = forall f. Env -> Script f -> ([Expr], Env)
runScript Env
env' Script ()
s
in (Func -> [Expr] -> [Expr]
definefunc Func
f [Expr]
ls, Env
env'', forall {params}. CmdParams params => Func -> params
callfunc Func
f)
where
go :: Text -> Env -> t -> Func
go Text
basename Env
env t
x
| forall a. Ord a => a -> Set a -> Bool
S.member Func
f (Env -> Set Func
envFuncs Env
env) = Text -> Env -> t -> Func
go Text
basename Env
env (forall a. Enum a => a -> a
succ t
x)
| Bool
otherwise = Func
f
where
f :: Func
f = Text -> Func
Func forall a b. (a -> b) -> a -> b
$ Text
"_"
forall a. Semigroup a => a -> a -> a
<> Text
basename
forall a. Semigroup a => a -> a -> a
<> if t
x forall a. Eq a => a -> a -> Bool
== t
0 then Text
"" else String -> Text
L.pack (forall a. Show a => a -> String
show (t
x forall a. Num a => a -> a -> a
+ t
1))
genfuncname :: Maybe Text -> Text
genfuncname = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"p" ((Char -> Bool) -> Text -> Text
L.filter Char -> Bool
isAlpha)
definefunc :: Func -> [Expr] -> [Expr]
definefunc (Func Text
f) [Expr]
ls = (Text -> Expr
raw forall a b. (a -> b) -> a -> b
$ Text
f forall a. Semigroup a => a -> a -> a
<> Text
" () { :") forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map Expr -> Expr
indent [Expr]
ls forall a. [a] -> [a] -> [a]
++ [ Text -> Expr
raw Text
"}" ]
callfunc :: Func -> params
callfunc (Func Text
f) = forall command params.
(Param command, CmdParams params) =>
command -> params
cmd Text
f
forCmd :: forall a. Script () -> (Term Var a -> Script ()) -> Script ()
forCmd :: forall a. Script () -> (Term Var a -> Script ()) -> Script ()
forCmd Script ()
c Term Var a -> Script ()
a = do
Term Var a
v <- forall namehint a.
NameHinted namehint =>
namehint -> Script (Term Var a)
newVarUnsafe (Text -> NamedLike
NamedLike Text
"x")
Text
s <- [Expr] -> Text
toLinearScript forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Script () -> Script [Expr]
runM Script ()
c
Expr -> Script ()
add forall a b. (a -> b) -> a -> b
$ Text -> Expr
raw forall a b. (a -> b) -> a -> b
$ Text
"for " forall a. Semigroup a => a -> a -> a
<> forall t. Named t => t -> Text
getName Term Var a
v forall a. Semigroup a => a -> a -> a
<> Text
" in $(" forall a. Semigroup a => a -> a -> a
<> Text
s forall a. Semigroup a => a -> a -> a
<> Text
")"
Text -> Script () -> Script ()
block Text
"do" (Term Var a -> Script ()
a Term Var a
v)
Expr -> Script ()
add forall a b. (a -> b) -> a -> b
$ Text -> Expr
raw Text
"done"
whileCmd :: Script () -> Script () -> Script ()
whileCmd :: Script () -> Script () -> Script ()
whileCmd Script ()
c Script ()
a = do
Text
s <- [Expr] -> Text
toLinearScript forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Script () -> Script [Expr]
runM Script ()
c
Expr -> Script ()
add forall a b. (a -> b) -> a -> b
$ Text -> Expr
raw forall a b. (a -> b) -> a -> b
$ Text
"while $(" forall a. Semigroup a => a -> a -> a
<> Text
s forall a. Semigroup a => a -> a -> a
<> Text
")"
Text -> Script () -> Script ()
block Text
"do" Script ()
a
Expr -> Script ()
add forall a b. (a -> b) -> a -> b
$ Text -> Expr
raw Text
"done"
ifCmd :: Script () -> Script () -> Script () -> Script ()
ifCmd :: Script () -> Script () -> Script () -> Script ()
ifCmd Script ()
cond Script ()
thena Script ()
elsea =
(Text -> Text) -> Script () -> Script () -> Script ()
ifCmd' forall a. a -> a
id Script ()
cond forall a b. (a -> b) -> a -> b
$ do
Text -> Script () -> Script ()
block Text
"then" Script ()
thena
Text -> Script () -> Script ()
block Text
"else" Script ()
elsea
ifCmd' :: (L.Text -> L.Text) -> Script () -> Script () -> Script ()
ifCmd' :: (Text -> Text) -> Script () -> Script () -> Script ()
ifCmd' Text -> Text
condf Script ()
cond Script ()
body = do
[Expr]
condl <- Script () -> Script [Expr]
runM Script ()
cond
Expr -> Script ()
add forall a b. (a -> b) -> a -> b
$ Text -> Expr
raw forall a b. (a -> b) -> a -> b
$ Text
"if " forall a. Semigroup a => a -> a -> a
<> Text -> Text
condf ([Expr] -> Text
singleline [Expr]
condl)
Script ()
body
Expr -> Script ()
add forall a b. (a -> b) -> a -> b
$ Text -> Expr
raw Text
"fi"
where
singleline :: [Expr] -> Text
singleline [Expr]
l =
let c :: Expr
c = case [Expr]
l of
[c' :: Expr
c'@(Cmd {})] -> Expr
c'
[c' :: Expr
c'@(Raw {})] -> Expr
c'
[c' :: Expr
c'@(Subshell {})] -> Expr
c'
[Expr]
_ -> Text -> [Expr] -> Expr
Subshell Text
L.empty [Expr]
l
in [Expr] -> Text
toLinearScript [Expr
c]
whenCmd :: Script () -> Script () -> Script ()
whenCmd :: Script () -> Script () -> Script ()
whenCmd Script ()
cond Script ()
a =
(Text -> Text) -> Script () -> Script () -> Script ()
ifCmd' forall a. a -> a
id Script ()
cond forall a b. (a -> b) -> a -> b
$
Text -> Script () -> Script ()
block Text
"then" Script ()
a
unlessCmd :: Script () -> Script () -> Script ()
unlessCmd :: Script () -> Script () -> Script ()
unlessCmd Script ()
cond Script ()
a =
(Text -> Text) -> Script () -> Script () -> Script ()
ifCmd' (Text
"! " forall a. Semigroup a => a -> a -> a
<>) Script ()
cond forall a b. (a -> b) -> a -> b
$
Text -> Script () -> Script ()
block Text
"then" Script ()
a
caseOf :: forall a. Term Var a -> [(Quoted L.Text, Script ())] -> Script ()
caseOf :: forall a. Term Var a -> [(Quoted Text, Script ())] -> Script ()
caseOf Term Var a
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
caseOf Term Var a
v [(Quoted Text, Script ())]
l = Bool -> [(Quoted Text, Script ())] -> Script ()
go Bool
True [(Quoted Text, Script ())]
l
where
go :: Bool -> [(Quoted Text, Script ())] -> Script ()
go Bool
_ [] = Expr -> Script ()
add forall a b. (a -> b) -> a -> b
$ Text -> Expr
raw Text
";; esac"
go Bool
atstart ((Quoted Text
t, Script ()
s):[(Quoted Text, Script ())]
rest) = do
Env
env <- Script Env
getEnv
let leader :: Text
leader = if Bool
atstart
then Text
"case " forall a. Semigroup a => a -> a -> a
<> forall a. Param a => a -> Env -> Text
toTextParam Term Var a
v Env
env forall a. Semigroup a => a -> a -> a
<> Text
" in "
else Text
": ;; "
Expr -> Script ()
add forall a b. (a -> b) -> a -> b
$ Text -> Expr
raw forall a b. (a -> b) -> a -> b
$ Text
leader forall a. Semigroup a => a -> a -> a
<> forall a. Quoted a -> a
getQ Quoted Text
t forall a. Semigroup a => a -> a -> a
<> Text
") :"
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Expr -> Script ()
add forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Expr
indent) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Script () -> Script [Expr]
runM Script ()
s
Bool -> [(Quoted Text, Script ())] -> Script ()
go Bool
False [(Quoted Text, Script ())]
rest
subshell :: Script () -> Script ()
subshell :: Script () -> Script ()
subshell Script ()
s = do
[Expr]
e <- Script () -> Script [Expr]
runM Script ()
s
Expr -> Script ()
add forall a b. (a -> b) -> a -> b
$ Text -> [Expr] -> Expr
Subshell Text
"" [Expr]
e
group :: Script () -> Script ()
group :: Script () -> Script ()
group Script ()
s = do
[Expr]
e <- Script () -> Script [Expr]
runM Script ()
s
Expr -> Script ()
add forall a b. (a -> b) -> a -> b
$ Text -> [Expr] -> Expr
Group Text
"" [Expr]
e
withEnv :: Param value => L.Text -> value -> Script () -> Script ()
withEnv :: forall value.
Param value =>
Text -> value -> Script () -> Script ()
withEnv Text
n value
v (Script Env -> ([Expr], Env, ())
f) = forall a. (Env -> ([Expr], Env, a)) -> Script a
Script forall a b. (a -> b) -> a -> b
$ ([Expr], Env, ()) -> ([Expr], Env, ())
addEnv forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env -> ([Expr], Env, ())
f
where
addEnv :: ([Expr], Env, ()) -> ([Expr], Env, ())
addEnv ([Expr]
e, Env
env, ()
_) = let localenv :: LocalEnv
localenv = (Text
n, forall a. Param a => a -> Env -> Text
toTextParam value
v Env
env)
in case [Expr]
e of
[Cmd Indent
i [LocalEnv]
localenvs Text
l] -> ([Indent -> [LocalEnv] -> Text -> Expr
Cmd Indent
i (LocalEnv
localenv forall a. a -> [a] -> [a]
: [LocalEnv]
localenvs) Text
l], Env
env, ())
[EnvWrap Indent
i Text
envName [LocalEnv]
localenvs [Expr]
e'] -> ([Indent -> Text -> [LocalEnv] -> [Expr] -> Expr
EnvWrap Indent
i Text
envName (LocalEnv
localenv forall a. a -> [a] -> [a]
: [LocalEnv]
localenvs) [Expr]
e'], Env
env, ())
[Expr]
l -> ([Indent -> Text -> [LocalEnv] -> [Expr] -> Expr
EnvWrap Indent
0 (forall t. Named t => t -> Text
getName UntypedVar
name) [LocalEnv
localenv] [Expr]
l], Env
env', ())
where
(Script Env -> ([Expr], Env, UntypedVar)
nameFn) = forall namehint.
NameHinted namehint =>
namehint -> Script UntypedVar
newVarUnsafe' (Text -> NamedLike
NamedLike Text
"envfn")
([Expr]
_, Env
env', UntypedVar
name) = Env -> ([Expr], Env, UntypedVar)
nameFn Env
env
block :: L.Text -> Script () -> Script ()
block :: Text -> Script () -> Script ()
block Text
word Script ()
s = do
Expr -> Script ()
add forall a b. (a -> b) -> a -> b
$ Text -> Expr
raw forall a b. (a -> b) -> a -> b
$ Text
word forall a. Semigroup a => a -> a -> a
<> Text
" :"
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Expr -> Script ()
add forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Expr
indent) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Script () -> Script [Expr]
runM Script ()
s
readVar :: Term Var String -> Script ()
readVar :: Term Var String -> Script ()
readVar Term Var String
v = Expr -> Script ()
add forall a b. (a -> b) -> a -> b
$ Text -> Expr
newCmd forall a b. (a -> b) -> a -> b
$ Text
"read " forall a. Semigroup a => a -> a -> a
<> forall a. Quoted a -> a
getQ (forall t. Quotable t => t -> Quoted Text
quote (forall t. Named t => t -> Text
getName Term Var String
v))
stopOnFailure :: Bool -> Script ()
stopOnFailure :: Bool -> Script ()
stopOnFailure Bool
b = Expr -> Script ()
add forall a b. (a -> b) -> a -> b
$ Text -> Expr
raw forall a b. (a -> b) -> a -> b
$ Text
"set " forall a. Semigroup a => a -> a -> a
<> (if Bool
b then Text
"-" else Text
"+") forall a. Semigroup a => a -> a -> a
<> Text
"e"
ignoreFailure :: Script () -> Script ()
ignoreFailure :: Script () -> Script ()
ignoreFailure Script ()
s = Script () -> Script [Expr]
runM Script ()
s forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Expr -> Script ()
add forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Expr
go)
where
go :: Expr -> Expr
go c :: Expr
c@(Cmd Indent
_ [LocalEnv]
_ Text
_) = Expr -> Expr -> Expr
Or Expr
c Expr
true
go c :: Expr
c@(Raw Indent
_ Text
_) = Expr -> Expr -> Expr
Or Expr
c Expr
true
go c :: Expr
c@(Comment Text
_) = Expr
c
go (EnvWrap Indent
i Text
n [LocalEnv]
localenvs [Expr]
e) = Indent -> Text -> [LocalEnv] -> [Expr] -> Expr
EnvWrap Indent
i Text
n [LocalEnv]
localenvs (forall a b. (a -> b) -> [a] -> [b]
map Expr -> Expr
go [Expr]
e)
go (Subshell Text
i [Expr]
l) = Text -> [Expr] -> Expr
Subshell Text
i (forall a b. (a -> b) -> [a] -> [b]
map Expr -> Expr
go [Expr]
l)
go (Group Text
i [Expr]
l) = Text -> [Expr] -> Expr
Group Text
i (forall a b. (a -> b) -> [a] -> [b]
map Expr -> Expr
go [Expr]
l)
go (Pipe Expr
e1 Expr
e2) = Expr -> Expr -> Expr
Pipe Expr
e1 (Expr -> Expr
go Expr
e2)
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"
(-|-) :: Script () -> Script () -> Script ()
-|- :: Script () -> Script () -> Script ()
(-|-) = (Expr -> Expr -> Expr) -> Script () -> Script () -> Script ()
combine Expr -> Expr -> Expr
Pipe
(-&&-) :: Script () -> Script () -> Script ()
-&&- :: Script () -> Script () -> Script ()
(-&&-) = (Expr -> Expr -> Expr) -> Script () -> Script () -> Script ()
combine Expr -> Expr -> Expr
And
(-||-) :: Script () -> Script () -> Script ()
-||- :: Script () -> Script () -> Script ()
(-||-) = (Expr -> Expr -> Expr) -> Script () -> Script () -> Script ()
combine Expr -> Expr -> Expr
Or
combine :: (Expr -> Expr -> Expr) -> Script () -> Script () -> Script ()
combine :: (Expr -> Expr -> Expr) -> Script () -> Script () -> Script ()
combine Expr -> Expr -> Expr
f Script ()
a Script ()
b = do
[Expr]
alines <- Script () -> Script [Expr]
runM Script ()
a
[Expr]
blines <- Script () -> Script [Expr]
runM Script ()
b
Expr -> Script ()
add forall a b. (a -> b) -> a -> b
$ Expr -> Expr -> Expr
f ([Expr] -> Expr
toSingleExp [Expr]
alines) ([Expr] -> Expr
toSingleExp [Expr]
blines)
toSingleExp :: [Expr] -> Expr
toSingleExp :: [Expr] -> Expr
toSingleExp [Expr
e] = Expr
e
toSingleExp [Expr]
l = Text -> [Expr] -> Expr
Subshell Text
L.empty [Expr]
l
redir :: Script () -> RedirSpec -> Script ()
redir :: Script () -> RedirSpec -> Script ()
redir Script ()
s RedirSpec
r = do
Expr
e <- [Expr] -> Expr
toSingleExp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Script () -> Script [Expr]
runM Script ()
s
Expr -> Script ()
add forall a b. (a -> b) -> a -> b
$ Expr -> RedirSpec -> Expr
Redir Expr
e RedirSpec
r
class RedirFile r where
fromRedirFile :: Fd -> r -> (Fd, FilePath)
instance RedirFile FilePath where
fromRedirFile :: Fd -> String -> (Fd, String)
fromRedirFile = (,)
instance RedirFile (Fd, FilePath) where
fromRedirFile :: Fd -> (Fd, String) -> (Fd, String)
fromRedirFile = forall a b. a -> b -> a
const forall a. a -> a
id
fileRedir :: RedirFile f => f -> Fd -> (Fd -> FilePath -> RedirSpec) -> RedirSpec
fileRedir :: forall f.
RedirFile f =>
f -> Fd -> (Fd -> String -> RedirSpec) -> RedirSpec
fileRedir f
f Fd
deffd Fd -> String -> RedirSpec
c = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Fd -> String -> RedirSpec
c (forall r. RedirFile r => Fd -> r -> (Fd, String)
fromRedirFile Fd
deffd f
f)
(|>) :: RedirFile f => Script () -> f -> Script ()
Script ()
s |> :: forall f. RedirFile f => Script () -> f -> Script ()
|> f
f = Script () -> RedirSpec -> Script ()
redir Script ()
s (forall f.
RedirFile f =>
f -> Fd -> (Fd -> String -> RedirSpec) -> RedirSpec
fileRedir f
f Fd
stdOutput Fd -> String -> RedirSpec
RedirToFile)
(|>>) :: RedirFile f => Script () -> f -> Script ()
Script ()
s |>> :: forall f. RedirFile f => Script () -> f -> Script ()
|>> f
f = Script () -> RedirSpec -> Script ()
redir Script ()
s (forall f.
RedirFile f =>
f -> Fd -> (Fd -> String -> RedirSpec) -> RedirSpec
fileRedir f
f Fd
stdOutput Fd -> String -> RedirSpec
RedirToFileAppend)
(|<) :: RedirFile f => Script () -> f -> Script ()
Script ()
s |< :: forall f. RedirFile f => Script () -> f -> Script ()
|< f
f = Script () -> RedirSpec -> Script ()
redir Script ()
s (forall f.
RedirFile f =>
f -> Fd -> (Fd -> String -> RedirSpec) -> RedirSpec
fileRedir f
f Fd
stdInput Fd -> String -> RedirSpec
RedirFromFile)
toStderr :: Script () -> Script ()
toStderr :: Script () -> Script ()
toStderr Script ()
s = Script ()
s Script () -> Fd -> (Script (), Fd)
&Fd
stdOutput(Script (), Fd) -> Fd -> Script ()
>&Fd
stdError
(>&) :: (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)
(<&) :: (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)
(&) :: Script () -> Fd -> (Script (), Fd)
& :: Script () -> Fd -> (Script (), Fd)
(&) = (,)
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)
test :: Test -> Script ()
test :: Test -> Script ()
test Test
t = forall a. (Env -> ([Expr], Env, a)) -> Script a
Script forall a b. (a -> b) -> a -> b
$ \Env
env -> ([Text -> Expr
newCmd forall a b. (a -> b) -> a -> b
$ Text
"test " forall a. Semigroup a => a -> a -> a
<> Env -> Test -> Text
mkTest Env
env Test
t], Env
env, ())
mkTest :: Env -> Test -> L.Text
mkTest :: Env -> Test -> Text
mkTest Env
env = Test -> Text
go
where
go :: Test -> Text
go (TNot Test
t) = forall {a}. (Semigroup a, IsString a) => a -> a -> a
unop Text
"!" (Test -> Text
go Test
t)
go (TAnd Test
t1 Test
t2) = forall {a}. (Semigroup a, IsString a) => a -> a -> a -> a
binop (Test -> Text
go Test
t1) Text
"&&" (Test -> Text
go Test
t2)
go (TOr Test
t1 Test
t2) = forall {a}. (Semigroup a, IsString a) => a -> a -> a -> a
binop (Test -> Text
go Test
t1) Text
"||" (Test -> Text
go Test
t2)
go (TEmpty p
p) = forall {a}. (Semigroup a, IsString a) => a -> a -> a
unop Text
"-z" (forall p. Param p => p -> Text
pv p
p)
go (TNonEmpty p
p) = forall {a}. (Semigroup a, IsString a) => a -> a -> a
unop Text
"-n" (forall p. Param p => p -> Text
pv p
p)
go (TStrEqual p
p1 q
p2) = forall {a}. (Semigroup a, IsString a) => a -> a -> a -> a
binop (forall p. Param p => p -> Text
pv p
p1) Text
"=" (forall p. Param p => p -> Text
pv q
p2)
go (TStrNotEqual p
p1 q
p2) = forall {a}. (Semigroup a, IsString a) => a -> a -> a -> a
binop (forall p. Param p => p -> Text
pv p
p1) Text
"!=" (forall p. Param p => p -> Text
pv q
p2)
go (TEqual Term Var p
p1 Term Var q
p2) = forall {a}. (Semigroup a, IsString a) => a -> a -> a -> a
binop (forall p. Param p => p -> Text
pv Term Var p
p1) Text
"-eq" (forall p. Param p => p -> Text
pv Term Var q
p2)
go (TNotEqual Term Var p
p1 Term Var q
p2) = forall {a}. (Semigroup a, IsString a) => a -> a -> a -> a
binop (forall p. Param p => p -> Text
pv Term Var p
p1) Text
"-ne" (forall p. Param p => p -> Text
pv Term Var q
p2)
go (TGT Term Var p
p1 Term Var q
p2) = forall {a}. (Semigroup a, IsString a) => a -> a -> a -> a
binop (forall p. Param p => p -> Text
pv Term Var p
p1) Text
"-gt" (forall p. Param p => p -> Text
pv Term Var q
p2)
go (TLT Term Var p
p1 Term Var q
p2) = forall {a}. (Semigroup a, IsString a) => a -> a -> a -> a
binop (forall p. Param p => p -> Text
pv Term Var p
p1) Text
"-lt" (forall p. Param p => p -> Text
pv Term Var q
p2)
go (TGE Term Var p
p1 Term Var q
p2) = forall {a}. (Semigroup a, IsString a) => a -> a -> a -> a
binop (forall p. Param p => p -> Text
pv Term Var p
p1) Text
"-ge" (forall p. Param p => p -> Text
pv Term Var q
p2)
go (TLE Term Var p
p1 Term Var q
p2) = forall {a}. (Semigroup a, IsString a) => a -> a -> a -> a
binop (forall p. Param p => p -> Text
pv Term Var p
p1) Text
"-le" (forall p. Param p => p -> Text
pv Term Var q
p2)
go (TFileEqual p
p1 q
p2) = forall {a}. (Semigroup a, IsString a) => a -> a -> a -> a
binop (forall p. Param p => p -> Text
pv p
p1) Text
"-ef" (forall p. Param p => p -> Text
pv q
p2)
go (TFileNewer p
p1 q
p2) = forall {a}. (Semigroup a, IsString a) => a -> a -> a -> a
binop (forall p. Param p => p -> Text
pv p
p1) Text
"-nt" (forall p. Param p => p -> Text
pv q
p2)
go (TFileOlder p
p1 q
p2) = forall {a}. (Semigroup a, IsString a) => a -> a -> a -> a
binop (forall p. Param p => p -> Text
pv p
p1) Text
"-ot" (forall p. Param p => p -> Text
pv q
p2)
go (TBlockExists p
p) = forall {a}. (Semigroup a, IsString a) => a -> a -> a
unop Text
"-b" (forall p. Param p => p -> Text
pv p
p)
go (TCharExists p
p) = forall {a}. (Semigroup a, IsString a) => a -> a -> a
unop Text
"-c" (forall p. Param p => p -> Text
pv p
p)
go (TDirExists p
p) = forall {a}. (Semigroup a, IsString a) => a -> a -> a
unop Text
"-d" (forall p. Param p => p -> Text
pv p
p)
go (TFileExists p
p) = forall {a}. (Semigroup a, IsString a) => a -> a -> a
unop Text
"-e" (forall p. Param p => p -> Text
pv p
p)
go (TRegularFileExists p
p) = forall {a}. (Semigroup a, IsString a) => a -> a -> a
unop Text
"-f" (forall p. Param p => p -> Text
pv p
p)
go (TSymlinkExists p
p) = forall {a}. (Semigroup a, IsString a) => a -> a -> a
unop Text
"-L" (forall p. Param p => p -> Text
pv p
p)
go (TFileNonEmpty p
p) = forall {a}. (Semigroup a, IsString a) => a -> a -> a
unop Text
"-s" (forall p. Param p => p -> Text
pv p
p)
go (TFileExecutable p
p) = forall {a}. (Semigroup a, IsString a) => a -> a -> a
unop Text
"-x" (forall p. Param p => p -> Text
pv p
p)
paren :: a -> a
paren a
t = a
"\\( " forall a. Semigroup a => a -> a -> a
<> a
t forall a. Semigroup a => a -> a -> a
<> a
" \\)"
binop :: a -> a -> a -> a
binop a
a a
o a
b = forall {a}. (Semigroup a, IsString a) => a -> a
paren forall a b. (a -> b) -> a -> b
$ a
a forall a. Semigroup a => a -> a -> a
<> a
" " forall a. Semigroup a => a -> a -> a
<> a
o forall a. Semigroup a => a -> a -> a
<> a
" " forall a. Semigroup a => a -> a -> a
<> a
b
unop :: a -> a -> a
unop a
o a
v = forall {a}. (Semigroup a, IsString a) => a -> a
paren forall a b. (a -> b) -> a -> b
$ a
o forall a. Semigroup a => a -> a -> a
<> a
" " forall a. Semigroup a => a -> a -> a
<> a
v
pv :: (Param p) => p -> L.Text
pv :: forall p. Param p => p -> Text
pv = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Param a => a -> Env -> Text
toTextParam Env
env
data Test where
TNot :: Test -> Test
TAnd :: Test -> Test -> Test
TOr :: Test -> Test -> Test
TEmpty :: (Param p) => p -> Test
TNonEmpty :: (Param p) => p -> Test
TStrEqual :: (Param p, Param q) => p -> q -> Test
TStrNotEqual :: (Param p, Param q) => p -> q -> Test
TEqual :: (Integral p, Integral q) => Term Var p -> Term Var q -> Test
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
TFileNewer :: (Param p, Param q) => p -> q -> Test
TFileOlder :: (Param p, Param q) => p -> q -> Test
TBlockExists :: (Param p) => p -> Test
TCharExists :: (Param p) => p -> Test
TDirExists :: (Param p) => p -> Test
TFileExists :: (Param p) => p -> Test
TRegularFileExists :: (Param p) => p -> Test
TSymlinkExists :: (Param p) => p -> Test
TFileNonEmpty :: (Param p) => p -> Test
TFileExecutable :: (Param p) => p -> Test
instance (Show a, Num a) => Num (Term Static a) where
fromInteger :: Integer -> Term Static a
fromInteger = forall t. Quotable (Val t) => t -> Term Static t
static forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Integer -> a
fromInteger
(StaticTerm a
a) + :: Term Static a -> Term Static a -> Term Static a
+ (StaticTerm a
b) = forall t. Quotable (Val t) => t -> Term Static t
StaticTerm (a
a forall a. Num a => a -> a -> a
+ a
b)
(StaticTerm a
a) * :: Term Static a -> Term Static a -> Term Static a
* (StaticTerm a
b) = forall t. Quotable (Val t) => t -> Term Static t
StaticTerm (a
a forall a. Num a => a -> a -> a
* a
b)
(StaticTerm a
a) - :: Term Static a -> Term Static a -> Term Static a
- (StaticTerm a
b) = forall t. Quotable (Val t) => t -> Term Static t
StaticTerm (a
a forall a. Num a => a -> a -> a
- a
b)
abs :: Term Static a -> Term Static a
abs (StaticTerm a
a) = forall t. Quotable (Val t) => t -> Term Static t
StaticTerm (forall a. Num a => a -> a
abs a
a)
signum :: Term Static a -> Term Static a
signum (StaticTerm a
a) = forall t. Quotable (Val t) => t -> Term Static t
StaticTerm (forall a. Num a => a -> a
signum a
a)
val :: Term t Integer -> Arith
val :: forall t. Term t Integer -> Arith
val t :: Term t Integer
t@(VarTerm UntypedVar
_) = Term Var Integer -> Arith
AVar Term t Integer
t
val t :: Term t Integer
t@(StaticTerm Integer
_) = Term Static Integer -> Arith
AStatic Term t Integer
t
data Arith
= ANum Integer
| AVar (Term Var Integer)
| AStatic (Term Static Integer)
| ANegate Arith
| APlus Arith Arith
| AMinus Arith Arith
| AMult Arith Arith
| ADiv Arith Arith
| AMod Arith Arith
| ANot Arith
| AOr Arith Arith
| AAnd Arith Arith
| AEqual Arith Arith
| ANotEqual Arith Arith
| ALT Arith Arith
| AGT Arith Arith
| ALE Arith Arith
| AGE Arith Arith
| ABitOr Arith Arith
| ABitXOr Arith Arith
| ABitAnd Arith Arith
| AShiftLeft Arith Arith
| AShiftRight Arith Arith
| AIf Arith (Arith, Arith)
fmtArith :: Env -> Arith -> L.Text
fmtArith :: Env -> Arith -> Text
fmtArith Env
env Arith
arith = Text
"$(( " forall a. Semigroup a => a -> a -> a
<> Arith -> Text
go Arith
arith forall a. Semigroup a => a -> a -> a
<> Text
" ))"
where
go :: Arith -> Text
go (ANum Integer
i) = String -> Text
L.pack (forall a. Show a => a -> String
show Integer
i)
go (AVar (VarTerm UntypedVar
v)) = forall a. Quoted a -> a
getQ forall a b. (a -> b) -> a -> b
$ UntypedVar -> Env -> VarName -> Quoted Text
expandVar UntypedVar
v Env
env (UntypedVar -> VarName
varName UntypedVar
v)
go (AStatic (StaticTerm Integer
v)) = forall a. Quoted a -> a
getQ forall a b. (a -> b) -> a -> b
$ forall t. Quotable t => t -> Quoted Text
quote forall a b. (a -> b) -> a -> b
$ forall v. v -> Val v
Val Integer
v
go (ANegate Arith
v) = Text -> Arith -> Text
unop Text
"-" Arith
v
go (APlus Arith
a Arith
b) = Arith -> Text -> Arith -> Text
binop Arith
a Text
"+" Arith
b
go (AMinus Arith
a Arith
b) = Arith -> Text -> Arith -> Text
binop Arith
a Text
"-" Arith
b
go (AMult Arith
a Arith
b) = Arith -> Text -> Arith -> Text
binop Arith
a Text
"*" Arith
b
go (ADiv Arith
a Arith
b) = Arith -> Text -> Arith -> Text
binop Arith
a Text
"/" Arith
b
go (AMod Arith
a Arith
b) = Arith -> Text -> Arith -> Text
binop Arith
a Text
"%" Arith
b
go (ANot Arith
v) = Text -> Arith -> Text
unop Text
"!" Arith
v
go (AOr Arith
a Arith
b) = Arith -> Text -> Arith -> Text
binop Arith
a Text
"||" Arith
b
go (AAnd Arith
a Arith
b) = Arith -> Text -> Arith -> Text
binop Arith
a Text
"&&" Arith
b
go (AEqual Arith
a Arith
b) = Arith -> Text -> Arith -> Text
binop Arith
a Text
"==" Arith
b
go (ANotEqual Arith
a Arith
b) = Arith -> Text -> Arith -> Text
binop Arith
a Text
"!=" Arith
b
go (ALT Arith
a Arith
b) = Arith -> Text -> Arith -> Text
binop Arith
a Text
"<" Arith
b
go (AGT Arith
a Arith
b) = Arith -> Text -> Arith -> Text
binop Arith
a Text
">" Arith
b
go (ALE Arith
a Arith
b) = Arith -> Text -> Arith -> Text
binop Arith
a Text
"<=" Arith
b
go (AGE Arith
a Arith
b) = Arith -> Text -> Arith -> Text
binop Arith
a Text
">=" Arith
b
go (ABitOr Arith
a Arith
b) = Arith -> Text -> Arith -> Text
binop Arith
a Text
"|" Arith
b
go (ABitXOr Arith
a Arith
b) = Arith -> Text -> Arith -> Text
binop Arith
a Text
"^" Arith
b
go (ABitAnd Arith
a Arith
b) = Arith -> Text -> Arith -> Text
binop Arith
a Text
"&" Arith
b
go (AShiftLeft Arith
a Arith
b) = Arith -> Text -> Arith -> Text
binop Arith
a Text
"<<" Arith
b
go (AShiftRight Arith
a Arith
b) = Arith -> Text -> Arith -> Text
binop Arith
a Text
">>" Arith
b
go (AIf Arith
c (Arith
a, Arith
b)) = forall {a}. (Semigroup a, IsString a) => a -> a
paren forall a b. (a -> b) -> a -> b
$ Arith -> Text
go Arith
c forall a. Semigroup a => a -> a -> a
<> Text
" ? " forall a. Semigroup a => a -> a -> a
<> Arith -> Text
go Arith
a forall a. Semigroup a => a -> a -> a
<> Text
" : " forall a. Semigroup a => a -> a -> a
<> Arith -> Text
go Arith
b
paren :: a -> a
paren a
t = a
"(" forall a. Semigroup a => a -> a -> a
<> a
t forall a. Semigroup a => a -> a -> a
<> a
")"
binop :: Arith -> Text -> Arith -> Text
binop Arith
a Text
o Arith
b = forall {a}. (Semigroup a, IsString a) => a -> a
paren forall a b. (a -> b) -> a -> b
$ Arith -> Text
go Arith
a forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
o forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Arith -> Text
go Arith
b
unop :: Text -> Arith -> Text
unop Text
o Arith
v = forall {a}. (Semigroup a, IsString a) => a -> a
paren forall a b. (a -> b) -> a -> b
$ Text
o forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Arith -> Text
go Arith
v
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
)
)
instance Enum Arith where
succ :: Arith -> Arith
succ Arith
a = Arith -> Arith -> Arith
APlus Arith
a (Integer -> Arith
ANum Integer
1)
pred :: Arith -> Arith
pred Arith
a = Arith -> Arith -> Arith
AMinus Arith
a (Integer -> Arith
ANum Integer
1)
toEnum :: Indent -> Arith
toEnum = Integer -> Arith
ANum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
enumFrom :: Arith -> [Arith]
enumFrom Arith
a = Arith
a forall a. a -> [a] -> [a]
: forall a. Enum a => a -> [a]
enumFrom (forall a. Enum a => a -> a
succ Arith
a)
enumFromThen :: Arith -> Arith -> [Arith]
enumFromThen Arith
a Arith
b = Arith
a forall a. a -> [a] -> [a]
: forall a. Enum a => a -> a -> [a]
enumFromThen Arith
b ((Arith
b Arith -> Arith -> Arith
`AMult` Integer -> Arith
ANum Integer
2) Arith -> Arith -> Arith
`AMinus` Arith
a)
fromEnum :: Arith -> Indent
fromEnum = forall a. HasCallStack => String -> a
error String
"fromEnum not implemented for Arith"
enumFromTo :: Arith -> Arith -> [Arith]
enumFromTo = forall a. HasCallStack => String -> a
error String
"enumFromTo not implemented for Arith"
enumFromThenTo :: Arith -> Arith -> Arith -> [Arith]
enumFromThenTo = forall a. HasCallStack => String -> a
error String
"enumFromToThen not implemented for Arith"