Merge pull request #3 from tpoindex/master

Fix tup/tupx plus a few additions: safe nested tuples, maybe monad, filter predicates.
This commit is contained in:
Slawomir Sledz 2019-09-14 11:55:48 +02:00 committed by GitHub
commit e5f3e8c5f3
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
6 changed files with 224 additions and 21 deletions

View file

@ -8,11 +8,11 @@ take() {
command head -n ${1} command head -n ${1}
} }
tail() { ltail() {
drop 1 drop 1
} }
head() { lhead() {
take 1 take 1
} }
@ -262,7 +262,7 @@ tup() {
read arg read arg
tup $arg tup $arg
else else
list "$@" | map lambda x . 'echo ${x/,/u002c}' | join , '(' ')' list "$@" | map lambda x . 'echo ${x//,/u002c}' | join , '(' ')'
fi fi
} }
@ -274,7 +274,7 @@ tupx() {
else else
local n=$1 local n=$1
shift shift
echo "$@" | stripl '(' | stripr ')' | cut -d',' -f${n} | tr ',' '\n' | map lambda x . 'echo ${x/u002c/,}' echo "$@" | stripl '(' | stripr ')' | cut -d',' -f${n} | tr ',' '\n' | map lambda x . 'echo ${x//u002c/,}'
fi fi
} }
@ -286,7 +286,37 @@ tupr() {
tupx 1- "$@" | last tupx 1- "$@" | last
} }
zip() { ntup() {
if [[ $# -eq 0 ]]; then
local arg
read arg
ntup $arg
else
list "$@" | map lambda x . 'echo "$x" | base64 --wrap=0 ; echo' | join , '(' ')'
fi
}
ntupx() {
if [[ $# -eq 1 ]]; then
local arg
read arg
ntupx "$1" "$arg"
else
local n=$1
shift
echo "$@" | stripl '(' | stripr ')' | cut -d',' -f${n} | tr , '\n' | map lambda x . 'echo "$x" | base64 -d'
fi
}
ntupl() {
ntupx 1 "$@"
}
ntupr() {
ntupx 1- "$@" | last
}
lzip() {
local list=$* local list=$*
cat - | while read x; do cat - | while read x; do
y=$(list $list | take 1) y=$(list $list | take 1)
@ -328,3 +358,80 @@ call() {
local args=$@ local args=$@
tup $f $args tup $f $args
} }
maybe() {
if [[ $# -eq 0 ]]; then
local arg
read arg
maybe "$arg"
else
local x="$*"
local value=$(echo $x | strip)
if [[ ${#value} -eq 0 ]]; then
tup Nothing
else
tup Just "$value"
fi
fi
}
maybemap() {
local x
read x
if [[ $(tupl $x) = "Nothing" ]]; then
echo $x
else
local y=$(tupr "$x")
local r=$(echo "$y" | map "$@")
maybe "$r"
fi
}
maybevalue() {
local default="$*"
local x
read x
if [[ $(tupl $x) = "Nothing" ]]; then
echo "$default"
else
echo $(tupr $x)
fi
}
# commonly used predicates for filter
# e.g. list 1 a 2 b 3 c | filter lambda x . 'isint $x'
# inverse another test, e.g. "not isint $x"
not() {
local r=$("$@" 2>/dev/null)
$r && ret false || ret true
}
isint() {
[ "$1" -eq "$1" ] 2>/dev/null && ret true || ret false
}
isempty() {
[ -z "$1" ] && ret true || ret false
}
isfile() {
[ -f "$1" ] && ret true || ret false
}
isnonzerofile() {
[ -s "$1" ] && ret true || ret false
}
isreadable() {
[ -r "$1" ] && ret true || ret false
}
iswritable() {
[ -w "$1" ] && ret true || ret false
}
isdir() {
[ -d "$1" ] && ret true || ret false
}

View file

@ -1,16 +1,16 @@
#! /bin/bash #! /bin/bash
testHeadFromList() { testLHeadFromList() {
assertEquals 1 $(list {1..10} | head) assertEquals 1 $(list {1..10} | lhead)
assertEquals 5 $(list 5 6 7 | head) assertEquals 5 $(list 5 6 7 | lhead)
} }
testHeadFromOneElementList() { testLHeadFromOneElementList() {
assertEquals 1 $(list 1 | head) assertEquals 1 $(list 1 | lhead)
} }
testHeadFromEmptyList() { testLHeadFromEmptyList() {
assertEquals "" "$(list | head)" assertEquals "" "$(list | lhead)"
} }
. ./shunit2-init.sh . ./shunit2-init.sh

29
test/maybe_test.sh Executable file
View file

@ -0,0 +1,29 @@
#! /bin/bash
testMaybe() {
assertEquals '(Just,1)' "$(maybe 1)"
assertEquals '(Just,1)' "$(echo 1 | maybe)"
assertEquals '(Nothing)' "$(maybe '')"
assertEquals '(Nothing)' "$(maybe ' ')"
assertEquals '(Nothing)' "$(maybe ' ' ' ' ' ')"
assertEquals '(Nothing)' "$(echo | maybe)"
assertEquals '(Just,1 2 3)' "$(maybe 1 2 3)"
assertEquals '(Just,1 2 3)' "$(echo 1 2 3 | maybe)"
}
testMaybemap() {
assertEquals '(Just,3)' "$(echo 1 | maybe | maybemap lambda a . 'echo $(( a + 1 ))' | maybemap lambda a . 'echo $(( a + 1 ))')"
assertEquals '(Nothing)' "$(echo | maybe | maybemap lambda a . 'echo $(( a + 1 ))' | maybemap lambda a . 'echo $(( a + 1 ))')"
assertEquals '(Nothing)' "$(echo 1 | maybe | maybemap lambda a . 'echo $(( a + 1 ))' | maybemap lambda a . 'echo')"
assertEquals '(Nothing)' "$(echo 1 | maybe | maybemap lambda a . 'echo $(( a + 1 ))' | maybemap lambda a . 'echo' | maybemap lambda a . 'echo $(( a + 1 ))')"
}
testMaybevalue() {
assertEquals 3 "$(echo 1 | maybe | maybemap lambda a . 'echo $(( a + 1 ))' | maybemap lambda a . 'echo $(( a + 1 ))' | maybevalue 0)"
assertEquals 0 "$(echo | maybe | maybemap lambda a . 'echo $(( a + 1 ))' | maybemap lambda a . 'echo $(( a + 1 ))' | maybevalue 0)"
assertEquals 'a b c' "$(echo | maybe | maybemap lambda a . 'echo $(( a + 1 ))' | maybemap lambda a . 'echo $(( a + 1 ))' | maybevalue a b c)"
}
. ./shunit2-init.sh

52
test/predicates_test.sh Executable file
View file

@ -0,0 +1,52 @@
#! /bin/bash
testIsint() {
assertEquals 'true' $(isint 1)
assertEquals 'true' $(isint -1)
assertEquals 'false' $(isint a)
assertEquals 'false' $(isint "")
assertEquals '1 2 3 4 5' "$(list 1 a 2 b 3 c 4 d 5 e | filter lambda x . 'isint $x' | unlist )"
assertEquals '1 2' "$(list 1 a 2 b 3 c 4 d 5 e | filter lambda x . '($(isint $x) && [[ $x -le 2 ]] && ret true) || ret false ' | unlist )"
assertEquals 'false' $(not isint 1)
assertEquals 'true' $(not isint a)
}
testIsempty() {
assertEquals 'true' $(isempty "")
assertEquals 'false' $(isempty a)
assertEquals 'true' $(not isempty a)
assertEquals 'false' $(not isempty "")
}
testIsfile() {
f=$(mktemp)
assertEquals 'true' $(isfile $f)
assertEquals 'false' $(isfile $f.xxx)
assertEquals 'false' $(isfile "")
assertEquals 'true' $(not isfile $f.xxx)
assertEquals 'false' $(isnonzerofile $f)
echo hello world >$f
assertEquals 'true' $(isnonzerofile $f)
assertEquals 'true' $(iswritable $f)
chmod 400 $f
assertEquals 'false' $(iswritable $f)
assertEquals 'true' $(isreadable $f)
chmod 200 $f
assertEquals 'false' $(isreadable $f)
chmod 600 $f
rm $f
}
testIsdir() {
assertEquals 'true' $(isdir .)
assertEquals 'false' $(isdir sir_not_appearing_in_this_film)
}
. ./shunit2-init.sh

View file

@ -1,15 +1,15 @@
#! /bin/bash #! /bin/bash
testTailFrom10() { testLTailFrom10() {
assertEquals "2 3 4 5 6 7 8 9 10" "$(list {1..10} | tail | unlist)" assertEquals "2 3 4 5 6 7 8 9 10" "$(list {1..10} | ltail | unlist)"
} }
testTailFromOneElementList() { testLTailFromOneElementList() {
assertEquals "" "$(list 1 | tail)" assertEquals "" "$(list 1 | ltail)"
} }
testTailFromEmptyList() { testLTailFromEmptyList() {
assertEquals "" "$(list | tail)" assertEquals "" "$(list | ltail)"
} }
. ./shunit2-init.sh . ./shunit2-init.sh

View file

@ -9,6 +9,7 @@ testTupIfOneElement() {
assertEquals '(")' $(tup '"') assertEquals '(")' $(tup '"')
assertEquals "(')" $(tup "'") assertEquals "(')" $(tup "'")
assertEquals "(u002c)" $(tup ",") assertEquals "(u002c)" $(tup ",")
assertEquals "(u002cu002c)" $(tup ",,")
assertEquals "(()" $(tup "(") assertEquals "(()" $(tup "(")
assertEquals "())" $(tup ")") assertEquals "())" $(tup ")")
} }
@ -38,6 +39,7 @@ testTupxIfZeroIndex() {
testTupxIfSpecialChars() { testTupxIfSpecialChars() {
assertEquals ',' "$(tup ',' | tupx 1)" assertEquals ',' "$(tup ',' | tupx 1)"
assertEquals ',,' "$(tup ',,' | tupx 1)"
assertEquals '(' "$(tup '(' | tupx 1)" assertEquals '(' "$(tup '(' | tupx 1)"
assertEquals ')' "$(tup ')' | tupx 1)" assertEquals ')' "$(tup ')' | tupx 1)"
assertEquals '()' "$(tup '()' | tupx 1)" assertEquals '()' "$(tup '()' | tupx 1)"
@ -45,6 +47,7 @@ testTupxIfSpecialChars() {
assertEquals '(' "$(tup '(' '(' | tupx 1)" assertEquals '(' "$(tup '(' '(' | tupx 1)"
assertEquals ')' "$(tup ')' ')' | tupx 1)" assertEquals ')' "$(tup ')' ')' | tupx 1)"
assertEquals ',' "$(tup 'u002c' | tupx 1)" assertEquals ',' "$(tup 'u002c' | tupx 1)"
assertEquals ',,' "$(tup 'u002cu002c' | tupx 1)"
} }
testTupxRange() { testTupxRange() {
@ -66,4 +69,16 @@ testTupr() {
assertEquals '5' "$(tup 5 | tupr)" assertEquals '5' "$(tup 5 | tupr)"
} }
testNTup() {
assertEquals '(KFlRbz0sWWdvPSkK,Ywo=)' "$(ntup $(ntup a b) c)"
assertEquals '(YQo=,Ygo=)' "$(ntupl '(KFlRbz0sWWdvPSkK,Ywo=)')"
assertEquals 'a' "$(ntupl '(YQo=,Ygo=)')"
assertEquals 'b' "$(ntupr '(YQo=,Ygo=)')"
assertEquals 'c' "$(ntupr '(KFlRbz0sWWdvPSkK,Ywo=)')"
assertEquals 'a' "$(ntup $(ntup a b) c | ntupx 1 | ntupx 1)"
assertEquals 'b' "$(ntup $(ntup a b) c | ntupx 1 | ntupx 2)"
assertEquals 'c' "$(ntup $(ntup a b) c | ntupx 2)"
assertEquals 'a b' "$(ntup $(ntup a b) c | ntupx 1 | ntupx 1,2 | unlist)"
}
. ./shunit2-init.sh . ./shunit2-init.sh