(def (fail* message)
  (#Failure message))

(def (return* state value)
  (#Ok [state value]))

(def (fail message)
  (lambda [state]
     (#Failure message)))

(def (return value)
  (lambda [state]
     (#Ok [state value])))

(def (bind m-value step)
  (lambda [state]
     (let inputs (m-value state)
          (case inputs
            (#Ok [?state ?datum])
            (step ?datum ?state)
            
            _
            inputs))))

## Ideally, this is what I want...
## (exec [yolo lol
##        #let [foo (bar 1 2 3)]]
##   (meme yolo foo))

(defmacro (exec tokens)
  (case tokens
    (#Cons (#Tuple steps) (#Cons value #Nil))
    (fold (lambda [inner pair]
             (case pair
               [label computation]
               (' (bind (~ computation) (lambda [(~ label)] (~ inner))))))
          value
          (pairs steps))))

(def (try-m monad)
  (lambda [state]
     (case (monad state)
       (#Ok [?state ?datum])
       (return* ?state (#Just ?datum))
       
       (#Failure _)
       (return* state #Nothing))))

(def (repeat-m monad)
  (lambda [state]
     (case (monad state)
       (#Ok [?state ?head])
       (case ((repeat-m monad) ?state)
         (#Ok [?state* ?tail])
         (return* ?state* (#Cons ?head ?tail)))
       
       (#Failure ?message)
       (return* state #Nil))))

(def (try-all-m monads)
  (lambda [state]
     (case monads
       #Nil
       (fail* "No alternative worked!")
       (#Cons monad monads')
       (let output (monad state)
            (case output
              (#Ok _)
              output
              
              (#Failure _)
              (case monads'
                #Nil
                output
                (#Cons _ _)
                ((try-all-m monads') state))
              ))
       )))

(def (map-m f inputs)
  (case inputs
    #Nil
    (return #Nil)
    (#Cons input inputs')
    (exec [output (f input)
           outputs (map-m f inputs')]
      (return (#Cons output outputs)))))

(def (fold-m f init inputs)
  (case inputs
    #Nil              (return init)
    (#Cons x inputs') (exec [init* (f init x)]
                        (fold-m f init* inputs'))))

(def (apply-m monad call-state)
  (lambda [state]
     (let output (monad call-state)
          (case output
            (#Ok [?state ?datum])
            (#Ok [state ?datum])

            _
            output))))

(def (assert test message)
  (if test
    (return [])
    (fail message)))

(def (pass %value)
  (lambda [state]
     %value))

(def get-state
  (lambda [state]
     (return* state state)))

(def (normalize-char char)
  (case char
    #"*" "_ASTER_"
    #"+" "_PLUS_"
    #"-" "_DASH_"
    #"/" "_SLASH_"
    #"_" "_UNDERS_"
    #"%" "_PERCENT_"
    #"$" "_DOLLAR_"
    #"'" "_QUOTE_"
    #"`" "_BQUOTE_"
    #"@" "_AT_"
    #"^" "_CARET_"
    #"&" "_AMPERS_"
    #"=" "_EQ_"
    #"!" "_BANG_"
    #"?" "_QM_"
    #":" "_COLON_"
    #";" "_SCOLON_"
    #"." "_PERIOD_"
    #"," "_COMMA_"
    #"<" "_LT_"
    #">" "_GT_"
    #"~" "_TILDE_"
    ##;;#"\" "_BSLASH_"
    _    (show char)
    ))

(def (normalize-ident ident)
  (fold concat "" (map normalize-char (text->list ident))))

(def (within slot monad)
  (lambda [state]
     (let =return (monad (get slot state))
          (case =return
            (#Ok ?state ?value)
            (#Ok (put slot ?state state) ?value)
            
            _
            =return))))

(def (run-state monad state)
  (monad state))

(def (fresh-class-loader path)
  (let file (jvm/new java.io.File [String] [path])
       (let url (jvm/invokevirtual java.io.File "toURL" []
                                   file [])
            (let urls (jvm/new-array java.net.URL 1)
                 (do (jvm/aastore urls 0 url)
                   (jvm/new java.net.URLClassLoader [(Array java.net.URL)] [urls]))))
       ))