(;module:
  lux
  (lux (control monoid
                ["F" functor]
                [eq #+ Eq]
                fold)
       (data (coll [list "List/" Fold<List>])
             [product])
       ))

## [Types]
(type: #export (Array a)
  {#;doc "Mutable arrays."}
  (#;Host "#Array" (#;Cons a #;Nil)))

## [Functions]
(def: #export (new size)
  (All [a] (-> Nat (Array a)))
  (_lux_proc ["array" "new"] [size]))

(def: #export (size xs)
  (All [a] (-> (Array a) Nat))
  (_lux_proc ["array" "size"] [xs]))

(def: #export (get i xs)
  (All [a]
    (-> Nat (Array a) (Maybe a)))
  (_lux_proc ["array" "get"] [xs i]))

(def: #export (put i x xs)
  (All [a]
    (-> Nat a (Array a) (Array a)))
  (_lux_proc ["array" "put"] [xs i x]))

(def: #export (remove i xs)
  (All [a]
    (-> Nat (Array a) (Array a)))
  (_lux_proc ["array" "remove"] [xs i]))

(def: #export (copy length src-start src-array dest-start dest-array)
  (All [a] (-> Nat Nat (Array a) Nat (Array a)
               (Array a)))
  (if (n.= +0 length)
    dest-array
    (List/fold (function [offset target]
                 (case (get (n.+ offset src-start) src-array)
                   #;None
                   target
                   
                   (#;Some value)
                   (put (n.+ offset dest-start) value target)))
               dest-array
               (list;n.range +0 (n.dec length)))))

(def: #export (occupied array)
  {#;doc "Finds out how many cells in an array are occupied."}
  (All [a] (-> (Array a) Nat))
  (List/fold (function [idx count]
               (case (get idx array)
                 #;None
                 count
                 
                 (#;Some _)
                 (n.inc count)))
             +0
             (list;indices (size array))))

(def: #export (vacant array)
  {#;doc "Finds out how many cells in an array are vacant."}
  (All [a] (-> (Array a) Nat))
  (n.- (occupied array) (size array)))

(def: #export (filter p xs)
  (All [a]
    (-> (-> a Bool) (Array a) (Array a)))
  (List/fold (: (-> Nat (Array ($ +0)) (Array ($ +0)))
                (function [idx xs']
                  (case (get idx xs)
                    #;None
                    xs'

                    (#;Some x)
                    (if (p x)
                      xs'
                      (remove idx xs')))))
             xs
             (list;indices (size xs))))

(def: #export (find p xs)
  (All [a]
    (-> (-> a Bool) (Array a) (Maybe a)))
  (let [arr-size (size xs)]
    (loop [idx +0]
      (if (n.< arr-size idx)
        (case (get idx xs)
          #;None
          (recur (n.inc idx))
          
          (#;Some x)
          (if (p x)
            (#;Some x)
            (recur (n.inc idx))))
        #;None))))

(def: #export (find+ p xs)
  {#;doc "Just like 'find', but with access to the index of each value."}
  (All [a]
    (-> (-> Nat a Bool) (Array a) (Maybe [Nat a])))
  (let [arr-size (size xs)]
    (loop [idx +0]
      (if (n.< arr-size idx)
        (case (get idx xs)
          #;None
          (recur (n.inc idx))
          
          (#;Some x)
          (if (p idx x)
            (#;Some [idx x])
            (recur (n.inc idx))))
        #;None))))

(def: #export (clone xs)
  (All [a] (-> (Array a) (Array a)))
  (let [arr-size (size xs)]
    (List/fold (function [idx ys]
                 (case (get idx xs)
                   #;None
                   ys

                   (#;Some x)
                   (put idx x ys)))
               (new arr-size)
               (list;indices arr-size))))

(def: #export (from-list xs)
  (All [a] (-> (List a) (Array a)))
  (product;right (List/fold (function [x [idx arr]]
                              [(n.inc idx) (put idx x arr)])
                            [+0 (new (list;size xs))]
                            xs)))

(def: #export (to-list array)
  (All [a] (-> (Array a) (List a)))
  (let [_size (size array)]
    (product;right (List/fold (function [_ [idx tail]]
                                (case (get idx array)
                                  (#;Some head)
                                  [(n.dec idx) (#;Cons head tail)]

                                  #;None
                                  [(n.dec idx) tail]))
                              [(n.dec _size) #;Nil]
                              (list;repeat _size [])
                              ))))

## [Structures]
(struct: #export (Eq<Array> Eq<a>)
  (All [a] (-> (Eq a) (Eq (Array a))))
  (def: (= xs ys)
    (let [sxs (size xs)
          sxy (size ys)]
      (and (n.= sxy sxs)
           (List/fold (function [idx prev]
                        (and prev
                             (case [(get idx xs) (get idx ys)]
                               [#;None #;None]
                               true

                               [(#;Some x) (#;Some y)]
                               (:: Eq<a> = x y)

                               _
                               false)))
                      true
                      (list;n.range +0 (n.dec sxs)))))
    ))

(struct: #export Monoid<Array> (All [a]
                                 (Monoid (Array a)))
  (def: identity (new +0))

  (def: (compose xs ys)
    (let [sxs (size xs)
          sxy (size ys)]
      (|> (new (n.+ sxy sxs))
          (copy sxs +0 xs +0)
          (copy sxy +0 ys sxs)))))

(struct: #export _ (F;Functor Array)
  (def: (map f ma)
    (let [arr-size (size ma)]
      (if (n.= +0 arr-size)
        (new arr-size)
        (List/fold (: (-> Nat (Array ($ +1)) (Array ($ +1)))
                      (function [idx mb]
                        (case (get idx ma)
                          #;None
                          mb

                          (#;Some x)
                          (put idx (f x) mb))))
                   (new arr-size)
                   (list;n.range +0 (n.dec arr-size)))))))

(struct: #export _ (Fold Array)
  (def: (fold f init xs)
    (let [arr-size (size xs)]
      (loop [so-far init
             idx +0]
        (if (n.< arr-size idx)
          (case (get idx xs)
            #;None
            (recur so-far (n.inc idx))

            (#;Some value)
            (recur (f value so-far) (n.inc idx)))
          so-far)))))