Commit initial

lib/moi/util/condition.elv

@@ -0,0 +1,20 @@
+fn set [c t f]{
+  if $c {
+    put $t
+  } else {
+    put $f
+  }
+}
+
+fn mset [c t f]{
+  explode (set $c $t $f)
+}
+
+fn call [c t f @argv]{
+  local:v = (set $c $t $f)
+  if (is (kind-of $v) fn) {
+    $v $@argv
+  } else {
+    put $v
+  }
+}

lib/moi/util/file.elv

@@ -0,0 +1,63 @@
+search-type = [
+  &exact=       [m]{ e:ls $m 2>/dev/null }
+  &match=       [m]{ put *$m* }
+  &prefix=      [m]{ put $m* }
+  &suffix=      [m]{ put *$m }
+  &deep-match=  [m]{ put **$m** }
+  &deep-prefix= [m]{ put $m** }
+  &deep-suffix= [m]{ put **$m }
+]
+
+fn -less [f1 f2]{
+  use str
+  local:fl1 local:fl2 = (str:to-lower $f1) (str:to-lower $f2)
+  local:c = (str:compare $fl1 $fl2)
+  if (== $c 0) {
+    c = (str:compare $f1 $f2)
+  }
+  put (< $c 0)
+}
+
+fn -get-results [sort result]{
+  if $sort {
+    use ./list
+    keys $result | list:sort $-less~
+  } else {
+    keys $result
+  }
+}
+
+fn -search [&sort=$false &type=exact @motive]{
+  use ./list
+  local:f = $search-type[$type]
+  local:result = [&]
+  if (list:empty $motive) {
+    use ./map
+    result = (put * | map:to-set)
+  } else {
+    peach [m]{
+      local:m = $m
+      try {
+        $f $m | peach [e]{
+          local:e = $e
+          result[$e] = $nil
+        }
+      } except e { }
+    } $motive
+  }
+  -get-results $sort $result
+}
+
+fn match-files [&sort=$false &type=prefix @motive]{ -search &sort=$sort &type=$type $@motive }
+
+fn match-extensions [&sort=$false &type=deep-prefix motive @extensions]{
+  use ./list
+  result = [&]
+  -search &type=$type $motive | peach [f]{
+    local:f = $f
+    if (list:contains [e]{ has-suffix $f .$e } $extensions) {
+      result[$f] = $nil
+    }
+  }
+  -get-results $sort $result
+}

lib/moi/util/ip.elv

