#lang scheme
(require "../prelude.ss")
; Exercise 1
;------------
(define-struct maybe (value))
(define Just make-maybe)
(define Nothing (make-maybe 'Nothing))


;; :TODO Convert these to use a macro 
;; (define safe-head (safe first))
(define (safe-head o) (if (null? o) Nothing (Just (first o))))
(define (safe-tail o) (if (null? o) Nothing (Just (rest o))))
(define (safe-last o) (if (null? o) Nothing (Just (last o))))
(define (safe-init o) (if (null? o) Nothing (Just (init o))))

; Exercise 2
;------------
; split-with that preserves all list members 
(define (split-with+ p xs)
  (cond [(null? xs) null]
        [else (let-values ([(head) (first xs)]
                           [(pre suf) (span p (rest xs))])
                (cons (cons head pre)
                      (split-with+ p suf)))]))

; split-with that drops all list members where the predicate is false
(define (split-with p xs)
  (define (split-suffix suf) (split-with p (drop-while (combine not p) suf)))
  (if (null? xs)
      null
      (let-values ([(pre suf) (span p xs)])
        (if (null? pre)
            (split-suffix suf)
            (cons pre (split-suffix suf))))))

;; Folds 
; Exercise 1

; string -> number
(define (as-int-fold ds)
  (cond [(string=? ds "") 0]
        [(char=? (string-ref ds 0) #\-) (- (as-int-fold (substring ds 1)))]
        [else (foldl shift-right-and-add 
                     0
                     (string->list ds))]))

; char -> integer -> ineger
(define (shift-right-and-add d acc)
  (+ (* 10 acc) 
     (char->digit d)))

; string -> number
(define (as-int-foldr ds)
  (cond [(string=? ds "")               
         0]
        [(char=? (string-ref ds 0) #\-) 
         (- (as-int-foldr (substring ds 1)))]
        [else 
         (first (foldr shift-left-and-add 
                       (list 0 0)
                       (string->list ds)))]))

(define (shift-left-and-add d acc)
  (let ([val (first acc)]
        [radix (second acc)])
    (list (+ val (* (expt 10 radix) 
                    (char->digit d)))
          (add1 radix))))


; Exercise 2

(define-struct either (which value))
(define (left  val)   (make-either 'left  val))
(define (right val)   (make-either 'right val))
(define (left? val)   (eq? (either-which val) 'left))
(define (right? val)  (eq? (either-which val) 'right))
(define (either-show val) (format "~A: ~A" 
                                  (if (left? val) "Left" "Right")
                                  (either-value val)))
                                  

(define (as-int-either s)
  (define (radix-add d acc)
    (cond [(left? acc) acc]
          [(digit? d) (right (+ (char->digit d) 
                                (* 10 (either-value acc))))]
          [else (left (format "Non digit ~A" d))]))
  
  (cond [(string=? s "") 
         (right 0)]
        [(string=? s "-") 
         (left "No digits supplied")]
        [(char=? (string-ref s 0) #\-) 
         (let ([res (as-int-either (substring s 1))])
           (if (left? res)
               res
               (right (- (either-value res)))))]
        [else (foldl radix-add (right 0) (string->list s))]))
        
; Exercise 3
(define (concat xss) (foldr append null xss))

; Exercise 4

; recursive take-while
(define (ba-take-while pred? xs)
  (cond [(null? xs)     null]
        [(pred? (first xs)) (cons (first xs) (ba-take-while pred? (rest xs)))]
        [else           null]))
  
; fold take-while
(define (ba-take-while-fold p xs)
  (define (take-step x acc) (if (p x) (cons x acc) null))
  (foldr take-step null xs))

; Exercise 5
(define (ba-group-by pred? xs)
  (define (group-step x acc)
    (cond [(null? acc) `((,x))]
          [else (let* ([last-added (last acc)]
                       [head (first last-added)]) 
                  (if (pred? head x)
                      (append (init acc) 
                              (list (append last-added (list x))))
                      (append acc `((,x)))))]))
  (foldl group-step null xs))

; Exercise 6
(define (ba-any pred? xs)
  (define (or-pred? x acc) (or acc (pred? x)))
  (foldr or-pred? false xs))

(require scheme/promise)
(define (lcar p) (let ([c (car p)]) (if (promise? c) (force c) c)))
(define (lcdr p) (let ([c (cdr p)]) (if (promise? c) (force c) c)))
(define (ba-cycle xs)
  (cons xs (delay (ba-cycle xs))))

(define (ba-words ws)
  
  (define (build-word x acc)
    (let ([this-word (first acc)]
          [all-words (second acc)]) 
      (if (char-whitespace? x)
          (if (null? this-word)
              (list null all-words)
              (list null (cons (list->string this-word) all-words)))
          (list (cons x this-word) all-words))))
                  
  (let* ((word-list (foldr build-word (list null null) (string->list ws)))
          [head-word (first word-list)]
          [tail-words (second word-list)])
    (if (null? head-word)
        tail-words
        (cons (list->string head-word) tail-words))))

(define (ba-unlines ls)
  (define (line-step l acc)
    (string-append (format "~A~N" l) acc))
  (foldr line-step "" ls))