{-# 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
import Data.List.Utils

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

-- | 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