@@ -0,0 +1,132 @@
+fn is-ipv4 [arg]{
+  use re
+  if (not (re:match '^([0-9]{1,3}\.){3}[0-9]{1,3}$' $arg)) {
+    put $false
+  } else {
+    use ./list
+    not (splits '.' $arg | list:contains [p]{ > $p 255 })
+  }
+}
+
+fn is-ipv6 [arg]{
+  use re
+  local:p = '[0-9a-fA-F]{1,4}'
+  local:g1 local:g2 = '('$p':)' '(:'$p')'
+  local:cases = [
+    $g1'{7,7}'$p
+    $g1'{1,7}:'
+    $g1'{1,6}:'$p
+    $g1'{1,5}'$g2'{1,2}'
+    $g1'{1,4}'$g2'{1,3}'
+    $g1'{1,3}'$g2'{1,4}'
+    $g1'{1,2}'$g2'{1,5}'
+    $p':'$g2'{1,6}'
+    ':'$g2'{1,7}'
+    '::'
+  ]
+  local:r = '^('(joins '|'  $cases)')$'
+  put (re:match $r $arg)
+}
+
+fn -long-part6 [p]{
+  use str
+  p = (str:to-lower $p)
+  c = (- 4 (count $p))
+  put (repeat $c '0' | joins '')$p
+}
+
+fn -middle-part6 [p]{
+  while (and (> (count $p) 1) (eq $p[0] 0)) {
+    p = $p[1:]
+  }
+  put $p
+}
+
+fn -find-max0 [parts]{
+  use ./list
+  use ./condition
+  local:idx local:s = -1 1
+  local:ci local:cs local:f = -1 0 $false
+  list:loop [i p]{
+    if (eq $p 0) {
+      condition:call $f { cs = (+ $cs 1) } { ci cs f = $i 1 $true }
+    } elif $f {
+      f = $false
+      if (> $cs $s) {
+        idx s = $ci $cs
+      }
+    }
+  } $parts
+  if (and $f (> $cs $s)) {
+    idx s = $ci $cs
+  }
+  put $idx $s
+}
+
+fn long6 [ip]{
+  if (not (is-ipv6 $ip)) {
+    fail 'Not an IPv6'
+  }
+  if (eq $ip '::') {
+    repeat 8 '0000' | joins ':'
+    return
+  }
+  use str
+  local:c = (- 7 (str:count $ip ':'))
+  if (> $c 0) {
+    local:i = (str:index $ip '::')
+    local:z = (repeat $c ':' | joins '')
+    ip = (joins '' [$ip[:$i] $z $ip[{$i}:]])
+  }
+  splits ':' $ip | each $-long-part6~ | joins ':'
+}
+
+fn middle6 [ip]{
+  splits ':' (long6 $ip) | each $-middle-part6~ | joins ':'
+}
+
+fn short6 [ip]{
+  local:parts = [(splits ':' (middle6 $ip))]
+  local:i local:s = (-find-max0 $parts)
+  if (>= $i 0) {
+    local:left local:right = $parts[:$i] $parts[(+ $i $s):]
+    if (== (count $left) 0) {
+      left = ['']
+    }
+    if (== (count $right) 0)  {
+      right = ['']
+    }
+    parts = [$@left '' $@right]
+  }
+  joins ':' $parts
+}
+
+fn is-ip [arg]{ or (is-ipv4 $arg) (is-ipv6 $arg) }
+
+fn -cmp [e1 e2]{
+  use ./list
+  use ./condition
+  local:c = 0
+  list:loop [i p1]{
+    local:p2 = $e2[$i]
+    c = (condition:set (< $p1 $p2) -1 (condition:set (> $p1 $p2) 1 0))
+    if (!= $c 0) {
+      break
+    }
+  } $e1
+  put $c
+}
+
+fn cmp4 [ip1 ip2]{
+  if (or (not (is-ipv4 $ip1)) (not (is-ipv4 $ip2))) {
+    fail 'Not an IPv4'
+  }
+  -cmp [(splits . $ip1)] [(splits . $ip2)]
+}
+
+fn cmp6 [ip1 ip2]{
+  if (or (not (is-ipv6 $ip1)) (not (is-ipv6 $ip2))) {
+    fail 'Not an IPv6'
+  }
+  -cmp [(splits : (middle6 $ip1))] [(splits : (middle6 $ip2))]
+}

lib/moi/util/list.elv

