family-tree 0.1.1 → 0.1.2

raw patch · 2 files changed

+88/−40 lines, 2 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• family-tree.cabal +2/−4
• src/Data/FamilyTree.hs +86/−36

@@ -1,5 +1,5 @@ name:           family-tree-version:        0.1.1+version:        0.1.2 cabal-version:  >= 1.2 build-type:     Simple author:         Nathan "Taneb" van Doorn@@ -7,9 +7,7 @@ stability:      Unstable synopsis:       Family trees with lenses -description:    This is a module which contains a data type for family trees.-                .-                It also includes appropriate lenses!+description:    This is a module for the manipulation of family trees. category:       Genealogy, Data copyright:      (c) 2012 Nathan "Taneb" van Doorn license:        BSD3

@@ -4,50 +4,61 @@ Portability :  portable  This module is for Family Trees.-It's got lenses, which are pretty cool.-I would use "Data.Binary" to do saving and loading. -Better description coming soon!+It uses lenses for the manipulation of people. For the usage of lenses, see+"Data.Lens.Lazy"++It is reccomended to use "Data.Binary" to do saving and loading.++ -} module Data.FamilyTree- (Person(..)- ,Family(..)- ,Event(..)- ,Location(..)- ,Relationship(..)- ,FamilyTree(..)- ,ID- ,newTree- ,personLens- ,familyLens- ,eventLens- ,addPerson- ,addFamily- ,addEvent- ,deletePerson- ,deleteFamily- ,deleteEvent+ (-- * Main types+ Person(..),+ Family(..),+ Event(..),+ FamilyTree(..),+ -- * Other types+ Location(..),+ Relationship(..),+ ID(..),+ -- * Creation+ newTree,+ addPerson,+ addFamily,+ addEvent,+ -- * Manipulation+ personLens,+ familyLens,+ eventLens,+ -- * Destruction+ deletePerson,+ deleteFamily,+ deleteEvent ) where -import Control.Applicative-import Control.Arrow-import Control.Monad+import Control.Applicative ((<$>))+import Control.Arrow ((***))+import Control.Monad (join) -import Data.Binary-import Data.Function+import Data.Binary (Binary, get, put, Word8, getWord8)+import Data.Function (on) import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HM-import Data.Lens.Common-import Data.Maybe+import Data.Lens.Common (Lens, lens)+import Data.Maybe (listToMaybe) import Data.IntMap (IntMap) import qualified Data.IntMap as IM import Data.IntSet (IntSet) import qualified Data.IntSet as IS import Data.Text (Text) import qualified Data.Text as T-import Data.Text.Encoding+import Data.Text.Encoding (encodeUtf8, decodeUtf8) import Data.Time (Day(..)) +-- | The basic type for a person. 'Nothing' meaning unknown (or otherwise +-- non-existent, for intance a death date for someone still alive) is a+-- convention used throughout this library. data Person = Person   {name :: Maybe Text   ,birthdate :: Maybe Day@@ -58,6 +69,8 @@   ,attendedEvents :: IntSet   } deriving (Eq, Show) +-- | The basic type for a family. Which person is head1 and which is head2 is+-- arbitrary, but try to use a consistent rule data Family = Family   {head1 :: Maybe Int   ,head2 :: Maybe Int@@ -67,16 +80,28 @@   ,children :: IntSet   } deriving (Eq, Show)   +-- | The basic type for an event. For example:+--+-- @+--   Event {+--     eventInfo = \"Battle of Agincourt\"+--     eventDate = fromGregorianValid 1415 10 25+--     eventAttendees = IM.empty+--         }+-- @ data Event = Event    {eventInfo :: Text   ,eventDate :: Maybe Day   ,eventAttendees :: IntSet   } deriving (Eq, Show)-  ++-- | The Location type. Either a coordinate or a placename.   data Location = Coord Double Double | PlaceName Text deriving (Eq, Show) +-- | The Relationship type. Marriage is the default for similarity to GEDCOM. data Relationship = Marriage | Other Text deriving (Eq, Show) +-- | The core structure of a family tree. data FamilyTree = FamilyTree   {treeName :: Text   ,people :: IntMap Person@@ -196,8 +221,15 @@       ,events = e       } +-- | ID represents an identifier for a person, family, or event. While the+-- constructor is exported, it is probably better to use the various+-- lenses for manipulation, as they echo the changes around the tree. newtype ID = ID Int +-- | Constructs a lens for the manipulation of a person in a family tree, from+-- that person's ID. Using an ID that does not correspond to a person is an+-- error, and it is impossible to create or destroy people using a lens created+-- by this.  personLens :: ID -> Lens FamilyTree Person personLens (ID n) = lens ((IM.! n) . people) $   \person familyTree ->@@ -216,14 +248,22 @@              {eventAttendees = IS.insert i (eventAttendees event)}) i)           (events familyTree) newattended) oldattended       }-      ++-- | Constructs a lens for the manipulation of a family in a family tree, from+-- that family's ID. Using an ID that does not correspond to a family is an+-- error, and it is impossible to create or destroy families using a lens+-- created by this.        familyLens :: ID -> Lens FamilyTree Family familyLens (ID n) = lens ((IM.! n) . families) $   \family' familyTree ->     familyTree       {families = IM.insert n family' (families familyTree)       }-      ++-- | Constructs a lens for the manipulation of an event in a family tree, from+-- that event's ID. Using an ID that does not correspond to an event is an+-- error, and it is impossible to create or destroy events using a lens created+-- by this.        eventLens :: ID -> Lens FamilyTree Event eventLens (ID n) = lens ((IM.! n) . events) $   \event familyTree ->@@ -274,7 +314,9 @@   ,eventDate = Nothing   ,eventAttendees = IS.empty   }-  ++-- | Adds a person with minimal information, returning the updated family tree+-- and the ID of the new person.   addPerson :: FamilyTree -> (FamilyTree, ID) addPerson familyTree =   let n = maybe 0 fst $@@ -283,7 +325,9 @@           zip [1 ..] $ IM.keys $ people familyTree   in (familyTree        {people = IM.insert n blankPerson $ people familyTree}, ID n)-  ++-- | Adds a family with minimal information, returning the updated family tree+-- and the ID of the new family.   addFamily :: FamilyTree -> (FamilyTree, ID) addFamily familyTree =   let n = maybe 0 fst $@@ -293,6 +337,8 @@   in (familyTree         {families = IM.insert n blankFamily $ families familyTree}, ID n) +-- | Adds an event with minimal information, returning the updated family tree+-- and the ID of the new event. addEvent :: FamilyTree -> (FamilyTree, ID) addEvent familyTree =   let n = maybe 0 fst $@@ -300,7 +346,8 @@           dropWhile (uncurry (==)) $           zip [1 ..] $ IM.keys $ events familyTree   in (familyTree {events = IM.insert n blankEvent $ events familyTree}, ID n)-  ++-- | Deletes a person from the family tree, removing all references to them.   deletePerson :: ID -> FamilyTree -> FamilyTree deletePerson (ID n) familyTree =   familyTree @@ -319,12 +366,14 @@         )       (events familyTree)     }-    ++-- | Deletes a family from the family tree, removing all references to it.     deleteFamily :: ID -> FamilyTree -> FamilyTree deleteFamily (ID n) familyTree =   familyTree     {families = IM.delete n $ families familyTree} +-- | Deletes an event from the family tree, removing all references to it. deleteEvent :: ID -> FamilyTree -> FamilyTree deleteEvent (ID n) familyTree =   let relevantPeople = eventAttendees (events familyTree IM.! n)@@ -334,7 +383,8 @@          (\p -> p {attendedEvents = IS.delete n $ attendedEvents p}))          (people familyTree) relevantPeople        }           -       ++-- | Creates a new tree with a given name.        newTree :: Text -> FamilyTree newTree n = FamilyTree   {treeName = n