<commit_before>(ns fcms.resources.taxonomy
  (:require [clojure.core.match :refer (match)]
            [clojure.string :as s]
            [flatland.ordered.map :refer (ordered-map)]
            [fcms.lib.ordered-map :refer (zip-ordered-map)]
            [fcms.resources.common :as common]
            [fcms.resources.collection-resource :as resource]
            [fcms.resources.collection :as collection]
            [fcms.resources.item :as item]))

(def taxonomy-media-type "application/vnd.fcms.taxonomy+json;version=1")

(defn get-taxonomy
  "Given the slug of the collection containing the taxonomy and the slug of the taxonomy,
  return the taxonomy as a map, or return :bad-collection if there's no collection with that slug, or
  nil if there is no taxonomy with that slug."
  [coll-slug slug]
    (resource/get-resource coll-slug slug :taxonomy))

(defn valid-new-taxonomy
  "Given the slug of the collection, the name of the taxonomy, and a map of a potential new taxonomy,
  check if the everything is in order to create the new taxonomy.
  Ensure the collection exists or return :bad-collection.
  Ensure the name of the taxonomy is specified or return :no-name.
  Ensure the slug is valid and doesn't already exist if it's specified,
  or return :invalid-slug or :slug-conflict respectively.
  If a property is included in the map of properties that is in the reserved-properties
  set, :property-conflict will be returned."
  ([coll-slug taxonomy-name] (valid-new-taxonomy coll-slug taxonomy-name {}))
  ([coll-slug taxonomy-name props]
    (resource/valid-new-resource coll-slug taxonomy-name resource/reserved-properties type props)))

(defn create-taxonomy
  "Create a new taxonomy in the collection specified by its slug, using the specified
  taxonomy name and an optional map of properties.
  If :slug is included in the properties it will be used as the taxonomy's slug, otherwise
  the slug will be created from the name.
  If a :slug is included in the properties and an taxonomy already exists
  in the collection with that slug, a :slug-conflict will be returned.
  If a :slug is included in the properties and it's not valid,
  :invalid-slug will be returned.
  If a property is included in the map of properties that is in the reserved-properties
  set, :property-conflict will be returned."
  ([coll-slug taxonomy-name] (create-taxonomy coll-slug taxonomy-name {}))
  ([coll-slug taxonomy-name props]
    (resource/create-resource coll-slug taxonomy-name :taxonomy (resource/allow-category-reserved-properties) (assoc props :categories []))))

(defn delete-taxonomy
  "Given the slug of the collection containing the taxonomy and the slug of the taxonomy,
  delete the taxonomy, or return :bad-collection if there's no collection with that slug, or
  :bad-taxonomy if there is no taxonomy with that slug."
  [coll-slug slug]
  (resource/delete-resource coll-slug slug :taxonomy))

(defn valid-taxonomy-update
  "Given the slug of the collection, the slug of the taxonomy,
  and a map of updated properties for the taxonomy,
  check if the everything is in order to update the taxonomy.
  Ensure the collection exists or return :bad-collection.
  Ensure the item exists or return :bad-taxonomy.
  If a new slug is provided in the properties, ensure it is
  valid or return :invalid-slug and ensure it is unused or
  return :slug-conflict. If no item slug is specified in
  the properties it will be retain its current slug."
  [coll-slug slug props]
  (resource/valid-resource-update coll-slug slug resource/reserved-properties props :taxonomy))

(defn update-taxonomy
  "Update a taxonomy in the collection specified by its slug using the specified
  map of properties. If :slug is included in the properties
  the taxonomy will be moved to the new slug, otherwise the slug will remain the same.
  The same validity conditions and invalid return values as valid-taxonomy-update? apply."
  [coll-slug slug props]
    (let [reason (valid-taxonomy-update coll-slug slug props)]
      (if (true? reason)
        (resource/update-resource coll-slug slug 
          {:reserved resource/reserved-properties
          :retained resource/retained-properties 
          :updated props} :taxonomy)
        reason)))

(defn all-taxonomies
  "Given the slug of the collection, return all the taxonomies it contains as a sequence of maps,
  or return :bad-collection if there's no collection with that slug."
  [coll-slug]
  (resource/all-resources coll-slug :taxonomy))

;; Category functions

(defn- valid-category-slug? [category]
  (common/valid-slug? (:slug category)))

(defn- valid-category-structure? [category]
  (and (contains? :slug) (contains? :name)
    (= 2 (count (dissoc category :categories)))))

