!import "base" !Local

_ = t

matchList = a b : triage a _ b

emptyList? = matchList true (_ _ : false)
head = matchList t (head _ : head)
tail = matchList t (_ tail : tail)

append_ self xs ys =
  matchList
    ys
    (h r : pair h (self r ys))
    xs
append = xs ys : y append_ xs ys

lExist?_ self x xs =
  matchList
    false
    (h r : or? (equal? x h) (self x r))
    xs
lExist? = x xs : y lExist?_ x xs

map_ self l f =
  matchList
    t
    (h r : pair (f h) (self r f))
    l
map = f l : y map_ l f

filter_ self l f =
  matchList
    t
    (h r :
      matchBool
        (pair h (self r f))
        (self r f)
        (f h))
    l
filter = f l : y filter_ l f

foldl_ self l f acc =
  matchList
    acc
    (h r : self r f (f acc h))
    l
foldl = f x l : y foldl_ l f x

foldr_ self l f x =
  matchList
    x
    (h r : f (self r f x) h)
    l
foldr = f x l : y foldr_ l f x

length_ self xs =
  matchList
    0
    (_ r : succ (self r))
    xs
length = xs : y length_ xs

reverse_ self xs acc =
  matchList
    acc
    (h r : self r (pair h acc))
    xs
reverse = xs : y reverse_ xs t

snoc_ self x xs =
  matchList
    (pair x t)
    (h r : pair h (self x r))
    xs
snoc = x xs : y snoc_ x xs

count_ self x xs =
  matchList
    0
    (h r :
      matchBool
        (succ (self x r))
        (self x r)
        (equal? x h))
    xs
count = x xs : y count_ x xs

last_ self xs =
  matchList
    t
    (h r :
      matchBool
        h
        (self r)
        (emptyList? r))
    xs
last = xs : y last_ xs

all?_ self pred xs =
  matchList
    true
    (h r : and? (pred h) (self pred r))
    xs
all? = pred xs : y all?_ pred xs

any?_ self pred xs =
  matchList
    false
    (h r : or? (pred h) (self pred r))
    xs
any? = pred xs : y any?_ pred xs

intersect = xs ys : filter (x : lExist? x ys) xs

nth_ self xs n i =
  matchList
    t
    (h r :
      matchBool
        h
        (self r n (succ i))
        (equal? i n))
    xs
nth = n xs : y nth_ xs n 0

headMaybe = matchList nothing (h _ : just h)

lastMaybe_ self xs =
  matchList
    nothing
    (h r :
      matchBool
        (just h)
        (self r)
        (emptyList? r))
    xs
lastMaybe = xs : y lastMaybe_ xs

nthMaybe_ self xs n i =
  matchList
    nothing
    (h r :
      matchBool
        (just h)
        (self r n (succ i))
        (equal? i n))
    xs
nthMaybe = n xs : y nthMaybe_ xs n 0

take_ self xs n i =
  matchList
    t
    (h r :
      matchBool
        t
        (pair h (self r n (succ i)))
        (equal? i n))
    xs
take = n xs : y take_ xs n 0

drop_ self xs n i =
  matchBool
    xs
    (matchList
      t
      (_ r : self r n (succ i))
      xs)
    (equal? i n)
drop = n xs : y drop_ xs n 0

splitAt = n xs : pair (take n xs) (drop n xs)

concatMap_ self f xs =
  matchList
    t
    (h r : append (f h) (self f r))
    xs
concatMap = f xs : y concatMap_ f xs

find_ self pred xs =
  matchList
    nothing
    (h r :
      matchBool
        (just h)
        (self pred r)
        (pred h))
    xs
find = pred xs : y find_ pred xs

partition_ self pred xs trues falses =
  matchList
    (pair (reverse trues) (reverse falses))
    (h r :
      matchBool
        (self pred r (pair h trues) falses)
        (self pred r trues (pair h falses))
        (pred h))
    xs
partition = pred xs : y partition_ pred xs t t

strLength = length
strAppend = append
strEq? = equal?
strEmpty? = emptyList?

