Permalink
Browse files

Initial commit with license, readme, and tests.

  • Loading branch information...
0 parents commit ccfb860160fd4405b3795ff279ab061a94e53ace Sean Grove committed Nov 13, 2010
Showing with 301 additions and 0 deletions.
  1. +20 −0 LICENSE
  2. +72 −0 README.md
  3. +129 −0 inflector.lisp
  4. +45 −0 tests/inflector.lisp
  5. +35 −0 utils.lisp
20 LICENSE
@@ -0,0 +1,20 @@
+Copyright (c) 2010 Sean Grove, http://trapm.com/
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
@@ -0,0 +1,72 @@
+Vana Inflector
+========
+
+A common lisp library to easily pluralize and singularize English words.
+
+This is a support package for the [Vana web framework][1], and is a port of the same from Rails' ActiveSupport module.
+
+
+Installation
+------------------
+
+(ql:quickload 'vana-inflector)
+
+Usage
+-----------
+Basic Usage:
+
+ (use-package :vana-inflector)
+ > (pluralize "octopus")
+ "octopi"
+ > (pluralize "datum")
+ "data"
+ > (singularize "children")
+ "child"
+ > (singularize "cats")
+ "cat"
+ > (singularize "data")
+ "datum"
+
+Use `irregular` to add an irregular:
+
+ > (singularize "feet")
+ "feet"
+ > (irregular "foot" "feet")
+ > (singularize "feet")
+ "foot"
+ > (pluralize "foot")
+ "feet"
+
+Use `uncountable` to add an uncountable:
+
+ > (pluralize "advice")
+ "advices"
+ > (singularize "advice")
+ "advice"
+ > (singularize "advices")
+ "advice"
+ > (uncountable "advice")
+ > (pluralize "advice")
+ "advice"
+
+TODO
+-------
+ * Expand the default lookup lists? Possible (but probably negligible) performance tradeoff for completeness
+ * Add methods to transfer between CamelCase, whatJavaScriptDoes, and_this_underscore_style
+
+License
+---------------
+
+Released under the MIT license, please see `LICENSE` for more details
+
+Thanks
+-------------
+
+ - [Xach][2] - For [quicklisp][3], really made getting back into CL much easier.
+ - Siebel - For [PCL][4], which has been a great reference.
+
+
+ [1]: https://github.com/sgrove/vana
+ [2]: http://xach.livejournal.com/
+ [3]: http://www.quicklisp.org/
+ [4]: http://gigamonkeys.com/book/
@@ -0,0 +1,129 @@
+(defpackage :vana-inflector
+ (:use :cl
+ :cl-ppcre
+ :vana-utils)
+ (:export :pluralize
+ :plural
+ :singularize
+ :singular
+ :irregular?
+ :irregular
+ :uncountable?
+ :uncountable))
+
+(in-package :vana-inflector)
+
+;; Adapted *cough*ripped*cough* from rails inflector.rb
+;;; singular->plurals regular expressions
+(defvar plurals
+ (reverse (list (list "$" "s")
+ (list "s$" "s")
+ (list "(ax|test)is$" "\\1es")
+ (list "(octop|vir)us$" "\\1i")
+ (list "(alias|status)$" "\\1es")
+ (list "(bu)s$" "\\1ses")
+ (list "(buffal|tomat)o$" "\\1oes")
+ (list "([ti])um$" "\\1a")
+ (list "sis$" "ses")
+ (list "(?:([^f])fe|([lr])f)$" "\\1\2ves")
+ (list "(hive)$" "\\1s")
+ (list "([^aeiouy]|qu)y$" "\\1ies")
+ (list "(x|ch|ss|sh)$" "\\1es")
+ (list "(matr|vert|ind)(?:ix|ex)$" "\\1ices")
+ (list "([m|l])ouse$" "\\1ice")
+ (list "^(ox)$" "\\1en")
+ (list "(quiz)$" "\\1zes"))))
+
+;;; plurals->singular regular expressions
+(defvar singulars
+ (reverse (list
+ (list "s$" "")
+ (list "(n)ews$" "\\1ews")
+ (list "([ti])a$" "\\1um")
+ (list "((a)naly|(b)a|(d)iagno|(p)arenthe|(p)rogno|(s)ynop|(t)he)ses$" "\\1\\2sis")
+ (list "(^analy)ses$" "\\1sis")
+ (list "([^f])ves$" "\\1fe")
+ (list "(hive)s$" "\\1")
+ (list "(tive)s$" "\\1")
+ (list "([lr])ves$" "\\1f")
+ (list "([^aeiouy]|qu)ies$" "\\1y")
+ (list "(s)eries$" "\\1eries")
+ (list "(m)ovies$" "\\1ovie")
+ (list "(x|ch|ss|sh)es$" "\\1")
+ (list "([m|l])ice$" "\\1ouse")
+ (list "(bus)es$" "\\1")
+ (list "(o)es$" "\\1")
+ (list "(shoe)s$" "\\1")
+ (list "(cris|ax|test)es$" "\\1is")
+ (list "(octop|vir)i$" "\\1us")
+ (list "(alias|status)es$" "\\1")
+ (list "^(ox)en" "\\1")
+ (list "(vert|ind)ices$" "\\1ex")
+ (list "(matr)ices$" "\\1ix")
+ (list "(quiz)zes$" "\\1")
+ (list "(database)s$" "\\1"))))
+
+(defvar uncountables
+ (list "equipment" "information" "rice" "money" "species" "series" "fish" "sheep" "jeans"))
+
+(defvar irregulars
+ (args->alist
+ "person" "people"
+ "man" "men"
+ "child" "children"
+ "sex" "sexes"
+ "move" "moves"
+ "cow" "kine"))
+
+;; Interface for adding new uncountables, querying, etc.
+(defun uncountable (word)
+ "Notifies the inflector that a word is uncountable"
+ (setf uncountables (cons word uncountables)))
+
+(defun uncountable? (word)
+ (member word uncountables :test #'string-equal))
+
+(defun irregular (singular plural)
+ "Adds a irregular single-plural set to the irregular list"
+ (setf irregulars (acons singular plural irregulars)))
+
+(defun irregular? (word)
+ (or (-> word irregulars)
+ (rassoc word irregulars :test #'string-equal)))
+
+;; For a touch of added robustness
+(defun irregular-plural? (word)
+ (rassoc word irregulars :test #'string-equal))
+
+(defun irregular-singular? (word)
+ (-> word irregulars))
+
+;; These two could be combined nicely, I'm sure
+(defun get-irregular-singular (plural)
+ (if (irregular-singular? plural)
+ plural
+ (car (rassoc plural irregulars :test #'string-equal))))
+
+(defun get-irregular-plural (singular)
+ (if (irregular-plural? singular)
+ singular
+ (-> singular irregulars)))
+
+(defun pluralize (word)
+ "Returns the plural of a word if it's singular, or itself if already plural"
+ (cond ((uncountable? word) word)
+ ((irregular? word) (get-irregular-plural word))
+ (t (inflector-helper word plurals))))
+
+(defun singularize (word)
+ "Returns the singular of a word if it's singular, or itself if already singular"
+ (cond ((uncountable? word) word)
+ ((irregular? word) (get-irregular-singular word))
+ (t (inflector-helper word singulars))))
+
+(defun inflector-helper (word regexes)
+ (multiple-value-bind (string match-found?)
+ (cl-ppcre:regex-replace (first (first regexes)) word (second (first regexes)))
+ (if match-found?
+ string
+ (inflector-helper word (rest regexes)))))
@@ -0,0 +1,45 @@
+(defpackage :vana-inflector-test
+ (:use :cl
+ :vana-inflector
+ :lisp-unit))
+
+(in-package :vana-inflector-test)
+
+(define-test test-pluralize-regular
+ (assert-equal "quizzes" (pluralize "quiz"))
+ (assert-equal "oxen" (pluralize "ox"))
+ (assert-equal "matrices" (pluralize "matrix"))
+ (assert-equal "vertices" (pluralize "vertex"))
+ (assert-equal "indices" (pluralize "index"))
+ (assert-equal "hives" (pluralize "hive"))
+ (assert-equal "tomatoes" (pluralize "tomato"))
+ (assert-equal "crises" (pluralize "crisis")))
+
+(define-test test-pluralize-irregular
+ (assert-equal "people" (pluralize "person"))
+ (assert-equal "men" (pluralize "man"))
+ (assert-equal "sexes" (pluralize "sex"))
+ (assert-equal "kine" (pluralize "cow")))
+
+(define-test test-add-irregular
+ (assert-equal "womans" (pluralize "woman"))
+ (irregular "woman" "women")
+ (assert-equal "women" (pluralize "woman")))
+
+(define-test test-uncountable
+ (assert-equal "fish" (pluralize "fish"))
+ (assert-equal "fish" (singularize "fish"))
+ (assert-equal "sheep" (pluralize "sheep"))
+ (assert-equal "sheep" (singularize "sheep")))
+
+(define-test test-add-uncountable
+ (assert-equal "cackles" (pluralize "cackle"))
+ (uncountable "cackle")
+ (assert-equal "cackle" (pluralize "cackle")))
+
+(define-test test-singularize
+ (assert-equal "cup" (singularize "cups"))
+ (assert-equal "ox" (singularize "oxen"))
+ (assert-equal "life" (singularize "lives")))
+
+;;(run-tests)
@@ -0,0 +1,35 @@
+(defpackage :vana-utils
+ (:use :common-lisp)
+ (:export :args->alist
+ :list->string
+ :defalias
+ :->
+ :zero?))
+
+(in-package :vana-utils)
+
+;; I like pretty function names :P
+(defmacro defalias (old new)
+ `(defun ,new (&rest args)
+ (apply #',old args)))
+
+(defalias zerop zero?)
+
+;; Convenience function
+(defun list->string (list &optional separator)
+ "A bit of a hacky way to turn a list into a string via reduce"
+ (if list
+ (reduce #'(lambda (str1 str2) (concatenate 'string str1 str2 separator)) list)
+ ""))
+
+(defun args->alist (&rest args)
+ "Takes an even number of arguments and returns an associative list consisting of (ARG1 . ARG2) (ARG3 . ARG4), etc."
+ (if (null args)
+ nil
+ (acons (first args)
+ (second args)
+ (apply #'args->alist (rest (rest args))))))
+
+(defun -> (key list &optional (test 'string-equal))
+ "Returns value associated with KEY from the associatie list ALIST. Optionally uses :TEST for key equality."
+ (cdr (assoc key list :test test)))

0 comments on commit ccfb860

Please sign in to comment.