if cond (then) (else) = [[
  default-take [take :truthy cond] (:false else) then
]]

cond cases = [[
  take true cases
]]

true = (:truthy :true)
false = (:truthy :false)

equal? a b = [default-take a (b true) false]

not v = [if v [give :truthy :false v] [give :truthy :true v]]

empty? map = [default-take map (() true) false]

zero = ()

succ num = [give :pred num ()]

pred num = [take :pred num]

add a b = [
  if [empty? a]
    b
    [succ [add [pred a] b]]
]

mult a b = [
  if [elem? (|a b|) zero]
    zero
    [if [elem? (|a b|) one]
      [take one (a b b a)]
      [add a [mult a [pred b]]]]
]

digit-char->nat c = [
  take c (
    '0' zero,
    '1' one,
    '2' two,
    '3' three,
    '4' four,
    '5' [succ four],
    '6' [add three three],
    '7' [add four three],
    '8' [add four four],
    '9' [add four [succ four]]
  )
]

-- private
string->nat-aux str acc = [
  if [empty? str]
    acc
    [string->nat-aux
      [:tail str]
      [add
        [mult ten acc]
        [digit-char->nat [:head str]
      ]
    ]
  ]
]

string->nat str = [string->nat-aux str zero]

pow base exponent = [
  if [equal? zero exponent]
    one
    [mult base [pow base [pred exponent]]]
]

div dividend divisor = (
  :numerator dividend
  :denominator divisor
)

one = [succ zero]
two = [succ one]
three = [succ two]
four = [succ three]
ten = [mult two [succ four]]

identity a = a

const a _ = a

. f g = \x -> [f [g x]]

nil = ()

cons value list = (:head value :tail list)

-- length : list a -> nat
length values = [
  if [empty? values]
    zero
    [succ [length [:tail values]]]
]

-- elem? : list a -> a -> bool
elem? values a = [
  if [empty? values]
    false
    [if [equal? [:head values] a]
      true
      [elem? [:tail values] a]]
]

-- ++ : list a -> list a -> list a
++ as bs = [
  if [empty? as]
    bs
    [cons [:head as] [++ [:tail as] bs]]
]

-- concat : list (list a) -> list a
concat values = [
  if [empty? values]
    nil
    [++ [:head values] [concat [:tail values]]]
]

-- iterate-n : (a -> a) -> a -> nat -> list a
iterate-n f v n = [
  if [equal? n zero]
    nil
    [cons v [iterate-n f [f v] [pred n]]]
]

-- replicate : nat -> a -> list a
replicate n v = [
  if [equal? n zero]
    nil
    [cons v [replicate [pred n] v]]
]

-- prepend-all : a -> list a -> list a
prepend-all sep vs = [
  if [empty? vs]
    nil
    [cons sep [cons [:head vs] [prepend-all sep [:tail vs]]]]
]

-- intersperse : a -> list a -> list a
intersperse sep values =[
  if [empty? values]
    nil
    [cons [:head values] [prepend-all sep [:tail values]]]
]

-- intercalate : list a -> list (list a) -> list a
intercalate sep vs = [concat [intersperse sep vs]]

-- fold : (a -> b -> b) -> b -> list a -> b
fold f init vs = [
  if [empty? vs]
    init
    [f [:head vs] [fold f init [:tail vs]]]
]

-- private
reverse-into vs acc = [
  if [empty? vs]
    acc
    [reverse-into [:tail vs] [cons [:head vs] acc]]
]

-- reverse : list a -> list a
reverse vs = [reverse-into vs nil]

-- private
split-aux vs acc = [
  if [empty? vs]
    [if [empty? acc] nil (|[reverse acc]|)]
    let
      first = [:head vs]
      rest = [:tail vs]
    in [
      if [equal? delim first]
        [cons [reverse acc] [split-aux rest nil]]
        [split-aux rest [cons first acc]]
    ]
]

-- split: a -> list a -> list (list a)
split delim vs = [split-aux vs nil]

-- map-stream : (a -> b) -> stream a -> stream b
map-stream f stream =
  \ -> let
    current = [stream]
  in
    (
      :value [f [:value current]]
      :next [map-stream f [:next current]]
    )

-- filter-stream : (a -> bool) -> stream a -> stream a
filter-stream p? stream =
  let
    current = [stream]
    value = [:value current]
    next = [:next current]
  in
    [
      if [p? value]
      \ -> (
        :value value
        :next [filter-stream p? next]
      )
      [filter-stream p? next]
    ]

