#+Title: CL-GENEALOGY
#+Subtitle: A Common Lisp Genealogical Database System
#+AUTHOR: Sam Flint
#+EMAIL: swflint@flintfam.org
#+DATE: \today
#+INFOJS_OPT: view:info toc:nil path:http://flintfam.org/org-info.js
#+OPTIONS: toc:nil H:5 ':t *:t d:nil stat:nil todo:nil
#+PROPERTY: noweb no-export
#+PROPERTY: comments noweb
#+LATEX_HEADER: \parskip=5pt
#+LATEX_HEADER: \lstset{texcl=true,breaklines=true,columns=fullflexible,basicstyle=\ttfamily,frame=lines,literate={lambda}{$\lambda$}{1} {set}{$\gets$}1 {setq}{$\gets$}1 {setf}{$\gets$}1 {<=}{$\leq$}1 {>=}{$\geq$}1}
#+LATEX_CLASS_OPTIONS: [10pt,twoside]
#+LATEX_HEADER: \pagestyle{headings}
#+LATEX_HEADER: \usepackage[margins=0.75in]{geometry}
#+LATEX_HEADER: \parindent=0pt

* COMMENT Export

#+Caption: Export the Document
#+Name: export-document
#+BEGIN_SRC emacs-lisp :exports none :results none
  (save-buffer)
  (let ((org-confirm-babel-evaluate
         (lambda (lang body)
           (declare (ignore lang body))
           nil)))
    (org-latex-export-to-pdf)
    (org-latex-export-to-pdf))
#+END_SRC

* COMMENT Tangle

#+Caption: Tangle This Document
#+Name: tangle-document
#+BEGIN_SRC emacs-lisp :exports none :results none
  (save-buffer)
  (let ((org-babel-tangle-comment-format-beg "%file [[%link][%source-name]]")
        (org-babel-tangle-comment-format-end "End %file [[%link][%source-name]]"))
    (org-babel-tangle))
#+END_SRC

* DONE Introduction                                                   :nonum:
CLOSED: [2016-03-06 Sun 13:53]
:PROPERTIES:
:CREATED:  <2016-01-06 Wed 13:13>
:END:

Genealogy in general is a fairly interesting subject, and can, in the study of history be important.  While there are many libraries and even applications to deal with genealogical data, there has yet to be an adequate genealogy library for Lisp.  The goal is to build a library upon which to build a genealogical research application, and also to possibly integrate into a later application for the management of museum collections and meta-data.

This library is designed from the perspective of a Computer Scientist, rather than that of a genealogist, and as such is not meant to be used directly, but instead is meant to be the basis of a much better genealogy application.

* TOC                                                         :ignoreheading:
:PROPERTIES:
:CREATED:  <2016-01-06 Wed 13:13>
:END:

#+TOC: headlines 3
#+TOC: listings

* Data Storage
:PROPERTIES:
:CREATED:  <2016-01-06 Wed 13:14>
:END:

One of the key components of genealogical software is the ability to effectively store information related to members of a family.  This will include things such as people, birth records, death records, marriage records, divorce records and notes.

To accomplish the storage of this information, I'm using a schema-less relational database management system called LambdaLite, which is written entirely in lisp, and uses the local file system to store data effectively.

** Macros
:PROPERTIES:
:CREATED:  <2016-01-06 Wed 13:16>
:END:

To accomplish the goal of storing data within the database system that is LambdaLite, I need to be able to constrain various attributes to be certain values.  To do this, instead of having to manually write code to constrain them each time, I use a few macros to do this.  These macros include:

 - constrain-values :: Constrains to be one of several values.
      This macro takes one or more arguments, and generates a function that checks to see if the argument passed to it is in any of the given values.
 - in-table-column :: Checks to see if the value is one of the values in a specific column.
      This macro takes two arguments, a table name and a column name, then generates a function which will calculate all possible values, iterating for each row in the table, getting the values in the specified column, and then testing the value passed to the function to see if it is a member of the possible values.
 - ids-in-table-column :: Checks to see if this is one of the possible IDs in a table column.
      This is done through the same mechanism as ~in-table-column~, but simply ensuring that the passed object is a) a list, and b) the elements in the list are mapped through the ~in-table-column~ result, with the values of a and be being reduced using ~and~ to produce a single boolean.
 - unique-in-column :: This checks to see whether or not the passed value is within the specified column, ensuring that it is not within it.
      This function takes three things, a table, a column and a type.  It first ensures that the passed object is of the specified type, and if it is, calculates all values currently in the specified table and column, and then checks to see that the passed object is /not/ within the list.