@@ -0,0 +1,309 @@
+use ./condition
+
+fn -i [&reverse=false i c]{
+  if (and (== $c 0) (or (== $i 0) ($i -1))) {
+    put 0
+    return
+  }
+  if (< $i 0) {
+    i = (+ $c $i)
+  }
+  if (or (and (>= $i 0) (< $i $c)) (and (== $i -1) $reverse) (and (== $i $c) (not $reverse))) {
+    put $i
+  } else {
+    fail 'Index out of range'
+  }
+}
+fn -indexes [&from=$false &step=1 l]{
+  if (== $step 0) {
+    fail 'Step must be ≠ 0'
+  }
+  local:c local:r = (count $l) (< $step 0)
+  if (not $from) {
+    if $r {
+      range &step=$step[1:] $c | each [i]{ - $c $i 1 }
+    } else {
+      range &step=$step $c
+    }
+  } else {
+    from = (-i &reverse=$r $from $c)
+    if $r {
+      c = (+ $from 1)
+      range &step=$step[1:] $c | each [i]{ - $c $i 1 }
+    } else {
+      range &step=$step $from $c
+    }
+  }
+}
+
+fn -loop [&from=$false &step=1 &end=$false cb l]{
+  if (not $end) {
+    -indexes &from=$from &step=$step $l | each [i]{
+      put [$i $l[$i]]
+    } | each [e]{
+      $cb $@e
+    }
+  } else {
+    -indexes &from=$from &step=$step $l | each [i]{
+      put [$i $l[$i]]
+    } | each [e]{
+      local:i local:v = $@e
+      if ($end $i $v) {
+        break
+      }
+      $cb $i $v
+    }
+  }
+}
+fn -ploop [&from=$false &step=1 cb l]{
+  -indexes &from=$from &step=$step $l | peach [i]{
+    put [$i $l[$i]]
+  } | peach [e]{
+    $cb $@e
+  }
+}
+
+fn -reverse [l]{
+  -indexes &step=-1 $l | each [i]{ put $l[$i] }
+}
+fn -reach [cb l]{
+  -reverse $l | each [v]{ $cb $v }
+}
+
+fn -empty [l]{ eq (count $l) 0 }
+
+fn -filter [cb l]{
+  each [v]{
+    if ($cb $v) {
+      put $v
+    }
+  } $l
+}
+fn -first [&from=$false &reverse=$false cb l]{
+  local:f = [v]{
+    if ($cb $v) {
+      put $v
+      break
+    }
+  }
+  if $reverse {
+    if $from {
+      local:end = (-i $from (count $l))
+      -reach $f $l[:(+ $end 1)]
+    } else {
+      -reach $f $l
+    }
+  } else {
+    if $from {
+      from = (-i $from (count $l))
+      drop $from $l | each $f
+    } else {
+      each $f $l
+    }
+  }
+}
+
+fn -filter-index [cb l]{
+  -loop [i v]{
+    if ($cb $v) {
+      put $i
+    }
+  } $l
+}
+fn -first-index [&from=$false &reverse=$false cb l]{
+  local:idx = -1
+  -loop &from=$from &step=(condition:set $reverse -1 1) [i v]{
+    if ($cb $v) {
+      idx = $i
+      break
+    }
+  } $l
+  put $idx
+}
+
+fn -search [cb l]{
+  -loop [i v]{
+    if ($cb $i $v) {
+      put $v
+    }
+  } $l
+}
+fn -search-first [&from=$false &reverse=$false cb l]{
+  -loop &from=$from &step=(condition:set $reverse -1 1) [i v]{
+    if ($cb $i $v) {
+      put $v
+      break
+    }
+  } $l
+}
+
+fn -search-index [cb l]{
+  -loop [i v]{
+    if ($cb $i $v) {
+      put $i
+    }
+  } $l
+}
+fn -search-first-index [&from=$false &reverse=$false cb l]{
+  local:idx = -1
+  -loop &from=$from &step=(condition:set $reverse -1 1) [i v]{
+    if ($cb $i $v) {
+      idx = $i
+      break
+    }
+  }
+  put $idx
+}
+
+fn -contains [cb l]{
+  local:e =  $false
+  each [v]{
+    if ($cb $v) {
+      e = $true
+      break
+    }
+  } $l
+  put $e
+}
+fn -exists [cb l]{
+  local:e = $false
+  -loop [i v]{
+    if ($cb $i $v) {
+      e = $true
+      break
+    }
+  } $l
+  put $e
+}
+
+fn -remove-duplicate [l]{
+  local:done = [&]
+  each [v]{
+    put [&v=$v &e=(has-key $done $v)]
+    done[$v] = $nil
+  } $l | each [v]{
+    assoc $v k (not $v[e])
+  } | each [v]{
+    if $v[k] {
+      put $v[v]
+    }
+  }
+}
+
+fn -premove-duplicate [l]{
+  local:done= [&]
+  peach [v]{
+    local:v = $v
+    done[$v] = $nil
+  }
+  keys $done
+}
+
+fn -swap [i j l]{
+  local:c = (count $l)
+  i j = (-i $i $c) (-i $j $c)
+  if (or (eq $i $c) (eq $j $c)) {
+    fail 'Index out of range'
+  }
+  if (eq $i $j) {
+    explode $l
+  } else {
+    i j = (condition:mset (< $i $j) [$i $j] [$j $i])
+    take $i $l
+    put $l[j]
+    explode $l[(+ $i 1):$j]
+    put $l[$i]
+    drop (+ $j 1) $l
+  }
+}
+
+fn -p [@argv]{
+  local:c = (count $argv)
+  if (eq $c 0) {
+    put [(all)]
+  } elif (eq $c 1) {
+    put $argv[0]
+  } else {
+    fail '0 or 1 argument needed'
+  }
+}
+
+fn to-list [@argv]{
+  try {
+    -p $@argv
+  } except e {
+    put $argv
+  }
+}
+
+fn indexes [&from=$false &step=1 @argv]{ -indexes &from=$from &step=1 (-p $@argv) }
+
+fn loop [&from=$false &step=1 &end=$false cb @argv]{ -loop &from=$from &step=$step &end=$end $cb (-p $@argv) }
+fn rloop [&end=$false cb @argv]{ loop &step=-1 &end=$end $cb $@argv }
+fn ploop [&from=$false &step=1 cb @argv]{ -ploop &from=$from &step=$step $cb (-p $@argv) }
+
+fn reverse [@argv]{ -reverse (-p $@argv) }
+fn reach [cb @argv]{ -reach $cb (-p $@argv) }
+
+fn empty [@argv]{ -empty (-p $@argv) }
+fn not-empty [@argv]{ not (empty $@argv) }
+
+fn filter [cb @argv]{ -filter $cb (-p $@argv) }
+fn filter-not [cb @argv]{ filter [v]{ not ($cb $v) } $@argv }
+fn first [&from=$false &reverse=$false cb @argv]{ -first &from=$from &reverse=$reverse $cb (-p $@argv) }
+
+fn filter-index [cb @argv]{ -filter-index $cb (-p $@argv) }
+fn filter-index-not [cb @argv]{ filter-index [v]{ not ($cb $v) } $@argv }
+fn first-index [&from=$false &reverse=$false cb @argv]{ -first-index &from=$from &reverse=$reverse $cb (-p $@argv) }
+
+fn search [cb @argv]{ -search $cb (-p $@argv) }
+fn search-not [cb @argv]{ search [i v]{ not ($cb $i $v) } $@argv }
+fn search-first [&from=$false &reverse=$false cb @argv]{ -search-first &from=$from &reverse=$reverse $cb (-p $@argv) }
+
+fn search-index [cb @argv]{ -search-index $cb (-p $@argv) }
+fn search-index-not [cb @argv]{ search-index [i v]{ not ($cb $i $v) } $@argv }
+fn search-first-index [&from=$false &reverse=$false cb @argv]{ -search-first-index &from=$from &reverse=$reverse $cb (-p $@argv) }
+
+fn contains [cb @argv]{ -contains $cb (-p $@argv) }
+fn contains-not [cb @argv]{ contains [v]{ not ($cb $v) } $@argv }
+
+fn exists [cb @argv]{ -exists $cb (-p $@argv) }
+fn exists-not [cb @argv]{ exists [i v]{ $cb $i $v } $@argv }
+
+fn reduce [v cb @argv]{
+  each [e]{ v = ($cb $v $e) } (to-list $@argv)
+  put $v
+}
+
+fn remove-duplicate [@argv]{ -remove-duplicate (-p $@argv) }
+fn premove-duplicate [@argv]{ -premove-duplicate (-p $@argv) }
+
+fn swap [i j @argv]{ -swap $i $j (-p $@argv) }
+
+fn -s1 [cb l e]{
+  c = (count $l)
+  i = (first-index [v]{ $cb $e $v } $l)
+  if (eq $i 0) {
+    put $e
+    explode $l
+  } elif (< $i 0) {
+    explode $l
+    put $e
+  } else {
+    explode $l[:$i]
+    put $e
+    explode $l[{$i}:]
+  }
+}
+
+fn -sort [cb l]{
+  c = (count $l)
+  if  (> $c 1) {
+    l2 = $l[:1]
+    each [e]{ l2 = [ (-s1 $cb $l2 $e) ] } $l[1:]
+    l = $l2
+  }
+  explode $l
+}
+
+fn sort [cb @argv]{ -sort $cb (-p $@argv) }

