Journal Portage de TapTempo en Clojure (v2)

Salut à tous. Voici une 2ème version en Clojure de TapTempo.
Je ne mets pas de référence vers le premier jet tellement il était à côté de la plaque (la version en Forth était beaucoup trop simpliste aussi). Désolé pour le bruit.

Dans celle-ci, nous avons :

• Le lissage avec une vraie moyenne sur sample-size.

• la gestion des arguments en ligne de commande avec validation des entrées :

  • nombre de samples
  • précision de l'affichage
  • reset après un certain temps
  • version
  • usage

• L'internationalisation avec la fonction _ qui est un raccourci de la fonction gettext. Je n'ai fais que l'anglais et le français.

Les traductions se trouve dans une table de hachage dans le répertoire translations.

• Des tests unitaires (pour la validation et la non régression en cas de changement).

Techniquement, la définition des arguments est faite via une table de hachage cli-options avec comme clés :default, :parse-fn et :validate et la fonction parse-opts.

Le calcul de la moyenne du tempo utilise des fonctions d'ordre supérieur (reduce, map, partition…).

Comme particularité, on peut trouver de la compréhension de liste (destructuring bind) sur des tableaux ou des tables de hachages :

(defn print-tempo [[tempo cnt] prec] ...)
ou
(defn do-loop [{:keys [precision sample-size reset-time] :as options}] ...)

Je mets ici la version complète en un seul fichier mais vous pouvez trouver une version mieux organisée sur github.

(ns taptempo.core
  (:require [clojure.tools.cli :refer [parse-opts]]
            [clojure.string :as str]
            [gettext.core :refer [_]]
            [trptcolin.versioneer.core :as version])
  (:import jline.console.ConsoleReader)
  (:gen-class))


(defn now []
  (System/currentTimeMillis))

(defn read-char []
  (->> (ConsoleReader.) (.readCharacter) char))

(defn parse-int [x]
  (Integer/parseInt x))

(def cli-options
  [["-p", "--precision PREC" (_ "change the number of decimal for the tempo. The default is 0 decimal places, the max is 5 decimals")
    :default 0
    :parse-fn parse-int
    :validate [#(<= 0 % 5) (_ "Must be a number between 0 and 5")]]
   ["-r", "--reset-time T" (_ "change the time in seconds to reset the calculation. The default is 5 seconds")
    :default 5
    :parse-fn parse-int
    :validate [pos? (_ "Must be a positive number")]]
   ["-s", "--sample-size N" (_ "change the number of samples needed to calculate the tempo. The default is 5 samples")
    :default 5
    :parse-fn parse-int
    :validate [#(<= 2 %) (_ "Must be a number greater than 1")]]
   ["-v", "--version" (_ "print the version number")]
   ["-h", "--help"]])

(defn calc-tempo
  "Compute tempo in bpm from samples"
  [samples]
  (let [cnt (count samples)]
    [(when (> cnt 1)
       (* 60 1000 (/ (dec cnt)
                     (reduce +
                             (map (fn [[end start]] (- end start))
                                  (partition 2 1 samples))))))
     cnt]))

(defn print-tempo [[tempo cnt] prec]
  (println (format (str "Tempo: %." prec "f bpm (%d " (_ "samples") ")") (float (or tempo 0)) cnt)))

(defn compute-next
  "Append now to samples. Keep at most sample-size.
   Reset samples if more than reset-time has elapsed since last call"
  [now samples {:keys [sample-size reset-time]}]
  (if (< (- now (first samples)) (* 1000 reset-time))
    (conj (take (dec sample-size) samples) now)
    [now]))

(defn do-loop [{:keys [precision sample-size reset-time] :as options}]
  (println (_ "Press the enter key in cadence (q to quit)"))
  (loop [samples [(now)]]
    (when-not (= (read-char) \q)
      (print-tempo (calc-tempo samples) precision)
      (recur (compute-next (now) samples options))))
  (println (_ "Bye!")))

(defn usage [options-summary]
  (->> ["Usage: TapTempo [options]"
        ""
        "Options:"
        options-summary]
       (str/join \newline)))

(defn version []
  (version/get-version "taptempo" "taptempo"))

(defn error-msg [errors]
  (str (_ "The following errors occurred while parsing your command") ":\n\n"
       (str/join \newline errors)))

(defn validate-args [args]
  (let [{:keys [options arguments errors summary]} (parse-opts args cli-options)]
    (cond
      (:help options)    {:exit-message (usage summary) :ok? true}
      (:version options) {:exit-message (version) :ok? true}
      errors             {:exit-message (error-msg errors)}
      :else              {:options options})))

(defn exit [status msg]
  (println msg)
  (System/exit status))

(defn -main [& args]
  (let [{:keys [options exit-message ok?]} (validate-args args)]
    (if exit-message
      (exit (if ok? 0 1) exit-message)
      (do-loop options))))