bbdb 0.3 → 0.4
raw patch · 3 files changed
+573/−565 lines, 3 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Database.BBDB: parseBBDB :: String -> Either ParseError [BBDBFile]
Files
- Database/BBDB.hs +0/−563
- bbdb.cabal +3/−2
- src/Database/BBDB.hs +570/−0
− Database/BBDB.hs
@@ -1,563 +0,0 @@-{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}---- | --- This module can read and write BBDB files, and provides a few handy--- functions for getting at fields inside of BBDB data.--- --- BBDB (<http://bbdb.sourceforge.net/>) is short for the Insidious Big--- Brother Database, which is a contact management utility that can--- be integrated into Emacs (the one true editor.) Since bbdb.el is--- implemented in elisp, it can be difficult to \"get at\" the data--- inside a .bbdb file with external programs. Many years ago, I--- wrote a BBDB interface for perl, but having experience--- enlightenment at the hands of the category gods, I\`m now dabbling--- with Haskell. But having been a loyal Emacs user for many years--- now, I wanted a way to spam my friends while still using my--- favorite programming language. Hence the module Data.BBDB.--- --- The following is the data layout for a BBDB record. I have created a--- sample record with my own data. Each field is just separated by a--- space. I have added comments to the right--- --- > ["Henry" The first name - a string--- > "Laxen" The last name - a string--- > ("Henry, Enrique") Also Known As - comma separated list--- > "Elegant Solutions" Business name - a string--- > (--- > ["reno" 775 624 1851 0] Phone number field - US style--- > ["chapala" "011-52-376-765-3181"] Phone number field - International style--- > ) --- > (--- > ["mailing" The address location, then a list--- > ("10580 N. McCarran Blvd." "#115-396") for the street address, then one each--- > "Reno" "Nevada" "89503" "USA" for City, State, Zip Code, and country--- > ] --- > ["home" another Address field--- > ("Via Alta #6" "Gaviotas #10") The street list--- > "Chapala" "Jalisco" City State--- > "45900" "Mexico" Zip and country--- > ]) --- > (--- > "nadine.and.henry@pobox.com" the net addresses - a list of strings--- > "nadinelaxen@pobox.com"--- > ) --- > (--- > (notes . "Always split aces and eights") The notes field - a list of alists--- > (creation-date . "2010-09-03") --- > (timestamp . "2010-09-03")--- > (birthday . "6/15")--- > ) --- > nil The cache vector - always nil--- > ]--- --- Inside the .bbdb file, this looks like:--- \[\"Henry\" \"Laxen\" (\"Henry, Enrique\") \"Elegant Solutions\" --- (\[\"reno\" 775 624 1851 0] \[\"chapala\" \"011-52-376-765-3181\"]) --- (\[\"mailing\" (\"10580 N. McCarran Blvd.\" --- \"#115-396\") \"Reno\" \"Nevada\" \"89503\" \"USA\"] --- \[\"home\" (\"Via Alta #6\" \"Gaviotas #10\") --- \"Chapala\" \"Jalisco\" \"45900\" \"Mexico\"]) --- (\"nadine.and.henry\@pobox.com\" \"nadinelaxen\@pobox.com\") --- ((notes . \"Always split aces and eights\") --- (creation-date . \"2010-09-03\") --- (timestamp . \"2010-09-03\") (birthday . \"6/15\")) nil]------ When parsed, this is represented inside Haskell as:--- --- > BBDBEntry--- > (BBDB{firstName = Just "Henry", lastName = Just "Laxen",--- > aka = Just ["Henry, Enrique"], company = Just "Elegant Solutions",--- > phone =--- > Just--- > [USStyle "reno" ["775", "624", "1851", "0"],--- > InternationalStyle "chapala" "011-52-376-765-3181"],--- > address =--- > Just--- > [Address{location = "mailing",--- > streets =--- > Just ["10580 N. McCarran Blvd.", "#115-396"],--- > city = Just "Reno", state = Just "Nevada",--- > zipcode = Just "89503", country = Just "USA"},--- > Address{location = "home",--- > streets = Just ["Via Alta #6", "Gaviotas #10"],--- > city = Just "Chapala", state = Just "Jalisco",--- > zipcode = Just "45900", country = Just "Mexico"}],--- > net = Just ["nadine.and.henry@pobox.com", "nadinelaxen@pobox.com"],--- > notes =--- > Just--- > (Note{unnote =--- > [("notes", "Always split aces and eights"),--- > ("creation-date", "2010-09-03"),--- > ("timestamp", "2010-09-03"),--- > ("birthday", "6/15")]})})]--- > --module Database.BBDB - (- Location,- Street,- Symbol,- Address(..), - Alist(..), - Note(..), - Phone(..), - BBDB(..), - BBDBFile(..),- LispAble(..),- bbdbDefault,- key,value,- bbdbFileParse,- justEntry,- justEntries,- readBBDB,- wantNote,- getNote,- mapBBDB,- filterBBDB- ) where---import Text.Parsec.Char-import Text.Parsec.String (Parser) -- type Parser = Parsec String ()-import Data.Char -- (chr)-import Control.Monad.Identity hiding (join)-import Text.Parsec hiding ((<|>))-import Control.Applicative hiding (many)-import Data.Maybe-import Data.List--doubleQuoteChar = '"'--betweenParens :: Parser a -> Parser a-betweenParens = between (char '(') (char ')')--quotedString :: Parser String ---quotedString :: (Stream s m Char) => ParsecT s u Identity String -> ParsecT s u Identity String-quotedString = - between (char doubleQuoteChar) (char doubleQuoteChar) $- many quotedChar--quotedChar :: Parser Char -quotedChar =- noneOf "\\\"" <|>- try (string "\\\"" >> return '"') <|>- noneOf "\""---- | A Location is just a synonym for String. Each BBDB Address and--- Phone field must be associated with a location, such as /home/ or--- /work/-type Location = String--- | A Street is also a synonym for String. Each Address may have a--- list of Streets associated with it.-type Street = String--- | A Symbol is just a String, but Lisp only wants--- alphanumerics and the characters _ (underscore) and - (dash)-type Symbol = String---- | For some unknow reason, BBDB can have phones in two different--- formats. In /USStyle/, the phone is list of integers, in the form--- of Area code, Prefix, Number, and Extension. I don\'t bother to--- convert the strings of digits to actual integers. In--- /InternationalStyle/, the phone number is just a String.-data Phone =- USStyle Location [String] - |- InternationalStyle Location String- deriving (Eq, Ord, Show)--- | An Address must have a location, and may have associated streets,--- a city, a state, a zipcode, and an country.-data Address = Address {- location :: Location,- streets :: Maybe [String],- city :: Maybe String,- state :: Maybe String,- zipcode :: Maybe String,- country :: Maybe String- }- deriving (Eq, Ord, Show)---- | An Alist is an Association List. Lisp writes these as (key--- . value) We convert these to a tuple in haskell where fst is key--- and snd is value. -type Alist = (Symbol,String)---- | Given an Alist, return the key-key :: (x,y) -> x-key (x,y) = x--- | Given an Alist, return the value-value :: (x,y) -> y-value (x,y) = y---- | The Note field of a BBDB record is just a list of associations.--- If you don\'t provide a your own key, the BBDB will use the word \"note\"--data Note = Note {- unnote :: [Alist]- }- deriving (Eq, Ord, Show)--data BBDB = BBDB {--- | the first name. Why is this a Maybe? Because sometimes you just--- have a company, and not a specific first name-- firstName :: Maybe String,- lastName :: Maybe String,--- | aka = Also Known As. Sometimes the same email address can match--- several users, so BBDB gives you the option of remembering--- different names for the same address- aka :: Maybe [String],--- | The company if any - company :: Maybe String,--- | A list of phone numbers, either in US Style or International Style- phone :: Maybe [Phone],--- | A list of addresses, keyed by location- address :: Maybe [Address],--- | A list of email addresses. --- BBDB uses the first element of this field when you create a new email- net :: Maybe [String],--- | Any number of key, value pairs. Great for random data.- notes :: Maybe Note- } - deriving (Eq, Ord, Show)--bbdbDefault = BBDB Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing---- | At the beginning of a BBDB file are a variable number of comments, which--- specify the encoding type and the version. We just ignore them.--- Comments starts with a \; (semi-colon) and continue to end of line-data BBDBFile = - BBDBComment String - | - BBDBEntry BBDB- deriving (Eq, Ord, Show)---- | return Nothing if parsing the string \"nil\"-nil :: Parser (Maybe a)-nil = string "nil" >> return Nothing--strings = betweenParens (sepBy quotedString space)- --stringOrNil :: Parser (Maybe String)-stringOrNil = - nil <|> Just <$> quotedString <?> "nil or string"---stringsOrNil :: Parser (Maybe [String])-stringsOrNil = - nil <|> Just <$> strings- --listOfInts :: Parser [String]-listOfInts = sepBy1 (many1 digit) space--phoneParser :: Parser Phone-phoneParser = do- char '[' - phoneType <- quotedString- spaces- n <- singlePhone phoneType- char ']' - return n- where - singlePhone phoneType = do- n <- listOfInts- return $ USStyle phoneType n- <|> do- n <- quotedString- return $ InternationalStyle phoneType n--phonesParser :: Parser (Maybe [Phone])-phonesParser = - try nil- <|> Just <$> betweenParens (sepBy phoneParser space)---singleAddress :: Parser Address-singleAddress = do- char '['- location <- quotedString- space- streets <- stringsOrNil- space- city <- stringOrNil- space- state <- stringOrNil- space- zip <- stringOrNil- space- country <- stringOrNil- char ']'- return $ Address location streets city state zip country----addressesParser :: Parser (Maybe [Address])-addressesParser = - nil- <|> Just <$> betweenParens (sepBy singleAddress space)-- -lispSymbol :: Parser Symbol-lispSymbol = many1 (alphaNum <|> oneOf "-_")----alist :: Parser Alist-alist = betweenParens $- (,) <$> lispSymbol <*> (string " . " *> quotedString)---notesParser :: Parser (Maybe Note)-notesParser = - nil- <|> Just <$> betweenParens (Note <$> sepBy alist space)--bbdbEntry :: Parser BBDB -bbdbEntry = do- char '['- firstName <- stringOrNil- space- lastName <- stringOrNil- space- aka <- stringsOrNil- space- company <- stringOrNil- space- phoneS <- phonesParser- space- addresseS <- addressesParser- space- net <- stringsOrNil- space- noteS <- notesParser- space- string "nil"- char ']'- return $ BBDB firstName lastName aka company phoneS addresseS net noteS--{--bEntry :: Parser BBDB -bEntry = BBDB <$>- stringOrNil <*> stringOrNil <*> stringsOrNil <*> stringOrNil <*>- phonesParser <*> addressesParser <*> stringsOrNil <*> (notesParser <*- string "nil]")--}----- | The Parser for a BBDB file, as it is written on disk. If you--- read a .bbdb file with:--- --- > testParse :: FilePath -> IO (Either ParseError [BBDBFile])--- > testParse filename = do--- > b <- readFile filename--- > return $ parse bbdbFileParse "bbdb" b--- --- You will get IO (Right [BBDBFile]) if the parse went ok--- -bbdbFileParse :: Parser [BBDBFile]-bbdbFileParse = do- comments <- many commentLine- entries <- many (bbdbEntry <* newline)- eof- return $ map BBDBComment comments ++ map BBDBEntry entries- where- commentLine = (:) <$> char ';' <*> (many (noneOf "\n\r") <* newline)---- | converts a BBDB comment to nothing, and a BBDB entry to just the entry-justEntry :: BBDBFile -> Maybe BBDB-justEntry (BBDBComment _) = Nothing-justEntry (BBDBEntry x) = Just x---- | returns a list of only the actual bbdb entries, removing the comments-justEntries :: [BBDBFile] -> [BBDB]-justEntries = mapMaybe justEntry--join :: [a] -> [[a]] -> [a]-join delim l = concat (intersperse delim l)---- | surround a string with the given two characters -surroundWith :: a -> a -> [a] -> [a]-surroundWith before after string = before : string ++ [after]---- | convert a Haskell string to a string that Lisp likes-escapeLisp [] = []-escapeLisp (c:cs) = - case c of- '"' -> '\\' : '"' : escapeLisp cs--- '\\' -> '\\' : '\\' : escapeLisp cs- otherwise -> c : escapeLisp cs- -- let x = if isAscii c then [c] else '\\' : c : []- -- in x ++ escapeLisp cs---- | LispAble is how we convert from our internal representation of a--- BBDB record, to one that will make Lisp and Emacs happy. (Sans bugs)--- --- > testInverse = do--- > let inFile = "/home/henry/.bbdb"--- > actualBBDBFile <- readFile inFile--- > parsedBBDBdata <- readBBDB inFile--- > let bbdbDataOut = asLisp parsedBBDBdata--- > print $ actualBBDBFile == bbdbDataOut--- > --- --- should print True-class LispAble s where- asLisp :: s -> String--instance LispAble String where- asLisp = escapeLisp --instance LispAble (Maybe String) where- asLisp Nothing = "nil"- asLisp (Just x) = surroundWith '"' '"' . escapeLisp $ x--instance LispAble (Maybe [String]) where- asLisp Nothing = "nil"- asLisp (Just x) = surroundWith '(' ')' . join " " .- map (surroundWith '"' '"' . asLisp) $ x--instance LispAble Phone where- asLisp (USStyle location numbers) =- surroundWith '[' ']' $ surroundWith '"' '"' location ++ " " ++ - join " " numbers- asLisp (InternationalStyle location numbers) = - surroundWith '[' ']' $ surroundWith '"' '"' location ++ " " ++ - surroundWith '"' '"' numbers--instance LispAble (Maybe [Phone]) where- asLisp Nothing = "nil"- asLisp (Just x) = surroundWith '(' ')' . join " " . map asLisp $ x--instance LispAble Address where- asLisp x = surroundWith '[' ']' $ join " " - [asLisp $ Just (location x),- asLisp (streets x),- asLisp (city x),- asLisp (state x),- asLisp (zipcode x),- asLisp (country x)]--instance LispAble (Maybe [Address]) where- asLisp Nothing = "nil"- asLisp (Just x) = surroundWith '(' ')' . join " " .- map asLisp $ x--instance LispAble Alist where- asLisp x = surroundWith '(' ')' $- key x ++ " . " ++ asLisp (Just (value x))--instance LispAble Note where- asLisp (Note x) = surroundWith '(' ')' . join " " .- map asLisp $ x- -instance LispAble (Maybe Note) where- asLisp Nothing = "nil"- asLisp (Just x) = surroundWith '(' ')' . join " " . - map asLisp $ unnote x- -instance LispAble BBDB where- asLisp x = surroundWith '[' ']' $ join " " - [asLisp (firstName x),- asLisp (lastName x),- asLisp (aka x),- asLisp (company x),- asLisp (phone x),- asLisp (address x),- asLisp (net x),- asLisp (notes x),- "nil"- ]--instance LispAble BBDBFile where- asLisp (BBDBComment x) = x- asLisp (BBDBEntry x) = asLisp x---- | the inverse of bbdbFileParse-instance LispAble [BBDBFile] where- asLisp = unlines . map asLisp---- | read the given file and call error if the parse failed,--- otherwise return the entire file as a list of BBDBFile records.-readBBDB :: String -> IO [BBDBFile]-readBBDB filename = do- b <- readFile filename- let ls = parse bbdbFileParse "bbdb" b- return . either (error . show) id $ ls---- | Notes inside a BBDB record are awkward to get at. This helper--- function digs into the record and applies a function to each--- Alist element of the record. It returns true if it any of the--- Alists in the note return true. For example:--- --- > hasBirthday :: BBDB -> Bool--- > hasBirthday = wantNote (\x -> key x == "birthday")--- --- will return True for any BBDB record that has a \"birthday\" key--- in it\'s notes field-wantNote :: (Alist -> Bool) -> BBDB -> Bool-wantNote cond bbdb = maybe False alistTest (notes bbdb)- where- alistTest = any id . map cond . unnote---- | Lookup the value whose key is the given string. If found returns --- Just the value, otherwise Nothing For example:------ > getBirthday :: BBDB -> Maybe String--- > getBirthday = getNote "birthday"----getNote :: String -> BBDB -> Maybe String-getNote k b = lookup k (maybe [] unnote (notes b))---- | This and filterBBDB are the main functions you should use to--- manipulate a set of BBDB entries. You supply a function that--- applies a transformation on a BBDB record, and this function will--- apply that transformation to every BBDBEntry in a BBDB file.--- Sample usage:--- --- > starCompanies = do--- > b <- readBBDB "/home/henry/.bbdb"--- > writeFile "/home/henry/.bbdb-new" $ asLisp . mapBBDB starCompany $ b--- > where--- > starCompany x = case (company x) of--- > Nothing -> x--- > Just y -> x { company = Just ("*" ++ y) }--- --- Prepend a star (\"*\") to each company --- field of a BBDB file and write the result--- out as a new bbdb file.-mapBBDB :: (BBDB -> BBDB) -> [BBDBFile] -> [BBDBFile]-mapBBDB f bbdbf = map g bbdbf- where- g (BBDBComment x) = BBDBComment x- g (BBDBEntry x) = BBDBEntry (f x)---- | Just like mapBBDB except it filters. You supply a function that--- takes a BBDB record to a Bool, and filterBBDB will return a new--- list of BBDBFile that satisfy that condition. Sample usage:--- --- > import Text.Regex.Posix--- > -- do regex matching while ignoring case, so "reno" matches "Reno"--- > matches x = match (makeRegexOpts compIgnoreCase defaultExecOpt x :: Regex)--- --- > getReno = do--- > b <- readBBDB "/home/henry/.bbdb"--- > let c = justEntries . filterBBDB hasReno $ b--- > mapM_ print $ map (\a -> (firstName a, lastName a, address a)) c--- > where--- > isReno :: Maybe String -> Bool--- > isReno = maybe False (matches "reno")--- > anyAddressHasReno :: [Address] -> Bool--- > anyAddressHasReno = any id . map (isReno . city)--- > hasReno :: BBDB -> Bool--- > hasReno = maybe False anyAddressHasReno . address--- --- print the name and all addresses of anyone in the BBDB file--- who live in Reno. -filterBBDB :: (BBDB -> Bool) -> [BBDBFile] -> [BBDBFile]-filterBBDB f bbdbf = filter g bbdbf- where- g (BBDBComment x) = True- g (BBDBEntry x) = f x --
bbdb.cabal view
@@ -7,7 +7,7 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented.-Version: 0.3+Version: 0.4 -- A short (one-line) description of the package. Synopsis: Ability to read, write, and examine BBDB files@@ -21,7 +21,7 @@ See the hackage docs for usage and examples. -- URL for the project homepage or repository.-Homepage: http://maztravel.com/haskell/database-bbdb.html+Homepage: http://www.nadineloveshenry.com/haskell/database-bbdb.html -- The license under which the package is released. License: GPL-3@@ -54,6 +54,7 @@ Library -- Modules exported by the library. Exposed-modules: Database.BBDB+ hs-source-dirs: src -- Packages needed in order to build this package. Build-depends:
+ src/Database/BBDB.hs view
@@ -0,0 +1,570 @@+{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, PackageImports #-}++-- | +-- This module can read and write BBDB files, and provides a few handy+-- functions for getting at fields inside of BBDB data.+-- +-- BBDB (<http://bbdb.sourceforge.net/>) is short for the Insidious Big+-- Brother Database, which is a contact management utility that can+-- be integrated into Emacs (the one true editor.) Since bbdb.el is+-- implemented in elisp, it can be difficult to \"get at\" the data+-- inside a .bbdb file with external programs. Many years ago, I+-- wrote a BBDB interface for perl, but having experience+-- enlightenment at the hands of the category gods, I\`m now dabbling+-- with Haskell. But having been a loyal Emacs user for many years+-- now, I wanted a way to spam my friends while still using my+-- favorite programming language. Hence the module Data.BBDB.+-- +-- The following is the data layout for a BBDB record. I have created a+-- sample record with my own data. Each field is just separated by a+-- space. I have added comments to the right+-- +-- > ["Henry" The first name - a string+-- > "Laxen" The last name - a string+-- > ("Henry, Enrique") Also Known As - comma separated list+-- > "Elegant Solutions" Business name - a string+-- > (+-- > ["reno" 775 624 1851 0] Phone number field - US style+-- > ["chapala" "011-52-376-765-3181"] Phone number field - International style+-- > ) +-- > (+-- > ["mailing" The address location, then a list+-- > ("10580 N. McCarran Blvd." "#115-396") for the street address, then one each+-- > "Reno" "Nevada" "89503" "USA" for City, State, Zip Code, and country+-- > ] +-- > ["home" another Address field+-- > ("Via Alta #6" "Gaviotas #10") The street list+-- > "Chapala" "Jalisco" City State+-- > "45900" "Mexico" Zip and country+-- > ]) +-- > (+-- > "nadine.and.henry@pobox.com" the net addresses - a list of strings+-- > "nadinelaxen@pobox.com"+-- > ) +-- > (+-- > (notes . "Always split aces and eights") The notes field - a list of alists+-- > (creation-date . "2010-09-03") +-- > (timestamp . "2010-09-03")+-- > (birthday . "6/15")+-- > ) +-- > nil The cache vector - always nil+-- > ]+-- +-- Inside the .bbdb file, this looks like:+-- \[\"Henry\" \"Laxen\" (\"Henry, Enrique\") \"Elegant Solutions\" +-- (\[\"reno\" 775 624 1851 0] \[\"chapala\" \"011-52-376-765-3181\"]) +-- (\[\"mailing\" (\"10580 N. McCarran Blvd.\" +-- \"#115-396\") \"Reno\" \"Nevada\" \"89503\" \"USA\"] +-- \[\"home\" (\"Via Alta #6\" \"Gaviotas #10\") +-- \"Chapala\" \"Jalisco\" \"45900\" \"Mexico\"]) +-- (\"nadine.and.henry\@pobox.com\" \"nadinelaxen\@pobox.com\") +-- ((notes . \"Always split aces and eights\") +-- (creation-date . \"2010-09-03\") +-- (timestamp . \"2010-09-03\") (birthday . \"6/15\")) nil]+--+-- When parsed, this is represented inside Haskell as:+-- +-- > BBDBEntry+-- > (BBDB{firstName = Just "Henry", lastName = Just "Laxen",+-- > aka = Just ["Henry, Enrique"], company = Just "Elegant Solutions",+-- > phone =+-- > Just+-- > [USStyle "reno" ["775", "624", "1851", "0"],+-- > InternationalStyle "chapala" "011-52-376-765-3181"],+-- > address =+-- > Just+-- > [Address{location = "mailing",+-- > streets =+-- > Just ["10580 N. McCarran Blvd.", "#115-396"],+-- > city = Just "Reno", state = Just "Nevada",+-- > zipcode = Just "89503", country = Just "USA"},+-- > Address{location = "home",+-- > streets = Just ["Via Alta #6", "Gaviotas #10"],+-- > city = Just "Chapala", state = Just "Jalisco",+-- > zipcode = Just "45900", country = Just "Mexico"}],+-- > net = Just ["nadine.and.henry@pobox.com", "nadinelaxen@pobox.com"],+-- > notes =+-- > Just+-- > (Note{unnote =+-- > [("notes", "Always split aces and eights"),+-- > ("creation-date", "2010-09-03"),+-- > ("timestamp", "2010-09-03"),+-- > ("birthday", "6/15")]})})]+-- > ++module Database.BBDB + (+ Location,+ Street,+ Symbol,+ Address(..), + Alist(..), + Note(..), + Phone(..), + BBDB(..), + BBDBFile(..),+ LispAble(..),+ bbdbDefault,+ key,value,+ parseBBDB,+ bbdbFileParse,+ justEntry,+ justEntries,+ readBBDB,+ wantNote,+ getNote,+ mapBBDB,+ filterBBDB+ ) where+++import Text.Parsec.Char+import Text.Parsec.String (Parser) -- type Parser = Parsec String ()+import Data.Char -- (chr)+import "mtl" Control.Monad.Identity hiding (join)+import Text.Parsec hiding ((<|>))+import Control.Applicative hiding (many)+import Data.Maybe+import Data.List++doubleQuoteChar = '"'++betweenParens :: Parser a -> Parser a+betweenParens = between (char '(') (char ')')++quotedString :: Parser String +--quotedString :: (Stream s m Char) => ParsecT s u Identity String -> ParsecT s u Identity String+quotedString = + between (char doubleQuoteChar) (char doubleQuoteChar) $+ many quotedChar++quotedChar :: Parser Char +quotedChar =+ noneOf "\\\"" <|>+ try (string "\\\"" >> return '"') <|>+ noneOf "\""++-- | A Location is just a synonym for String. Each BBDB Address and+-- Phone field must be associated with a location, such as /home/ or+-- /work/+type Location = String+-- | A Street is also a synonym for String. Each Address may have a+-- list of Streets associated with it.+type Street = String+-- | A Symbol is just a String, but Lisp only wants+-- alphanumerics and the characters _ (underscore) and - (dash)+type Symbol = String++-- | For some unknow reason, BBDB can have phones in two different+-- formats. In /USStyle/, the phone is list of integers, in the form+-- of Area code, Prefix, Number, and Extension. I don\'t bother to+-- convert the strings of digits to actual integers. In+-- /InternationalStyle/, the phone number is just a String.+data Phone =+ USStyle Location [String] + |+ InternationalStyle Location String+ deriving (Eq, Ord, Show)+-- | An Address must have a location, and may have associated streets,+-- a city, a state, a zipcode, and an country.+data Address = Address {+ location :: Location,+ streets :: Maybe [String],+ city :: Maybe String,+ state :: Maybe String,+ zipcode :: Maybe String,+ country :: Maybe String+ }+ deriving (Eq, Ord, Show)++-- | An Alist is an Association List. Lisp writes these as (key+-- . value) We convert these to a tuple in haskell where fst is key+-- and snd is value. +type Alist = (Symbol,String)++-- | Given an Alist, return the key+key :: (x,y) -> x+key (x,y) = x+-- | Given an Alist, return the value+value :: (x,y) -> y+value (x,y) = y++-- | The Note field of a BBDB record is just a list of associations.+-- If you don\'t provide a your own key, the BBDB will use the word \"note\"++data Note = Note {+ unnote :: [Alist]+ }+ deriving (Eq, Ord, Show)++data BBDB = BBDB {+-- | the first name. Why is this a Maybe? Because sometimes you just+-- have a company, and not a specific first name++ firstName :: Maybe String,+ lastName :: Maybe String,+-- | aka = Also Known As. Sometimes the same email address can match+-- several users, so BBDB gives you the option of remembering+-- different names for the same address+ aka :: Maybe [String],+-- | The company if any + company :: Maybe String,+-- | A list of phone numbers, either in US Style or International Style+ phone :: Maybe [Phone],+-- | A list of addresses, keyed by location+ address :: Maybe [Address],+-- | A list of email addresses. +-- BBDB uses the first element of this field when you create a new email+ net :: Maybe [String],+-- | Any number of key, value pairs. Great for random data.+ notes :: Maybe Note+ } + deriving (Eq, Ord, Show)++bbdbDefault = BBDB Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing++-- | At the beginning of a BBDB file are a variable number of comments, which+-- specify the encoding type and the version. We just ignore them.+-- Comments starts with a \; (semi-colon) and continue to end of line+data BBDBFile = + BBDBComment String + | + BBDBEntry BBDB+ deriving (Eq, Ord, Show)++-- | return Nothing if parsing the string \"nil\"+nil :: Parser (Maybe a)+nil = string "nil" >> return Nothing++strings = betweenParens (sepBy quotedString space)+ ++stringOrNil :: Parser (Maybe String)+stringOrNil = + nil <|> Just <$> quotedString <?> "nil or string"+++stringsOrNil :: Parser (Maybe [String])+stringsOrNil = + nil <|> Just <$> strings+ ++listOfInts :: Parser [String]+listOfInts = sepBy1 (many1 digit) space++phoneParser :: Parser Phone+phoneParser = do+ char '[' + phoneType <- quotedString+ spaces+ n <- singlePhone phoneType+ char ']' + return n+ where + singlePhone phoneType = do+ n <- listOfInts+ return $ USStyle phoneType n+ <|> do+ n <- quotedString+ return $ InternationalStyle phoneType n++phonesParser :: Parser (Maybe [Phone])+phonesParser = + try nil+ <|> Just <$> betweenParens (sepBy phoneParser space)+++singleAddress :: Parser Address+singleAddress = do+ char '['+ location <- quotedString+ space+ streets <- stringsOrNil+ space+ city <- stringOrNil+ space+ state <- stringOrNil+ space+ zip <- stringOrNil+ space+ country <- stringOrNil+ char ']'+ return $ Address location streets city state zip country++++addressesParser :: Parser (Maybe [Address])+addressesParser = + nil+ <|> Just <$> betweenParens (sepBy singleAddress space)++ +lispSymbol :: Parser Symbol+lispSymbol = many1 (alphaNum <|> oneOf "-_")++++alist :: Parser Alist+alist = betweenParens $+ (,) <$> lispSymbol <*> (string " . " *> quotedString)+++notesParser :: Parser (Maybe Note)+notesParser = + nil+ <|> Just <$> betweenParens (Note <$> sepBy alist space)++bbdbEntry :: Parser BBDB +bbdbEntry = do+ char '['+ firstName <- stringOrNil+ space+ lastName <- stringOrNil+ space+ aka <- stringsOrNil+ space+ company <- stringOrNil+ space+ phoneS <- phonesParser+ space+ addresseS <- addressesParser+ space+ net <- stringsOrNil+ space+ noteS <- notesParser+ space+ string "nil"+ char ']'+ return $ BBDB firstName lastName aka company phoneS addresseS net noteS++{-+bEntry :: Parser BBDB +bEntry = BBDB <$>+ stringOrNil <*> stringOrNil <*> stringsOrNil <*> stringOrNil <*>+ phonesParser <*> addressesParser <*> stringsOrNil <*> (notesParser <*+ string "nil]")+-}+++-- | The Parser for a BBDB file, as it is written on disk. If you+-- read a .bbdb file with:+-- +-- > testParse :: FilePath -> IO (Either ParseError [BBDBFile])+-- > testParse filename = do+-- > b <- readFile filename+-- > return $ parse bbdbFileParse "bbdb" b+-- +-- You will get IO (Right [BBDBFile]) if the parse went ok+-- +bbdbFileParse :: Parser [BBDBFile]+bbdbFileParse = do+ comments <- many commentLine+ entries <- many (bbdbEntry <* newline)+ eof+ return $ map BBDBComment comments ++ map BBDBEntry entries+ where+ commentLine = (:) <$> char ';' <*> (many (noneOf "\n\r") <* newline)++-- | converts a BBDB comment to nothing, and a BBDB entry to just the entry+justEntry :: BBDBFile -> Maybe BBDB+justEntry (BBDBComment _) = Nothing+justEntry (BBDBEntry x) = Just x++-- | returns a list of only the actual bbdb entries, removing the comments+justEntries :: [BBDBFile] -> [BBDB]+justEntries = mapMaybe justEntry++join :: [a] -> [[a]] -> [a]+join delim l = concat (intersperse delim l)++-- | surround a string with the given two characters +surroundWith :: a -> a -> [a] -> [a]+surroundWith before after string = before : string ++ [after]++-- | convert a Haskell string to a string that Lisp likes+escapeLisp [] = []+escapeLisp (c:cs) = + case c of+ '"' -> '\\' : '"' : escapeLisp cs+-- '\\' -> '\\' : '\\' : escapeLisp cs+ otherwise -> c : escapeLisp cs+ -- let x = if isAscii c then [c] else '\\' : c : []+ -- in x ++ escapeLisp cs++-- | LispAble is how we convert from our internal representation of a+-- BBDB record, to one that will make Lisp and Emacs happy. (Sans bugs)+-- +-- > testInverse = do+-- > let inFile = "/home/henry/.bbdb"+-- > actualBBDBFile <- readFile inFile+-- > parsedBBDBdata <- readBBDB inFile+-- > let bbdbDataOut = asLisp parsedBBDBdata+-- > print $ actualBBDBFile == bbdbDataOut+-- > +-- +-- should print True+class LispAble s where+ asLisp :: s -> String++instance LispAble String where+ asLisp = escapeLisp ++instance LispAble (Maybe String) where+ asLisp Nothing = "nil"+ asLisp (Just x) = surroundWith '"' '"' . escapeLisp $ x++instance LispAble (Maybe [String]) where+ asLisp Nothing = "nil"+ asLisp (Just x) = surroundWith '(' ')' . join " " .+ map (surroundWith '"' '"' . asLisp) $ x++instance LispAble Phone where+ asLisp (USStyle location numbers) =+ surroundWith '[' ']' $ surroundWith '"' '"' location ++ " " ++ + join " " numbers+ asLisp (InternationalStyle location numbers) = + surroundWith '[' ']' $ surroundWith '"' '"' location ++ " " ++ + surroundWith '"' '"' numbers++instance LispAble (Maybe [Phone]) where+ asLisp Nothing = "nil"+ asLisp (Just x) = surroundWith '(' ')' . join " " . map asLisp $ x++instance LispAble Address where+ asLisp x = surroundWith '[' ']' $ join " " + [asLisp $ Just (location x),+ asLisp (streets x),+ asLisp (city x),+ asLisp (state x),+ asLisp (zipcode x),+ asLisp (country x)]++instance LispAble (Maybe [Address]) where+ asLisp Nothing = "nil"+ asLisp (Just x) = surroundWith '(' ')' . join " " .+ map asLisp $ x++instance LispAble Alist where+ asLisp x = surroundWith '(' ')' $+ key x ++ " . " ++ asLisp (Just (value x))++instance LispAble Note where+ asLisp (Note x) = surroundWith '(' ')' . join " " .+ map asLisp $ x+ +instance LispAble (Maybe Note) where+ asLisp Nothing = "nil"+ asLisp (Just x) = surroundWith '(' ')' . join " " . + map asLisp $ unnote x+ +instance LispAble BBDB where+ asLisp x = surroundWith '[' ']' $ join " " + [asLisp (firstName x),+ asLisp (lastName x),+ asLisp (aka x),+ asLisp (company x),+ asLisp (phone x),+ asLisp (address x),+ asLisp (net x),+ asLisp (notes x),+ "nil"+ ]++instance LispAble BBDBFile where+ asLisp (BBDBComment x) = x+ asLisp (BBDBEntry x) = asLisp x++-- | the inverse of bbdbFileParse+instance LispAble [BBDBFile] where+ asLisp = unlines . map asLisp++-- | parse the string as a BBDB File+parseBBDB :: String -> Either ParseError [BBDBFile]+parseBBDB = parse bbdbFileParse "bbdb"+++-- | read the given file and call error if the parse failed,+-- otherwise return the entire file as a list of BBDBFile records.+readBBDB :: String -> IO [BBDBFile]+readBBDB filename = do+ b <- readFile filename+ let ls = parseBBDB b+ return . either (error . show) id $ ls+++-- | Notes inside a BBDB record are awkward to get at. This helper+-- function digs into the record and applies a function to each+-- Alist element of the record. It returns true if it any of the+-- Alists in the note return true. For example:+-- +-- > hasBirthday :: BBDB -> Bool+-- > hasBirthday = wantNote (\x -> key x == "birthday")+-- +-- will return True for any BBDB record that has a \"birthday\" key+-- in it\'s notes field+wantNote :: (Alist -> Bool) -> BBDB -> Bool+wantNote cond bbdb = maybe False alistTest (notes bbdb)+ where+ alistTest = any id . map cond . unnote++-- | Lookup the value whose key is the given string. If found returns +-- Just the value, otherwise Nothing For example:+--+-- > getBirthday :: BBDB -> Maybe String+-- > getBirthday = getNote "birthday"+--+getNote :: String -> BBDB -> Maybe String+getNote k b = lookup k (maybe [] unnote (notes b))++-- | This and filterBBDB are the main functions you should use to+-- manipulate a set of BBDB entries. You supply a function that+-- applies a transformation on a BBDB record, and this function will+-- apply that transformation to every BBDBEntry in a BBDB file.+-- Sample usage:+-- +-- > starCompanies = do+-- > b <- readBBDB "/home/henry/.bbdb"+-- > writeFile "/home/henry/.bbdb-new" $ asLisp . mapBBDB starCompany $ b+-- > where+-- > starCompany x = case (company x) of+-- > Nothing -> x+-- > Just y -> x { company = Just ("*" ++ y) }+-- +-- Prepend a star (\"*\") to each company +-- field of a BBDB file and write the result+-- out as a new bbdb file.+mapBBDB :: (BBDB -> BBDB) -> [BBDBFile] -> [BBDBFile]+mapBBDB f bbdbf = map g bbdbf+ where+ g (BBDBComment x) = BBDBComment x+ g (BBDBEntry x) = BBDBEntry (f x)++-- | Just like mapBBDB except it filters. You supply a function that+-- takes a BBDB record to a Bool, and filterBBDB will return a new+-- list of BBDBFile that satisfy that condition. Sample usage:+-- +-- > import Text.Regex.Posix+-- > -- do regex matching while ignoring case, so "reno" matches "Reno"+-- > matches x = match (makeRegexOpts compIgnoreCase defaultExecOpt x :: Regex)+-- +-- > getReno = do+-- > b <- readBBDB "/home/henry/.bbdb"+-- > let c = justEntries . filterBBDB hasReno $ b+-- > mapM_ print $ map (\a -> (firstName a, lastName a, address a)) c+-- > where+-- > isReno :: Maybe String -> Bool+-- > isReno = maybe False (matches "reno")+-- > anyAddressHasReno :: [Address] -> Bool+-- > anyAddressHasReno = any id . map (isReno . city)+-- > hasReno :: BBDB -> Bool+-- > hasReno = maybe False anyAddressHasReno . address+-- +-- print the name and all addresses of anyone in the BBDB file+-- who live in Reno. +filterBBDB :: (BBDB -> Bool) -> [BBDBFile] -> [BBDBFile]+filterBBDB f bbdbf = filter g bbdbf+ where+ g (BBDBComment x) = True+ g (BBDBEntry x) = f x ++