(defn- valid-category-name? [category]
  (common/valid-name? (:name category)))

(defn- valid-categories
  "Validate a tree of categories, the following errors may be returned:
  invalid-structure, :invalid-category-name, :invalid-category-slug"
  ([categories] (valid-categories categories []))
  ([categories child-categories]
    ;; Validate a category tree with the following logic:
    ;; is it a vector?
    ;; is everything in it a map (the representation of a category)?
    ;; are categories structured as valid categories?
    ;; are the slugs of the categories valid?
    ;; are the names of the categories valid?
    ;; gather all the categories with children and add the children to the accumulator
    ;; is the accumulator empty? then it's all valid
    ;; otherwise recurse on the first child in the accumulator
    (cond
      (not (vector? categories)) :invalid-structure
      (empty? categories) true
      (not-every? map? categories) :invalid-structure
      (not-every? valid-category-structure? categories) :invalid-structure
      (not-every? valid-category-slug? categories) :invalid-category-slug
      (not-every? valid-category-name? categories) :invalid-category-name
      :else
        (let [non-leaves (reduce conj child-categories (map :categories (filter :categories categories)))]
          (if (empty? non-leaves)
            true
            (recur (first non-leaves) (vec (rest non-leaves))))))))

(defn- 
  ^{:testable true}
  taxonomy-slug-from-path [category-path]
  "Return the taxonomy slug given a category path such as: /taxonomy-slug/category-a/category-b"
  (if (or (nil? category-path) (not (string? category-path)))
    ""
    (let [path-parts (s/split category-path #"/")]
      (if (and (> (count path-parts) 1) (s/blank? (first path-parts)))
        (nth path-parts 1)
        (first path-parts)))))

(defn- 
  ^{:testable true}
  category-slugs-from-path [category-path]
  "Return a sequence of the category slugs given a category path such as: /taxonomy-slug/cat-a/cat-b"
  (if (or (nil? category-path) (not (string? category-path)))
    []
    (let [path-parts (s/split category-path #"/")]
        ;; "" => []
        ;; "tax" => []
        ;; "" "tax" => []
        ;; "" "tax" "cat-a" "cat-b" => ["cat-a" "cat-b"]
        ;; "tax" "cat-a" "cat-b" => ["cat-a" "cat-b"]
      (cond 
        (= (count path-parts) 1) []
        (s/blank? (first path-parts)) (vec (rest (rest path-parts)))
        :else (vec (rest path-parts))))))

(declare hash-category-slugs)

(defn- category-from-map [m]
  "Return the category map with its :categories vector replaced by an ordered map (if it has one)"
  (if-let [categories (:categories m)]
    (assoc m :categories (hash-category-slugs categories))
    m))

(defn- hash-category-slugs
  "Replace all the vectors of maps in the category tree with ordered maps of maps keyed by the category slug"
  [categories]
    ; create an ordered map with the slug as the key and the name and categories as values
    (zip-ordered-map (map :slug categories) (map category-from-map categories)))

(defn- new-categories [slugs category-name]
  ""
  (let [slug (first slugs)
        tail (rest slugs)]
    (if (empty? tail)
      {:slug slug :name category-name}
      {:slug slug :name slug :categories (ordered-map (first tail) (new-categories tail category-name))})))

(declare vectorize-category-slugs)

(defn- categories-vector-from-map [m]
  ""
  (if-let [categories (:categories m)]
    (assoc m :categories (vectorize-category-slugs categories))
    m))

(defn- vectorize-category-slugs
  "Replace all the ordered maps of maps in the category tree with vectors of maps"
  [categories]
  (vec (map categories-vector-from-map (vec (vals categories)))))

(defn- create-categories
  ""
  ([category-name category-slugs categories] 
    (vectorize-category-slugs (create-categories category-name [] category-slugs (hash-category-slugs categories))))
 
  ([category-name category-path category-slugs categories]
    (let [category-slug (first category-slugs)
          category (get-in categories (conj category-path category-slug))
          remaining-path (vec (rest category-slugs))]
      (match [category-slug remaining-path category]<commit_msg>Add some missing doc strings.<commit_after>(ns fcms.resources.taxonomy
  (:require [clojure.core.match :refer (match)]
            [clojure.string :as s]
            [flatland.ordered.map :refer (ordered-map)]
            [fcms.lib.ordered-map :refer (zip-ordered-map)]
            [fcms.resources.common :as common]
            [fcms.resources.collection-resource :as resource]
            [fcms.resources.collection :as collection]
            [fcms.resources.item :as item]))

(def taxonomy-media-type "application/vnd.fcms.taxonomy+json;version=1")

(defn get-taxonomy
  "Given the slug of the collection containing the taxonomy and the slug of the taxonomy,
  return the taxonomy as a map, or return :bad-collection if there's no collection with that slug, or
  nil if there is no taxonomy with that slug."
  [coll-slug slug]
    (resource/get-resource coll-slug slug :taxonomy))

(defn valid-new-taxonomy
  "Given the slug of the collection, the name of the taxonomy, and a map of a potential new taxonomy,
  check if the everything is in order to create the new taxonomy.
  Ensure the collection exists or return :bad-collection.
  Ensure the name of the taxonomy is specified or return :no-name.
  Ensure the slug is valid and doesn't already exist if it's specified,
  or return :invalid-slug or :slug-conflict respectively.
  If a property is included in the map of properties that is in the reserved-properties
  set, :property-conflict will be returned."
  ([coll-slug taxonomy-name] (valid-new-taxonomy coll-slug taxonomy-name {}))
  ([coll-slug taxonomy-name props]
    (resource/valid-new-resource coll-slug taxonomy-name resource/reserved-properties type props)))

(defn create-taxonomy
  "Create a new taxonomy in the collection specified by its slug, using the specified
  taxonomy name and an optional map of properties.
  If :slug is included in the properties it will be used as the taxonomy's slug, otherwise
  the slug will be created from the name.
  If a :slug is included in the properties and an taxonomy already exists
  in the collection with that slug, a :slug-conflict will be returned.
  If a :slug is included in the properties and it's not valid,
  :invalid-slug will be returned.
  If a property is included in the map of properties that is in the reserved-properties
  set, :property-conflict will be returned."
  ([coll-slug taxonomy-name] (create-taxonomy coll-slug taxonomy-name {}))
  ([coll-slug taxonomy-name props]
    (resource/create-resource coll-slug taxonomy-name :taxonomy (resource/allow-category-reserved-properties) (assoc props :categories []))))

(defn delete-taxonomy
  "Given the slug of the collection containing the taxonomy and the slug of the taxonomy,
  delete the taxonomy, or return :bad-collection if there's no collection with that slug, or
  :bad-taxonomy if there is no taxonomy with that slug."
  [coll-slug slug]
  (resource/delete-resource coll-slug slug :taxonomy))

(defn valid-taxonomy-update
  "Given the slug of the collection, the slug of the taxonomy,
  and a map of updated properties for the taxonomy,
  check if the everything is in order to update the taxonomy.
  Ensure the collection exists or return :bad-collection.
  Ensure the item exists or return :bad-taxonomy.
  If a new slug is provided in the properties, ensure it is
  valid or return :invalid-slug and ensure it is unused or
  return :slug-conflict. If no item slug is specified in
  the properties it will be retain its current slug."
  [coll-slug slug props]
  (resource/valid-resource-update coll-slug slug resource/reserved-properties props :taxonomy))

(defn update-taxonomy
  "Update a taxonomy in the collection specified by its slug using the specified
  map of properties. If :slug is included in the properties
  the taxonomy will be moved to the new slug, otherwise the slug will remain the same.
  The same validity conditions and invalid return values as valid-taxonomy-update? apply."
  [coll-slug slug props]
    (let [reason (valid-taxonomy-update coll-slug slug props)]
      (if (true? reason)
        (resource/update-resource coll-slug slug 
          {:reserved resource/reserved-properties
          :retained resource/retained-properties 
          :updated props} :taxonomy)
        reason)))

(defn all-taxonomies
  "Given the slug of the collection, return all the taxonomies it contains as a sequence of maps,
  or return :bad-collection if there's no collection with that slug."
  [coll-slug]
  (resource/all-resources coll-slug :taxonomy))

;; Category functions

(defn- valid-category-slug? [category]
  (common/valid-slug? (:slug category)))

(defn- valid-category-structure? [category]
  (and (contains? :slug) (contains? :name)
    (= 2 (count (dissoc category :categories)))))

(defn- valid-category-name? [category]
  (common/valid-name? (:name category)))

(defn- valid-categories
  "Validate a tree of categories, the following errors may be returned:
  invalid-structure, :invalid-category-name, :invalid-category-slug"
  ([categories] (valid-categories categories []))
  ([categories child-categories]
    ;; Validate a category tree with the following logic:
    ;; is it a vector?
    ;; is everything in it a map (the representation of a category)?
    ;; are categories structured as valid categories?
    ;; are the slugs of the categories valid?
    ;; are the names of the categories valid?
    ;; gather all the categories with children and add the children to the accumulator
    ;; is the accumulator empty? then it's all valid
    ;; otherwise recurse on the first child in the accumulator
    (cond
      (not (vector? categories)) :invalid-structure
      (empty? categories) true
      (not-every? map? categories) :invalid-structure
      (not-every? valid-category-structure? categories) :invalid-structure
      (not-every? valid-category-slug? categories) :invalid-category-slug
      (not-every? valid-category-name? categories) :invalid-category-name
      :else
        (let [non-leaves (reduce conj child-categories (map :categories (filter :categories categories)))]
          (if (empty? non-leaves)
            true
            (recur (first non-leaves) (vec (rest non-leaves))))))))

(defn- 
  ^{:testable true}
  taxonomy-slug-from-path [category-path]
  "Return the taxonomy slug given a category path such as: /taxonomy-slug/category-a/category-b"
  (if (or (nil? category-path) (not (string? category-path)))
    ""
    (let [path-parts (s/split category-path #"/")]
      (if (and (> (count path-parts) 1) (s/blank? (first path-parts)))
        (nth path-parts 1)
        (first path-parts)))))

(defn- 
  ^{:testable true}
  category-slugs-from-path [category-path]
  "Return a sequence of the category slugs given a category path such as: /taxonomy-slug/cat-a/cat-b"
  (if (or (nil? category-path) (not (string? category-path)))
    []
    (let [path-parts (s/split category-path #"/")]
        ;; "" => []
        ;; "tax" => []
        ;; "" "tax" => []
        ;; "" "tax" "cat-a" "cat-b" => ["cat-a" "cat-b"]
        ;; "tax" "cat-a" "cat-b" => ["cat-a" "cat-b"]
      (cond 
        (= (count path-parts) 1) []
        (s/blank? (first path-parts)) (vec (rest (rest path-parts)))
        :else (vec (rest path-parts))))))

(declare hash-category-slugs)

(defn- category-from-map [m]
  "Return the category map with its :categories vector replaced by an ordered map (if it has one)"
  (if-let [categories (:categories m)]
    (assoc m :categories (hash-category-slugs categories))
    m))

(defn- hash-category-slugs
  "Replace all the vectors of maps in the category tree with ordered maps of maps keyed by the category slug"
  [categories]
    ; create an ordered map with the slug as the key and the name and categories as values
    (zip-ordered-map (map :slug categories) (map category-from-map categories)))

(defn- new-categories [slugs category-name]
  "Create the new portion of a category path as an ordered-map (:name, :slug, :categories) of the slugs in
  a vector with each subsequent slug being a child of the prior slug,
  keyed by :categories, and the final slug getting the provided category-name."
  (let [slug (first slugs)
        tail (rest slugs)]
    (if (empty? tail)
      {:slug slug :name category-name}
      {:slug slug :name slug :categories (ordered-map (first tail) (new-categories tail category-name))})))

(declare vectorize-category-slugs)

(defn- categories-vector-from-map [m]
  "Replace the hash map of categories at the :categories key with a vector of categories"
  (if-let [categories (:categories m)]
    (assoc m :categories (vectorize-category-slugs categories))
    m))

(defn- vectorize-category-slugs
  "Replace all the ordered maps of maps in the category tree with vectors of maps"
  [categories]
  (vec (map categories-vector-from-map (vec (vals categories)))))

(defn- create-categories
  "Given a category name, a vector of the slugs of a desired category path,
  and the categories that already exist in the taxonomy, add the portions of the 
  desired category path that don't already exist."
  ([category-name category-slugs categories] 
    (vectorize-category-slugs (create-categories category-name [] category-slugs (hash-category-slugs categories))))
 
  ([category-name category-path category-slugs categories]
    (let [category-slug (first category-slugs)
          category (get-in categories (conj category-path category-slug))
          remaining-path (vec (rest category-slugs))]
      (match [category-slug remaining-path category]
{'fraction_non_alphanumeric': 0.1047562361344083, 'fraction_numerical': 0.0005410962610248363, 'mean_word_length': 3.5056070209653827, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 15, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3807419', 'n_tokens_mistral': 5466, 'n_tokens_neox': 5374, 'n_words': 2093}