lib/moi/util/map.elv

@@ -0,0 +1,77 @@
+fn empty [container]{ == (count $container) 0 }
+
+fn values [container]{ keys $container | each [v]{ put $container[$v] } }
+fn pvalues [container]{ keys $container | peach [v]{ put $container[$v] } }
+
+fn value-of [container k &default=$nil]{
+  if (has-key $container $k) {
+    put $container[$k]
+  } else {
+    put $default
+  }
+}
+
+fn unzip [container]{
+  local:lkeys local:lvalues = [] []
+  keys $container | each [k]{
+    lkeys = [(explode $lkeys) $k]
+    lvalues = [(explode $lvalues) $container[$k]]
+  }
+  put $lkeys $lvalues
+}
+
+fn zip [lkeys lvalues]{
+  use ./condition
+  local:ck local:cv = (count $lkeys) (count $lvalues)
+  local:c = (condition:set (> $ck $cv) $cv $ck)
+  local:result = [&]
+  range $c | peach [i]{
+    put [&k=$lkeys[$i] &i=$i]
+  } | peach [e]{
+    assoc $e v $lvalues[$e[i]]
+  } | each [e]{
+    result[$e[k]] = $e[v]
+  }
+  put $result
+}
+
+fn to-map [@argv]{
+  use ./list
+  local:container = (list:to-list $@argv)
+  zip [(range (count $container))] $container
+}
+
+fn to-set [@argv]{
+  use ./list
+  local:m = [&]
+  each [k]{ m[$k] = $nil } (list:to-list $@argv)
+  put $m
+}
+
+fn mdissoc [container @argv]{
+  each [k]{
+    container = (dissoc $container $k)
+  } $argv
+  put $container
+}
+
+fn massoc [&replace=$true container @argv]{
+  each [e]{
+    local:k local:v = $@e
+    if (or $replace (not (has-key $container $k))) {
+      container[$k] = $v
+    }
+  } $argv
+  put $container
+}
+
+fn add [container key @values]{
+  use ./list
+  local:values = (list:to-list $values)
+  if (has-key $container $key) {
+    container[$key] = [(explode $container[$key]) $@values]
+  } else {
+    container[$key] = $values
+  }
+  put $container
+}

