(.module:
  [lux (#- Module)
   [control
    ["." monad (#+ Monad do)]
    ["ex" exception (#+ exception:)]
    pipe]
   [data
    ["." bit ("#/." equivalence)]
    ["." maybe]
    ["." error]
    ["." product]
    [format
     ["." binary (#+ Format)]]
    ["." text
     [format (#- Format)]]
    [collection
     ["." list ("#/." functor fold)]
     ["dict" dictionary (#+ Dictionary)]
     ["." set (#+ Set)]]]
   [world
    [file (#+ File System)]]]
  [//
   [io (#+ Context Module)
    ["io/." context]
    ["io/." archive]]
   ["." archive (#+ Signature Key Descriptor Document Archive)]
   ["/." //]]
  ["." /dependency (#+ Dependency Graph)])

(exception: #export (cannot-delete-file {file File})
  (ex.report ["File" file]))

(exception: #export (stale-document {module ///.Module} {current-hash Nat} {stale-hash Nat})
  (ex.report ["Module" module]
             ["Current hash" (%n current-hash)]
             ["Stale hash" (%n stale-hash)]))

(exception: #export (mismatched-signature {module ///.Module} {expected Signature} {actual Signature})
  (ex.report ["Module" module]
             ["Expected" (archive.describe expected)]
             ["Actual" (archive.describe actual)]))

(do-template [<name>]
  [(exception: #export (<name> {message Text})
     message)]

  [cannot-load-definition]
  )

## General
(def: #export (cached System<m> root)
  (All [m] (-> (System m) File (m (List File))))
  (|> root
      (io/archive.archive System<m>)
      (do> (:: System<m> &monad)
           [(:: System<m> files)]
           [(monad.map @ (function (recur file)
                           (do @
                             [is-dir? (:: System<m> directory? file)]
                             (if is-dir?
                               (|> file
                                   (do> @
                                        [(:: System<m> files)]
                                        [(monad.map @ recur)]
                                        [list.concat
                                         (list& (maybe.assume (io/archive.module System<m> root file)))
                                         wrap]))
                               (wrap (list))))))]
           [list.concat wrap])))

## Clean
(def: (delete System<m> document)
  (All [m] (-> (System m) File (m Any)))
  (do (:: System<m> &monad)
    [deleted? (:: System<m> delete document)]
    (if deleted?
      (wrap [])
      (:: System<m> throw cannot-delete-file document))))

(def: (un-install System<m> root module)
  (All [m] (-> (System m) File Module (m Any)))
  (let [document (io/archive.document System<m> root module)]
    (|> document
        (do> (:: System<m> &monad)
             [(:: System<m> files)]
             [(monad.map @ (function (_ file)
                             (do @
                               [? (:: System<m> directory? file)]
                               (if ?
                                 (wrap #0)
                                 (do @
                                   [_ (..delete System<m> file)]
                                   (wrap #1))))))]
             [(list.every? (bit/= #1))
              (if> [(..delete System<m> document)]
                   [(wrap [])])]))))

(def: #export (clean System<m> root wanted-modules)
  (All [m] (-> (System m) File (Set Module) (m Any)))
  (|> root
      (do> (:: System<m> &monad)
           [(..cached System<m>)]
           [(list.filter (bit.complement (set.member? wanted-modules)))
            (monad.map @ (un-install System<m> root))])))

## Load
(def: signature
  (Format Signature)
  ($_ binary.and binary.name binary.text))

(def: descriptor
  (Format Descriptor)
  ($_ binary.and binary.nat binary.text (binary.list binary.text) (binary.ignore #.Cached)))

(def: document
  (All [a] (-> (Format a) (Format [Signature Descriptor a])))
  (|>> ($_ binary.and ..signature ..descriptor)))

(def: (load-document System<m> contexts root key binary module)
  (All [m d] (-> (System m) (List File) File (Key d) (Format d) Module
                 (m (Maybe [Dependency (Document d)]))))
  (do (:: System<m> &monad)
    [document' (:: System<m> read (io/archive.document System<m> root module))
     [module' source-code] (io/context.read System<m> contexts module)
     #let [current-hash (:: text.hash hash source-code)]]
    (case (do error.monad
            [[signature descriptor content] (binary.read (..document binary) document')
             #let [[document-hash _file references _state] descriptor]
             _ (ex.assert mismatched-signature [module (get@ #archive.signature key) signature]
                          (:: archive.equivalence =
                              (get@ #archive.signature key)
                              signature))
             _ (ex.assert stale-document [module current-hash document-hash]
                          (n/= current-hash document-hash))
             document (archive.write key signature descriptor content)]
            (wrap [[module references] document]))
      (#error.Success [dependency document])
      (wrap (#.Some [dependency document]))
      
      (#error.Failure error)
      (do @
        [_ (un-install System<m> root module)]
        (wrap #.None)))))

(def: #export (load-archive System<m> contexts root key binary)
  (All [m d] (-> (System m) (List Context) File (Key d) (Format d) (m Archive)))
  (do (:: System<m> &monad)
    [candidate (|> root
                   (do> @
                        [(..cached System<m>)]
                        [(monad.map @ (load-document System<m> contexts root key binary))
                         (:: @ map (list/fold (function (_ full-document archive)
                                                (case full-document
                                                  (#.Some [[module references] document])
                                                  (dict.put module [references document] archive)
                                                  
                                                  #.None
                                                  archive))
                                              (: (Dictionary Text [(List Module) (Ex [d] (Document d))])
                                                 (dict.new text.hash))))]))
     #let [candidate-entries (dict.entries candidate)
           candidate-dependencies (list/map (product.both id product.left)
                                            candidate-entries)
           candidate-archive (|> candidate-entries
                                 (list/map (product.both id product.right))
                                 (dict.from-list text.hash))
           graph (|> candidate
                     dict.entries
                     (list/map (product.both id product.left))
                     /dependency.graph
                     (/dependency.prune candidate-archive))
           archive (list/fold (function (_ module archive)
                                (if (dict.contains? module graph)
                                  archive
                                  (dict.remove module archive)))
                              candidate-archive
                              (dict.keys candidate))]]
    (wrap archive)))