#+Caption: Data Storage Macros
#+Name: data-storage-macros
#+BEGIN_SRC lisp
  (defmacro constrain-values (&rest values)
    `(lambda (object)
       (the boolean
            (member object (list ,@values)))))

  (defmacro in-table-column (table column)
    `(lambda (object)
       (let ((possible-values (iter
                                (for row in (select ,table))
                                (collect (,column row)))))
         (the boolean (member object possible-values)))))

  (defmacro ids-in-table-column (table column)
    `(lambda (object)
       (let ((possible-values (iter
                                (for row in (select ,table))
                                (collect (,column row)))))
         (and (listp object)
            (reduce #'and (map 'list ,(in-table-column table column)
                             object))))))

  (defmacro unique-in-column (table column type)
    `(lambda (object)
       (if (typep object ',type)
           (let ((possible-values (iter
                                    (for row in (select ,table))
                                    (collect (,column row)))))
             (not (the boolean (member object possible-values)))))))

  (defun generate-table-id (table)
    (check-type table keyword)
    (1+ (length (select table))))
#+END_SRC

** People
:PROPERTIES:
:CREATED:  <2016-01-06 Wed 13:17>
:END:

This is the People table, used to store the most bare information about a person.  This includes the following:

 - ID :: The ID used to identify the person within the database.
 - Name :: The name of the person.
 - Gender :: The gender of the person.  Can be one of:
   - M
   - F
   - T
 - Father :: The person's father.  This is either an person ID, or 0 if we don't know who the father is.
 - Mother :: The person's mother.  As with father, this can be either a person ID or 0.

#+Caption: Person Table
#+Name: person-table
#+BEGIN_SRC lisp
  (defattributes
    :/person-id (unique-in-column :people :/person-id integer)
    :/person-name #'stringp
    :/gender (constrain-values "M" "F" "T")
    :/father (lambda (object)
               (or (= 0 object)
                  (funcall (in-table-column :people :/person-id) object)))
    :/mother (lambda (object)
               (or (= 0 object)
                  (funcall (in-table-column :people :/person-id) object))))
#+END_SRC

** Births
:PROPERTIES:
:CREATED:  <2016-01-06 Wed 13:17>
:END:

Another important thing is to be able to log births, or possible birth dates.  To do this, you need four pieces of information:

 - Birth ID :: The ID used to reference the person's birth.
 - Person :: The ID of the person born.
 - Birth Date :: When the person was born.
 - Birth Location :: Where the person was born.

#+Caption: Births Table
#+Name: births-table
#+BEGIN_SRC lisp
  (defattributes
    :/birth-id (unique-in-column :births :/birth-id integer)
    :/birth-person (in-table-column :people :/person-id)
    :/birth-date #'stringp
    :/birth-location #'stringp)
#+END_SRC

** Deaths
:PROPERTIES:
:CREATED:  <2016-01-06 Wed 13:17>
:END:

Furthermore, to be as complete as possible, you need to be able to store and query death information.  This includes things such as:

 - Death ID :: The ID used to track this death record.
 - Person :: The ID of the person who died.
 - Date :: When the person died.
 - Location :: Where the person died.

#+Caption: Deaths Table
#+Name: deaths-table
#+BEGIN_SRC lisp
  (defattributes
    :/death-id (unique-in-column :deaths :/death-id integer)
    :/death-person (in-table-column :people :/person-id)
    :/death-date #'stringp
    :/death-location #'stringp)
#+END_SRC

** Marriages
:PROPERTIES:
:CREATED:  <2016-01-06 Wed 13:17>
:END:

Further, to be able to keep track of relationships (and thus families), you need to be able to track marriages.  This entails keeping track of the following information:

 - Marriage ID :: ID used to track the marriage within this system.
 - Husband :: ID of the husband in the marriage.
 - Wife :: ID of the wife in the marriage.
 - Wedding Date :: Date the marriage was considered to have started.
 - End Date :: Date the marriage ended (Divorce, death, annulment).

#+Caption: Marriage Table
#+Name: marriage-table
#+BEGIN_SRC lisp
  (defattributes
    :/marriage-id (unique-in-column :marriages :/marriage-id integer)
    :/husband (in-table-column :people :/person-id)
    :/wife (in-table-column :people :/person-id)
    :/wedding-date #'stringp
    :/end-date #'stringp)
#+END_SRC

** Divorces
:PROPERTIES:
:CREATED:  <2016-01-06 Wed 13:17>
:END:

To keep track of the dissolution of marriages, and to enable correct report generation, we must keep track of divorces.  To do this, we store the following information:

 - Divorce ID :: How the divorce is referred to within the database.
 - Marriage :: The ID of the marriage the divorce terminates
 - Divorce Date :: The date the Divorce is effective.

#+Caption: Divorce Table
#+Name: divorce-table
#+BEGIN_SRC lisp
  (defattributes
    :/divorce-id (unique-in-column :divorces :/divorce-id integer)
    :/marriage (in-table-column :marriages :/marriage-id)
    :/divorce-date #'stringp)
#+END_SRC

** Notes
:PROPERTIES:
:CREATED:  <2016-01-06 Wed 13:17>
:END:

Keeping notes within the database is a good idea, it allows the notes to be linked directly to the relevant data, and can help to keep organized.  To store a note, you need the following pieces of data:

 - Note ID :: The ID used to reference the note.
 - Title :: The title of the note.
 - Text :: The text of the note, formatted using markdown.
 - Media Link :: An optional link to a media file, such as an image or oral history.

#+Caption: Notes Table
#+Name: notes-table
#+BEGIN_SRC lisp
  (defattributes
      :/note-id (unique-in-column :notes :/note-id integer)
    :/note-title #'stringp
    :/note-text #'stringp
    :/media-link #'stringp)
#+END_SRC

** Common Attributes
:PROPERTIES:
:CREATED:  <2016-01-06 Wed 13:18>
:END:

As LambdaLite is schemaless, the following attributes can be mixed in to other tables, and can be used to help link records quickly and easily.

 - Person :: The ID of a relevant Person.
 - Birth :: The ID of a relevant Birth.
 - Death :: The ID of a relevant Death.
 - Marriage :: The ID of a relevant Marriage.
 - Divorce :: The ID of a relevant Divorce.

#+Caption: Common Table Attributes
#+Name: common-table-attributes
#+BEGIN_SRC lisp
  (defattributes
      :/person (in-table-column :people :/person-id)
    :/birth (in-table-column :births :/birth-id)
    :/death (in-table-column :deaths :/death-id)
    :/marriage (in-table-column :marriages :/marriage-id)
    :/divorce (in-table-column :divorces :/divorce-id))
#+END_SRC

* TODO Database Archive
:PROPERTIES:
:CREATED:  <2016-03-06 Sun 13:25>
:END:

* WORKING Data Interface [0/10]
:PROPERTIES:
:CREATED:  <2016-01-06 Wed 13:15>
:END:

** TODO Create Person
:PROPERTIES:
:CREATED:  <2016-01-06 Wed 13:18>
:END:

** TODO Create Birth
:PROPERTIES:
:CREATED:  <2016-01-06 Wed 13:19>
:END:

** TODO Create Death
:PROPERTIES:
:CREATED:  <2016-01-06 Wed 13:19>
:END:

** TODO Create Marriages
:PROPERTIES:
:CREATED:  <2016-01-06 Wed 13:19>
:END:

** TODO Create Divorce
:PROPERTIES:
:CREATED:  <2016-01-06 Wed 13:19>
:END:

** TODO Get Person
:PROPERTIES:
:CREATED:  <2016-01-06 Wed 13:19>
:END:

** TODO Get Birth
:PROPERTIES:
:CREATED:  <2016-01-06 Wed 13:19>
:END:

** TODO Get Death
:PROPERTIES:
:CREATED:  <2016-01-06 Wed 13:19>
:END:

** TODO Get Mariage
:PROPERTIES:
:CREATED:  <2016-01-06 Wed 13:20>
:END:

** TODO Get Divorce
:PROPERTIES:
:CREATED:  <2016-01-06 Wed 13:20>
:END:

* WORKING Family Tree Display [0/5]
:PROPERTIES:
:CREATED:  <2016-01-06 Wed 13:14>
:END:

** TODO Generate Person Nodes
:PROPERTIES:
:CREATED:  <2016-01-06 Wed 14:38>
:END:

** TODO Generate Marriage Nodes
:PROPERTIES:
:CREATED:  <2016-01-06 Wed 14:38>
:END:

** TODO Generate Edges Between People
:PROPERTIES:
:CREATED:  <2016-01-06 Wed 14:38>
:END:

** TODO Generate Edges Between Marriages
:PROPERTIES:
:CREATED:  <2016-01-06 Wed 14:38>
:END:

** TODO Generate Final Family Tree
:PROPERTIES:
:CREATED:  <2016-01-06 Wed 14:39>
:END:

* WORKING Ahnentafel Generation [0/3]
:PROPERTIES:
:CREATED:  <2016-01-06 Wed 13:14>
:END:

** TODO Numbering
:PROPERTIES:
:CREATED:  <2016-01-06 Wed 14:35>
:END:

#+Caption: Ahnentafel Numbering
#+Name: ahnentafel-numbering
#+BEGIN_SRC lisp
  (defun generate-ahnentafel-numbers (starting-person number-of-generations)
    (let ((ahnentafel-list (cons (cons 1 starting-person) nil)))
      (labels ((generate-number (current gender)
                 (if (string= gender "M")
                     (* 2 current)
                     (1+ (* 2 current))))
               (recurse (person number generation gender)
                 (if (not (= generation 0))
                     (let ((new-number (generate-number number gender))
                           (father (:/father person))
                           (mother (:/mother person)))
                       (push (cons new-number person) ahnentafel-list)
                       (if (not (= 0 father))
                           (recurse father new-number (1- generation) "M"))
                       (if (not (= 0 mother))
                           (recurse mother new-number (1- generation) "F"))))))
        (recurse (:/father starting-person) 1 (1- number-of-generations) "M")
        (recurse (:/mother starting-person) 1 (1- number-of-generations) "F"))
      ahnentafel-list))
#+END_SRC

** TODO Formatting
:PROPERTIES:
:CREATED:  <2016-01-06 Wed 14:35>
:END:

#+Caption: Format Ahnentafel Record
#+Name: format-ahnentafel-record
#+BEGIN_SRC lisp
  (defun format-ahnentafel-record (record)
    (destructuring-bind (number . person) record
      (let ((name (:/person-name (get-person person)))
            (birthdate (:/birth-date (get-birth person)))
            (death (let ((death-record (get-death person)))
                     (if (null death-record)
                         ""
                         (format nil " -- ~a" (:/death-date death-record))))))
        (format nil "~10,5R: ~A, ~A~A" number name birthdate death)))))
#+END_SRC

** TODO Final Output
:PROPERTIES:
:CREATED:  <2016-01-06 Wed 14:35>
:END:

#+Caption: Output Ahnentafel
#+Name: output-ahnentafel
#+BEGIN_SRC lisp
  (defun output-ahnentafel (file start-person total-generations)
    (let ((ahnentafel-text (map 'list
                             #'format-ahnentafel-record
                             (sort (generate-ahnentafel-numbers
                                    start-person
                                    total-generations)
                                   #'<
                                   :key #'car))))
      (with-open-file (output file
                              :direction :output
                              :if-exists :output
                              :if-does-not-exist :create)
        (map 'list #'(lambda (line)
                       (format output "~A~&" line))
             ahnentafel-text))))
#+END_SRC

* WORKING GEDCOM Handling [0/5]
:PROPERTIES:
:CREATED:  <2016-01-06 Wed 13:15>
:END:

** TODO Grammar
:PROPERTIES:
:CREATED:  <2016-01-06 Wed 14:39>
:END:

** TODO Parser
:PROPERTIES:
:CREATED:  <2016-01-06 Wed 14:40>
:END:

** TODO Cross-Reference Resolver
:PROPERTIES:
:CREATED:  <2016-01-06 Wed 14:41>
:END:

** TODO Convert To Native Format
:PROPERTIES:
:CREATED:  <2016-01-06 Wed 14:41>
:END:

** TODO Export to GEDCOM
:PROPERTIES:
:CREATED:  <2016-01-06 Wed 14:42>
:END:

* TODO Consanguinity Calculation
:PROPERTIES:
:CREATED:  <2016-03-06 Sun 13:29>
:END:

* TODO Configuration File Parsing
:PROPERTIES:
:CREATED:  <2016-03-04 Fri 21:00>
:END:

* WORKING Packaging [0/6]
:PROPERTIES:
:CREATED:  <2016-01-06 Wed 13:15>
:END:

#+Caption: Package File
#+Name: package-file
#+BEGIN_SRC lisp :tangle "package.lisp"
  (defpackage #:config-parser
    (:use :esrap
          :cl)
    (:import-from #:parse-number
                  #:parse-number)
    (:export open-configuration-file))

  (defpackage #:cl-genealogy
    (:use #:cl
          #:lambdalite
          #:iterate
          #:archive)
    (:export generate-graph
             print-ahnentafel
             database
             new-person
             new-death
             new-marriage
             new-divorce))
#+END_SRC

** TODO Data Storage
:PROPERTIES:
:CREATED:  <2016-01-06 Wed 14:13>
:END:

** TODO Data Interface
:PROPERTIES:
:CREATED:  <2016-01-06 Wed 14:14>
:END:

** TODO Family Tree
:PROPERTIES:
:CREATED:  <2016-01-06 Wed 14:14>
:END:

** TODO Ahnentafel
:PROPERTIES:
:CREATED:  <2016-01-06 Wed 14:14>
:END:

#+Caption: Put together Ahnentafel
#+Name: ahnentafel-final
#+BEGIN_SRC lisp :tangle "ahnentafel.lisp"
  (in-package #:cl-genealogy)

  <<ahnentafel-numbering>>
  <<format-ahnentafel-record>>
  <<output-ahnentafel>>
#+END_SRC

** TODO Gedcom Parsing
:PROPERTIES:
:CREATED:  <2016-01-06 Wed 14:14>
:END:

** TODO ASDF
:PROPERTIES:
:CREATED:  <2016-01-06 Wed 14:14>
:END:

#+Caption: ASDF Packaging
#+Name: asdf-packaging
#+BEGIN_SRC lisp :tangle "cl-genealogy.asd"
  (asdf:defsystem #:cl-genealogy
    :description "Describe genie here"
    :author "Samuel Flint <swflint@lisp.technology>"
    :license "GNU GPLv3 or Later"
    :depends-on (#:cl-utilities
                 #:esrap
                 #:parse-number
                 #:lambdalite
                 #:iterate
                 #:archive)
    :serial t
    :components ((:file "package")
                 (:file "database")
                 (:file "family-tree")
                 (:file "ahnentafel")))
#+END_SRC

* Push To Bottom                                              :ignoreheading:
:PROPERTIES:
:CREATED:  <2016-01-08 Fri 12:48>
:END:

#+LATEX: \vfill

* Version Information                                                 :nonum:
:PROPERTIES:
:CREATED:  <2016-01-08 Fri 12:49>
:END:

This document, and the code, forming the ~cl-genealogy~ package is version src_sh{git describe --always --long --dirty --abbrev=10 --tags}