lib/moi/util/number.elv

@@ -0,0 +1,40 @@
+fn sign [n]{
+  if (> $n 0) {
+    put 1
+  } elif (< $n 0) {
+    put -1
+  } else {
+    put 0
+  }
+}
+
+fn negative [n]{ < $n 0 }
+fn positive [n]{ >= $n 0 }
+
+fn ++ [n]{ to-string (+ $n 1) }
+fn -- [n]{ to-string (+ $n 1) }
+
+
+fn neg [n]{ to-string (* $n -1) }
+fn abs [n]{
+  use ./condition
+  condition:call (negative $n) $neg~ $put~ $n
+}
+
+fn sum [@numbers]{
+  use ./list
+  to-string (list:reduce 0 $+~ $numbers)
+}
+
+fn -minmax [t numbers]{
+  if (== (count $numbers) 0) {
+    return
+  }
+  use ./list
+  use ./condition
+  f = [c v]{ condition:set ($t $v $c) $v $c }
+  list:reduce $numbers[0] $f $numbers[1:]
+}
+
+fn min [@numbers]{ -minmax $<~ $numbers }
+fn max [@numbers]{ -minmax $>~ $numbers }

lib/moi/util/option.elv

@@ -0,0 +1,75 @@
+use re
+use str
+use ./list
+
+fn is-moptions [o]{ re:match '^\-\w{2,}$' $o }
+fn is-soption [o]{ re:match '^\-\w$' $o }
+fn is-loption [o]{ re:match '^\-\-\w+(=.*)?$' $o }
+fn is-option [o]{ or (is-soption $o) (is-loption $o) (is-moptions $o) }
+
+fn -splitm [o]{ each [e]{ put -$e } $o[1:] }
+
+fn -splitl [o]{
+  if (str:contains $o '=') {
+    local:opt @local:value = (splits '=' $o)
+    put $opt
+    joins '=' $value
+  } else {
+    put $o
+  }
+}
+
+fn split [o]{
+  if (is-moptions $o) {
+    -splitm $o
+  } elif (is-loption $o) {
+    -splitl $o
+  } else {
+    put $o
+  }
+}
+
+fn -joins [opt]{
+  local:o = (each [o]{ put $o[1:] } $opt | joins '')
+  if (not-eq $o '') { put -$o }
+}
+
+fn join [@opt]{
+  local:opt = (list:-p $@opt)
+  local:cb = [o]{ or (is-soption $o) (is-moptions $o) }
+  local:idx = [(list:filter-index-not $cb $opt)]
+  local:i0 = 0
+  each [i]{
+    -joins $opt[{$i0}:$i]
+    put $opt[$i]
+    i0 = (+ $i 1)
+  } $idx
+  -joins $opt[{$i0}:]
+}
+
+fn expand [@argv]{ each $split~ (list:-p $@argv) }
+
+fn map [@argv]{
+  use ./map
+  argv = [(expand $@argv)]
+  local:result = [&]
+  local:i local:c = 0 (count $argv)
+  while (< $i $c) {
+    local:o = $argv[$i]
+    if (is-option $o) {
+      local:k local:v = $o []
+      if (< $i (- $c 1)) {
+        local:e = $argv[(+ $i 1)]
+        if (not (is-option $e)) {
+          v = [$@v $e]
+          i = (+ $i 1)
+        }
+      }
+      result = (map:add $result $k $@v)
+    } else {
+      result = (map:add $result '' [$o])
+    }
+    i = (+ $i 1)
+  }
+  put $result
+}