-- head-while : (a -> bool) -> stream a -> list a
head-while p? stream =
  let
    current = [stream]
    value = [:value current]
  in
    [
      if [p? value]
        [cons value [head-while p? [:next current]]]
        nil
    ]

-- repeat : a -> stream a
repeat v = \ -> (
  :value v
  :next [repeat v]
)

-- private
cycle-aux vs values = [
  if [empty? vs]
    [cycle-aux values values]
    \ -> (
      :value [:head vs]
      :next [cycle-aux [:tail vs] values]
    )
]

cycle values = [cycle-aux values values]

-- first-n : nat -> stream a -> list a
first-n n stream = [
  if [equal? zero n]
    nil
    let
      unboxed = [stream]
    in
      [cons [:value unboxed] [first-n [pred n] [:next unboxed]]]
]

-- drop-n : nat -> stream a -> stream a
drop-n n stream = [
  if [equal? zero n]
    stream
    [drop-n [pred n] [:next [stream]]]
]

-- iterate : (a -> a) -> a -> stream a
iterate f v = \ -> (
  :value v
  :next [iterate f [f v]]
)

apply fn v = [fn v]

assert c = [if c :pass :fail]

map f xs = [
  if [empty? xs]
    nil
    [cons [f [take :head xs]] [map f [take :tail xs]]]
]

filter p? xs = [
  if [empty? xs]
    nil
    let
      first = [take :head xs]
      rest = [take :tail xs]
    in [if [p? first]
         [cons first [filter p? rest]]
         [filter p? rest]]
]

silly-list = [cons :a [cons :b nil]]
silly-with-empties-list = [cons () [cons () [cons :a [cons () [cons :b [cons () nil]]]]]]

silly-fn v = [take v (:a :c :b :d)]

expected-map-list = [cons :c [cons :d nil]]
expected-filter-list = [cons :c [cons :d nil]]

always-true _ = true