startsWith?_ self prefix input =
  matchList
    true
    (ph pr :
      matchList
        false
        (sh sr :
          matchBool
            (self pr sr)
            false
            (equal? ph sh))
        input)
    prefix
startsWith? = prefix input : y startsWith?_ prefix input

endsWith? = prefix str : startsWith? (reverse prefix) (reverse str)

contains?_ self needle haystack =
  matchBool
    true
    (matchList
      false
      (_ r : self needle r)
      haystack)
    (startsWith? needle haystack)
contains? = needle haystack : y contains?_ needle haystack

sum = foldl (acc x : add x acc) 0
product = foldl (acc x : mul x acc) 1

-- ---------------------------------------------------------------------------
-- Generic separators
--
-- `lines`, `unlines`, `words` and `unwords` at the bottom of this section are
-- the byte-valued special cases of these primitives.
--
-- Joining takes any separator; splitting takes one byte. Separators are removed
-- rather than kept, and empty fields are preserved.
--
-- The workers below follow notes/tricu-normalization-rules.md: consumed data
-- first, lazy eliminators around every recursive branch, `y` only inside the
-- public wrapper, and `pair`-only state updates.
-- ---------------------------------------------------------------------------

takeWhile_ self xs f =
  lazyList
    (_ : t)
    (h r :
      lazyBool
        (_ : pair h (self r f))
        (_ : t)
        (f h))
    xs
takeWhile = f xs : y takeWhile_ xs f

dropWhile_ self xs f =
  lazyList
    (_ : t)
    (h r :
      lazyBool
        (_ : self r f)
        (_ : pair h r)
        (f h))
    xs
dropWhile = f xs : y dropWhile_ xs f

-- Byte-level whitespace only: space and horizontal tab (HTTP OWS).
spaceByte? = b : equal? b 32
tabByte?   = b : equal? b 9
trimByte?  = b : or? (spaceByte? b) (tabByte? b)

trim = xs : dropWhile trimByte? (reverse (dropWhile trimByte? (reverse xs)))

intercalate_ self xs sep =
  lazyList
    (_ : t)
    (h r :
      lazyBool
        (_ : h)
        (_ : append h (append sep (self r sep)))
        (emptyList? r))
    xs
intercalate = sep xs : y intercalate_ xs sep

-- Separator after every field, including the last one. Line-oriented formats
-- want this: `joinSuffix "\n" xs` terminates the final line while
-- `intercalate "\n" xs` does not.
joinSuffix_ self xs sep =
  lazyList
    (_ : t)
    (h r : append (append h sep) (self r sep))
    xs
joinSuffix = sep xs : y joinSuffix_ xs sep

-- Split on a single byte. A separator byte is never stored, so the state
-- updates stay `pair`s and every recursive argument is a variable: the input is
-- walked exactly once and the fields are reversed back once, when it ends.
--
-- Splitting on a multi-byte separator is deliberately not here. Detecting a
-- separator longer than a byte means re-walking the remaining input at every
-- split point (or splicing the field), which is quadratic in the best case and
-- blew up when tried. `http.tri` wants CRLF and `:` splits; that wants a shape
-- where the separator drives the recursion instead of the input.
--
-- Empty fields are preserved: `splitOnByte 58 "a::b"` is ["a" "" "b"].
splitByte_ self str byte acc current =
  lazyList
    (_ : map reverse (reverse (pair current acc)))
    (h r :
      lazyBool
        (_ : self r byte (pair current acc) t)
        (_ : self r byte acc (pair h current))
        (equal? h byte))
    str
splitOnByte = byte str : y splitByte_ str byte t t

-- Every one of these keeps its arguments bound: partially applying a
-- multi-argument function at the top level leaves a fixed point exposed.
lines   = str : splitOnByte 10 str
unlines = xs : joinSuffix "\n" xs

-- Runs of separators collapse: empty fields are dropped.
words   = str : filter (w : not? (emptyList? w)) (splitOnByte 32 str)
unwords = xs : intercalate " " xs

zipWith_ self f xs ys =
  matchList
    t
    (xh xt :
      matchList
        t
        (yh yt : pair (f xh yh) (self f xt yt))
        ys)
    xs
zipWith = f xs ys : y zipWith_ f xs ys