(.module:
  [library
   [lux {"-" [Module]}
    [abstract
     ["." equivalence {"+" [Equivalence]}]
     ["." monad {"+" [do]}]]
    [control
     ["." try {"+" [Try]}]
     ["." exception {"+" [exception:]}]
     ["." function]
     ["<>" parser
      ["<.>" binary {"+" [Parser]}]]]
    [data
     [binary {"+" [Binary]}]
     ["." bit]
     ["." product]
     ["." name]
     ["." text
      ["%" format {"+" [format]}]]
     [format
      ["." binary {"+" [Writer]}]]
     [collection
      ["." list ("#\." functor mix)]
      ["." dictionary {"+" [Dictionary]}]
      ["." set]
      ["." row {"+" [Row]}]]]
    [math
     [number
      ["n" nat ("#\." equivalence)]]]
    [type
     abstract]]]
  [/
   ["." artifact]
   ["." signature {"+" [Signature]}]
   ["." key {"+" [Key]}]
   ["." descriptor {"+" [Module Descriptor]}]
   ["." document {"+" [Document]}]
   [///
    [version {"+" [Version]}]]])

(type: .public Output
  (Row [artifact.ID (Maybe Text) Binary]))

(exception: .public (unknown_document {module Module}
                                      {known_modules (List Module)})
  (exception.report
   ["Module" (%.text module)]
   ["Known Modules" (exception.listing %.text known_modules)]))

(exception: .public (cannot_replace_document {module Module}
                                             {old (Document Any)}
                                             {new (Document Any)})
  (exception.report
   ["Module" (%.text module)]
   ["Old key" (signature.description (document.signature old))]
   ["New key" (signature.description (document.signature new))]))

(exception: .public (module_has_already_been_reserved {module Module})
  (exception.report
   ["Module" (%.text module)]))

(exception: .public (module_must_be_reserved_before_it_can_be_added {module Module})
  (exception.report
   ["Module" (%.text module)]))

(exception: .public (module_is_only_reserved {module Module})
  (exception.report
   ["Module" (%.text module)]))

(type: .public ID
  Nat)

(def: .public runtime_module
  Module
  "")