cases = (|
  (
    :testing :cons-works
    :where (
      :should-be :equal
      :actual [cons :foo nil]
      :expected (:head :foo :tail ())
    )
  )
  (
    :testing :add-works-for-trivial-case
    :where (
      :should-be :equal
      :actual [add zero two]
      :expected two
    )
  )
  (
    :testing :add-works-for-harder-case
    :where (
      :should-be :equal
      :actual [add two two]
      :expected four
    )
  )
  (
    :testing :mult-for-zeroes
    :where (
      :should-be :equal
      :actual (| [mult zero four] [mult four zero] |)
      :expected (|zero zero|)
    )
  )
  (
    :testing :mult-for-ones
    :where (
      :should-be :equal
      :actual (| [mult one four] [mult four one] |)
      :expected (|four four|)
    )
  )
  (
    :testing :mult-for-a-less-trivial-case
    :where (
      :should-be :equal
      :actual [mult two four]
      :expected [succ [succ [succ [succ four]]]]
    )
  )
  (
    :testing :pow-of-zero
    :where (
      :should-be :equal
      :actual [pow four zero]
      :expected one
    )
  )
  (
    :testing :pow-of-one
    :where (
      :should-be :equal
      :actual [pow four one]
      :expected four
    )
  )
  (
    :testing :pow-for-less-trivial-case
    :where (
      :should-be :equal
      :actual [pow [succ two] two]
      :expected [succ [succ [succ [succ [succ four]]]]]
    )
  )
  (
    :testing :length-of-nil
    :where (
      :should-be :equal
      :actual [length nil]
      :expected zero
    )
  )
  (
    :testing :length-of-values
    :where (
      :should-be :equal
      :actual [length (|:a :b :c :d|)]
      :expected four
    )
  )
  (
    :testing :length-of-a-string
    :where (
      :should-be :equal
      :actual [length "12345"]
      :expected [succ four]
    )
  )
  (
    :testing :map-for-trivial-case
    :where (
      :should-be :equal
      :actual [map identity silly-list]
      :expected silly-list
    )
  )
  (
    :testing :map-for-harder-case
    :where (
      :should-be :equal
      :actual [map silly-fn silly-list]
      :expected expected-map-list
    )
  )
  (
    :testing :filter-for-trivial-case
    :where (
      :should-be :equal
      :actual [filter always-true silly-list]
      :expected silly-list
    )
  )
  (
    :testing :filter-for-harder-case
    :where (
      :should-be :equal
      :actual [filter [. not empty?] silly-with-empties-list]
      :expected silly-list
    )
  )
  (
    :testing :compose-for-trivial-case
    :where (
      :should-be :equal
      :actual [[. identity identity] true]
      :expected true
    )
  )
  (
    :testing :compose-for-harder-case
    :where (
      :should-be :equal
      :actual [[. not not] true]
      :expected true
    )
  )
  (:testing :++-for-trivial-case :where (:should-be :empty :value [++ nil nil]))
  (
    :testing :++-for-harder-case
    :where (
      :should-be :equal
      :actual [++ (|:a :b :c|) (|:d :e|)]
      :expected (|:a :b :c :d :e|)
    )
  )
  (
    :testing :concat-for-trivial-case
    :where (
      :should-be :empty
      :value [concat (| nil nil nil nil |)]
    )
  )
  (
    :testing :concat-for-harder-case
    :where (
      :should-be :equal
      :actual [concat (| (|:a :b :c|) (|:d :e|) (|:f|) |)]
      :expected (|:a :b :c :d :e :f|)
    )
  )
  (:testing :iterate-n-for-0 :where (:should-be :empty :value [iterate-n identity zero zero]))
  (
    :testing :iterate-n-for-1
    :where (
      :should-be :equal
      :actual [iterate-n identity zero (:pred zero)]
      :expected (|zero|)
    )
  )
  (
    :testing :iterate-n-for-n
    :where (
      :should-be :equal
      :actual [iterate-n succ zero four]
      :expected (|zero (:pred zero) two (:pred two)|)
    )
  )
  (
    :testing :replicate-for-n
    :where (
      :should-be :equal
      :actual [replicate four four]
      :expected (|four four four four|)
    )
  )
  (:testing :intersperse-for-empty :where (:should-be :empty :value [intersperse four nil]))
  (
    :testing :intersperse-for-singleton
    :where (
      :should-be :equal
      :actual [intersperse four (|four|)]
      :expected (|four|)
    )
  )
  (
    :testing :intersperse-for-bigger-list
    :where (
      :should-be :equal
      :actual [intersperse zero (|four four four|)]
      :expected (|four zero four zero four|)
    )
  )
  (
    :testing :intercalate-for-empties
    :where (:should-be :empty :value [intercalate nil nil])
  )
  (
    :testing :intercalate-for-non-trivial-case
    :where (
      :should-be :equal
      :actual [intercalate ", " (|"hello" "world" "hi"|)]
      :expected "hello, world, hi"
    )
  )
  (
    :testing :fold-for-empty-list
    :where (:should-be :equal :actual [fold add four nil] :expected four)
  )
  (
    :testing :fold-for-non-trivial-case
    :where (
      :should-be :equal
      :actual [fold add zero (|two two four four|)]
      :expected [add four [add four four]]
    )
  )
  (
    :testing :reverse-on-empty
    :where (:should-be :empty :value [reverse nil])
  )
  (
    :testing :reverse-on-a-non-empty-list
    :where (:should-be :equal :actual [reverse (|zero two four|)] :expected (|four two zero|))
  )
  (
    :testing :split-on-empty
    :where (:should-be :empty :value [split ',' nil])
  )
  (
    :testing :split-for-no-matches
    :where (:should-be :equal :actual [split ',' "Hello"] :expected (|"Hello"|))
  )
  (
    :testing :split-for-simple-matches
    :where (:should-be :equal :actual [split ',' "a,b,c"] :expected (|"a" "b" "c"|))
  )
  (
    :testing :split-for-match-on-the-end
    :where (:should-be :equal :actual [split ',' "a,b,"] :expected (|"a" "b"|))
  )
  (
    :testing :split-for-consecutive-matches
    :where (:should-be :equal :actual [split ',' "a,,b"] :expected (|"a" "" "b"|))
  )
  (
    :testing :repeat-returns-a-stream-whose-first-value-is-the-repeated-value
    :where (
      :should-be :equal
      :actual [:value [[repeat :foo]]]
      :expected :foo
    )
  )
  (
    :testing :repeat-returns-a-stream-whose-next-value-looks-a-lot-like-the-first
    :where (
      :should-be :equal
      :actual [:value [[:next [[repeat :foo]]]]]
      :expected :foo
    )
  )
  (
    :testing :map-stream-given-identity-returns-a-stream-that-behaves-the-same
    :where (
      :should-be :equal
      :actual [first-n four [map-stream identity [cycle (| one two |)]]]
      :expected (| one two one two |)
    )
  )
  (
    :testing :map-stream-applies-a-function-over-a-stream
    :where (
      :should-be :equal
      :actual [first-n four [map-stream succ [cycle (| one two three four |)]]]
      :expected (| two three four [succ four] |)
    )
  )
  (
    :testing :filter-stream-for-a-trivial-case
    :where (
      :should-be :equal
      :actual [first-n four [filter-stream [const true] [cycle (| one two |)]]]
      :expected (| one two one two |)
    )
  )
  (
    :testing :filter-stream-for-a-less-trivial-case
    :where (
      :should-be :equal
      :actual [first-n four [filter-stream [. not [equal? two]] [cycle (| zero one two |)]]]
      :expected (| zero one zero one |)
    )
  )
  (
    :testing :filter-stream-for-consecutive-filterables
    :where (
      :should-be :equal
      :actual [first-n four [filter-stream [. not [equal? two]] [cycle (| two two one two two |)]]]
      :expected (| one one one one |)
    )
  )
  (
    :testing :head-while-given-a-non-matching-predicate
    :where (
      :should-be :empty
      :value [head-while [equal? :foo] [repeat :bar]]
    )
  )
  (
    :testing :head-while-given-a-less-trivial-case
    :where (
      :should-be :equal
      :actual [head-while [elem? (| :a :b |)] [cycle (| :a :a :b :a :b :c |)]]
      :expected (| :a :a :b :a :b |)
    )
  )
  (
    :testing :first-n-given-zero
    :where (
      :should-be :equal
      :actual [first-n zero [repeat :foo]]
      :expected nil
    )
  )
  (
    :testing :first-n-given-n
    :where (
      :should-be :equal
      :actual [first-n four [repeat :foo]]
      :expected (| :foo :foo :foo :foo |)
    )
  )
  (
    :testing :iterate-given-a-trivial-function
    :where (
      :should-be :equal
      :actual [first-n four [iterate identity :foo]]
      :expected (| :foo :foo :foo :foo |)
    )
  )
  (
    :testing :iterate-given-a-less-trivial-function
    :where (
      :should-be :equal
      :actual [first-n four [iterate succ zero]]
      :expected (| zero one two three |)
    )
  )
  (
    :testing :drop-n-given-0
    :where (
      :should-be :equal
      :actual [first-n four [drop-n zero [iterate succ zero]]]
      :expected (| zero one two three |)
    )
  )
  (
    :testing :drop-n-given-n
    :where (
      :should-be :equal
      :actual [first-n four [drop-n four [iterate succ zero]]]
      :expected (| four [succ four] [succ [succ four]] [succ [succ [succ four]]] |)
    )
  )
  (
    :testing :cycle-given-a-single-element
    :where (
      :should-be :equal
      :actual [first-n four [cycle (| :foo |)]]
      :expected (| :foo :foo :foo :foo |)
    )
  )
  (
    :testing :cycle-given-multiple-elements
    :where (
      :should-be :equal
      :actual [first-n four [cycle (| :a :b |)]]
      :expected (| :a :b :a :b |)
    )
  )
  (
    :testing :digit-char->nat-for-each-digit-char
    :where (
      :should-be :equal
      :actual [map digit-char->nat "0123456789"]
      :expected (| zero one two three four [succ four] [add three three] [add four three] [add four four] [add four [succ four]]|)
    )
  )
  (
    :testing :string->nat_for-empty
    :where (
      :should-be :equal
      :actual [string->nat ""]
      :expected zero
    )
  )
  (
    :testing :string->nat_for-single-digit
    :where (
      :should-be :equal
      :actual [string->nat "7"]
      :expected [add three four]
    )
  )
  (
    :testing :string->nat_for-multi-digit
    :where (
      :should-be :equal
      :actual [string->nat "42"]
      :expected [mult [add three three] [add three four]]
    )
  )
|)

apply-case case =
  let
    assertion = [:where case]
  in (
    :passed [[take [:should-be [:where case]] (
      :equal \ -> [equal? [:actual [:where case]] [:expected [:where case]]]
      :empty \ -> [empty? [:value [:where case]]]
    )]]
    :show-on-fail (:name [:testing case] :reason [:where case])
  )

run-tests cases = [
  map :show-on-fail [filter [. not :passed] [map apply-case cases]]
]

io = __prim_io_map

main = [run-tests cases]