{-# 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
(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
, 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)
}
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
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)
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 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)
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 (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
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) }
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
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
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)
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
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
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
| 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)
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
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
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)
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
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) []
class Param a where
toTextParam :: a -> Env -> L.Text
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
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
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
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
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
")\""
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
"\""
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, ())
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 = (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, ())
comment :: L.Text -> Script ()
= Expr -> Script ()
add (Expr -> Script ()) -> (Text -> Expr) -> Text -> Script ()
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 :: (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
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
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)
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)
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
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, ())
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)
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
"@")
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)
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)
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
":-"
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
":+"
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
":?"
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
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
<>)
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)
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
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"
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"
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]
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
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
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
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
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
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
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
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
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
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))
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"
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)
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 (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
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)
(|>) :: 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)
(|>>) :: 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)
(|<) :: 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)
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 = (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
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 = 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)
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
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
"$(( " 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)
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
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 :: 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"