(.module:
  [lux #*
   [control
    ["ex" exception (#+ exception:)]
    [monad (#+ do)]]
   [data
    ["." product]
    ["." error (#+ Error)]
    ["." name ("name/." Equivalence<Name>)]
    ["." text
     format]
    [collection
     ["." row (#+ Row)]
     ["." dictionary (#+ Dictionary)]]]
   [world
    [file (#+ File)]]]
  ["." //
   ["." extension]]
  [//synthesis (#+ Synthesis)])

(do-template [<name>]
  [(exception: #export (<name>)
     "")]

  [no-active-buffer]
  [no-anchor]
  )

(exception: #export (cannot-interpret {error Text})
  (ex.report ["Error" error]))

(exception: #export (unknown-lux-name {name Name})
  (ex.report ["Name" (%name name)]))

(exception: #export (cannot-overwrite-lux-name {lux-name Name}
                                               {old-host-name Text}
                                               {new-host-name Text})
  (ex.report ["Lux Name" (%name lux-name)]
             ["Old Host Name" old-host-name]
             ["New Host Name" new-host-name]))

(do-template [<name>]
  [(exception: #export (<name> {name Name})
     (ex.report ["Output" (%name name)]))]

  [cannot-overwrite-output]
  [no-buffer-for-saving-code]
  )

(type: #export Context
  {#scope-name Text
   #inner-functions Nat})

(signature: #export (Host expression statement)
  (: (-> Text expression (Error Any))
     evaluate!)
  (: (-> Text statement (Error Any))
     execute!)
  (: (-> Name expression (Error [Text Any]))
     define!))

(type: #export (Buffer statement) (Row [Name statement]))

(type: #export (Outputs statement) (Dictionary File (Buffer statement)))

(type: #export (State anchor expression statement)
  {#context Context
   #anchor (Maybe anchor)
   #host (Host expression statement)
   #buffer (Maybe (Buffer statement))
   #outputs (Outputs statement)
   #counter Nat
   #name-cache (Dictionary Name Text)})

(do-template [<special> <general>]
  [(type: #export (<special> anchor expression statement)
     (<general> (State anchor expression statement) Synthesis expression))]

  [State+    extension.State]
  [Operation extension.Operation]
  [Phase     extension.Phase]
  [Handler   extension.Handler]
  [Bundle    extension.Bundle]
  )

(def: #export (state host)
  (All [anchor expression statement]
    (-> (Host expression statement)
        (..State anchor expression statement)))
  {#context {#scope-name ""
             #inner-functions 0}
   #anchor #.None
   #host host
   #buffer #.None
   #outputs (dictionary.new text.Hash<Text>)
   #counter 0
   #name-cache (dictionary.new name.Hash<Name>)})

(def: #export (with-context expr)
  (All [anchor expression statement output]
    (-> (Operation anchor expression statement output)
        (Operation anchor expression statement [Text output])))
  (function (_ [bundle state])
    (let [[old-scope old-inner] (get@ #context state)
          new-scope (format old-scope "c" (%n old-inner))]
      (case (expr [bundle (set@ #context [new-scope 0] state)])
        (#error.Success [[bundle' state'] output])
        (#error.Success [[bundle' (set@ #context [old-scope (inc old-inner)] state')]
                         [new-scope output]])

        (#error.Failure error)
        (#error.Failure error)))))

(def: #export context
  (All [anchor expression statement]
    (Operation anchor expression statement Text))
  (extension.read (|>> (get@ #context)
                       (get@ #scope-name))))

(do-template [<tag>
              <with-declaration> <with-type> <with-value>
              <get> <get-type> <exception>]
  [(def: #export <with-declaration>
     (All [anchor expression statement output] <with-type>)
     (function (_ body)
       (function (_ [bundle state])
         (case (body [bundle (set@ <tag> (#.Some <with-value>) state)])
           (#error.Success [[bundle' state'] output])
           (#error.Success [[bundle' (set@ <tag> (get@ <tag> state) state')]
                            output])

           (#error.Failure error)
           (#error.Failure error)))))

   (def: #export <get>
     (All [anchor expression statement]
       (Operation anchor expression statement <get-type>))
     (function (_ (^@ stateE [bundle state]))
       (case (get@ <tag> state)
         (#.Some output)
         (#error.Success [stateE output])

         #.None
         (ex.throw <exception> []))))]

  [#anchor
   (with-anchor anchor)
   (-> anchor (Operation anchor expression statement output)
       (Operation anchor expression statement output))
   anchor
   anchor anchor no-anchor]

  [#buffer
   with-buffer
   (-> (Operation anchor expression statement output)
       (Operation anchor expression statement output))
   row.empty
   buffer (Buffer statement) no-active-buffer]
  )

(def: #export outputs
  (All [anchor expression statement]
    (Operation anchor expression statement (Outputs statement)))
  (extension.read (get@ #outputs)))

(def: #export next
  (All [anchor expression statement]
    (Operation anchor expression statement Nat))
  (do //.Monad<Operation>
    [count (extension.read (get@ #counter))
     _ (extension.update (update@ #counter inc))]
    (wrap count)))

(do-template [<name> <inputT>]
  [(def: #export (<name> label code)
     (All [anchor expression statement]
       (-> Text <inputT> (Operation anchor expression statement Any)))
     (function (_ (^@ state+ [bundle state]))
       (case (:: (get@ #host state) <name> label code)
         (#error.Success output)
         (#error.Success [state+ output])

         (#error.Failure error)
         (ex.throw cannot-interpret error))))]

  [evaluate! expression]
  [execute!  statement]
  )

(def: #export (define! name code)
  (All [anchor expression statement]
    (-> Name expression (Operation anchor expression statement [Text Any])))
  (function (_ (^@ stateE [bundle state]))
    (case (:: (get@ #host state) define! name code)
      (#error.Success output)
      (#error.Success [stateE output])

      (#error.Failure error)
      (ex.throw cannot-interpret error))))

(def: #export (save! name code)
  (All [anchor expression statement]
    (-> Name statement (Operation anchor expression statement Any)))
  (do //.Monad<Operation>
    [count ..next
     _ (execute! (format "save" (%n count)) code)
     ?buffer (extension.read (get@ #buffer))]
    (case ?buffer
      (#.Some buffer)
      (if (row.any? (|>> product.left (name/= name)) buffer)
        (//.throw cannot-overwrite-output name)
        (extension.update (set@ #buffer (#.Some (row.add [name code] buffer)))))
      
      #.None
      (//.throw no-buffer-for-saving-code name))))

(def: #export (save-buffer! target)
  (All [anchor expression statement]
    (-> File (Operation anchor expression statement Any)))
  (do //.Monad<Operation>
    [buffer ..buffer]
    (extension.update (update@ #outputs (dictionary.put target buffer)))))

(def: #export (remember lux-name)
  (All [anchor expression statement]
    (-> Name (Operation anchor expression statement Text)))
  (function (_ (^@ stateE [_ state]))
    (let [cache (get@ #name-cache state)]
      (case (dictionary.get lux-name cache)
        (#.Some host-name)
        (#error.Success [stateE host-name])
        
        #.None
        (ex.throw unknown-lux-name lux-name)))))

(def: #export (learn lux-name host-name)
  (All [anchor expression statement]
    (-> Name Text (Operation anchor expression statement Any)))
  (function (_ [bundle state])
    (let [cache (get@ #name-cache state)]
      (case (dictionary.get lux-name cache)
        #.None
        (#error.Success [[bundle
                          (update@ #name-cache
                                   (dictionary.put lux-name host-name)
                                   state)]
                         []])

        (#.Some old-host-name)
        (ex.throw cannot-overwrite-lux-name [lux-name old-host-name host-name])))))