(abstract: .public Archive
  {}
  
  (Record
   [#next ID
    #resolver (Dictionary Module [ID (Maybe [Descriptor (Document Any) Output])])])

  (def: next
    (-> Archive ID)
    (|>> :representation (value@ #next)))

  (def: .public empty
    Archive
    (:abstraction [#next 0
                   #resolver (dictionary.empty text.hash)]))

  (def: .public (id module archive)
    (-> Module Archive (Try ID))
    (let [(^slots [#..resolver]) (:representation archive)]
      (case (dictionary.value module resolver)
        (#.Some [id _])
        (#try.Success id)
        
        #.None
        (exception.except ..unknown_document [module
                                              (dictionary.keys resolver)]))))

  (def: .public (reserve module archive)
    (-> Module Archive (Try [ID Archive]))
    (let [(^slots [#..next #..resolver]) (:representation archive)]
      (case (dictionary.value module resolver)
        (#.Some _)
        (exception.except ..module_has_already_been_reserved [module])
        
        #.None
        (#try.Success [next
                       (|> archive
                           :representation
                           (revised@ #..resolver (dictionary.has module [next #.None]))
                           (revised@ #..next ++)
                           :abstraction)]))))

  (def: .public (has module [descriptor document output] archive)
    (-> Module [Descriptor (Document Any) Output] Archive (Try Archive))
    (let [(^slots [#..resolver]) (:representation archive)]
      (case (dictionary.value module resolver)
        (#.Some [id #.None])
        (#try.Success (|> archive
                          :representation
                          (revised@ #..resolver (dictionary.has module [id (#.Some [descriptor document output])]))
                          :abstraction))
        
        (#.Some [id (#.Some [existing_descriptor existing_document existing_output])])
        (if (same? document existing_document)
          ... TODO: Find out why this code allows for the same module to be added more than once. It looks fishy...
          (#try.Success archive)
          (exception.except ..cannot_replace_document [module existing_document document]))
        
        #.None
        (exception.except ..module_must_be_reserved_before_it_can_be_added [module]))))

  (def: .public (find module archive)
    (-> Module Archive (Try [Descriptor (Document Any) Output]))
    (let [(^slots [#..resolver]) (:representation archive)]
      (case (dictionary.value module resolver)
        (#.Some [id (#.Some entry)])
        (#try.Success entry)

        (#.Some [id #.None])
        (exception.except ..module_is_only_reserved [module])
        
        #.None
        (exception.except ..unknown_document [module
                                              (dictionary.keys resolver)]))))

  (def: .public (archived? archive module)
    (-> Archive Module Bit)
    (case (..find module archive)
      (#try.Success _)
      bit.yes

      (#try.Failure _)
      bit.no))

  (def: .public archived
    (-> Archive (List Module))
    (|>> :representation
         (value@ #resolver)
         dictionary.entries
         (list.all (function (_ [module [id descriptor+document]])
                     (case descriptor+document
                       (#.Some _) (#.Some module)
                       #.None #.None)))))

  (def: .public (reserved? archive module)
    (-> Archive Module Bit)
    (let [(^slots [#..resolver]) (:representation archive)]
      (case (dictionary.value module resolver)
        (#.Some [id _])
        bit.yes

        #.None
        bit.no)))

  (def: .public reserved
    (-> Archive (List Module))
    (|>> :representation
         (value@ #resolver)
         dictionary.keys))

  (def: .public reservations
    (-> Archive (List [Module ID]))
    (|>> :representation
         (value@ #resolver)
         dictionary.entries
         (list\each (function (_ [module [id _]])
                      [module id]))))

  (def: .public (merged additions archive)
    (-> Archive Archive Archive)
    (let [[+next +resolver] (:representation additions)]
      (|> archive
          :representation
          (revised@ #next (n.max +next))
          (revised@ #resolver (function (_ resolver)
                                (list\mix (function (_ [module [id entry]] resolver)
                                            (case entry
                                              (#.Some _)
                                              (dictionary.has module [id entry] resolver)
                                              
                                              #.None
                                              resolver))
                                          resolver
                                          (dictionary.entries +resolver))))
          :abstraction)))

  (type: Reservation
    [Module ID])
  
  (type: Frozen
    [Version ID (List Reservation)])
  
  (def: reader
    (Parser ..Frozen)
    ($_ <>.and
        <binary>.nat
        <binary>.nat
        (<binary>.list (<>.and <binary>.text <binary>.nat))))

  (def: writer
    (Writer ..Frozen)
    ($_ binary.and
        binary.nat
        binary.nat
        (binary.list (binary.and binary.text binary.nat))))
  
  (def: .public (export version archive)
    (-> Version Archive Binary)
    (let [(^slots [#..next #..resolver]) (:representation archive)]
      (|> resolver
          dictionary.entries
          (list.all (function (_ [module [id descriptor+document]])
                      (case descriptor+document
                        (#.Some _) (#.Some [module id])
                        #.None #.None)))
          [version next]
          (binary.result ..writer))))

  (exception: .public (version_mismatch {expected Version} {actual Version})
    (exception.report
     ["Expected" (%.nat expected)]
     ["Actual" (%.nat actual)]))

  (exception: .public corrupt_data)

  (def: (correct_modules? reservations)
    (-> (List Reservation) Bit)
    (n.= (list.size reservations)
         (|> reservations
             (list\each product.left)
             (set.of_list text.hash)
             set.size)))

  (def: (correct_ids? reservations)
    (-> (List Reservation) Bit)
    (n.= (list.size reservations)
         (|> reservations
             (list\each product.right)
             (set.of_list n.hash)
             set.size)))

  (def: (correct_reservations? reservations)
    (-> (List Reservation) Bit)
    (and (correct_modules? reservations)
         (correct_ids? reservations)))

  (def: .public (import expected binary)
    (-> Version Binary (Try Archive))
    (do try.monad
      [[actual next reservations] (<binary>.result ..reader binary)
       _ (exception.assertion ..version_mismatch [expected actual]
                              (n\= expected actual))
       _ (exception.assertion ..corrupt_data []
                              (correct_reservations? reservations))]
      (in (:abstraction
           [#next next
            #resolver (list\mix (function (_ [module id] archive)
                                  (dictionary.has module [id #.None] archive))
                                (value@ #resolver (:representation ..empty))
                                reservations)]))))
  )