Simple JSON-backed address book in Haskell

contacts.hs

{-# LANGUAGE OverloadedStrings, DeriveGeneric #-}

import Data.Aeson ((.:), (.:?), decode, encode, FromJSON(..), ToJSON(..), Value(..))
import Data.Aeson.Encode.Pretty

import qualified Data.ByteString.Lazy as BS (readFile, writeFile)

import Control.Applicative ((<$>), (<*>))
import Control.Monad.IO.Class
import Control.Monad
import Control.Exception

import GHC.Generics
import UI.Command
import Data.Default
import System.IO.Error
import Data.List.Ordered

-------------------------------------------------------------------------------
-- CONSTANTS
-------------------------------------------------------------------------------
abFilePath = "./address_book.json" :: FilePath

-------------------------------------------------------------------------------
-- DATA
-------------------------------------------------------------------------------

type AddressBook = [Contact]

data Contact = Contact  { firstName  :: String
                        , lastName   :: String 
                        , company    :: String
                        , homeNumber :: String
                        , mobileNumber :: String
                        } deriving (Eq, Read, Generic)

instance Show Contact where 
        show c = 
            "\n" ++ firstName c ++ " " ++ lastName c ++ "\n"
            ++ company c ++ "\n"
            ++ "home: " ++ homeNumber c ++ "\n"
            ++ "mobile: " ++ mobileNumber c ++ "\n"

instance Ord Contact where
        c1 `compare` c2 = firstName c1 `compare` firstName c2


instance FromJSON Contact
instance ToJSON Contact

-------------------------------------------------------------------------------
-- FUNCTIONS
-------------------------------------------------------------------------------

loadAddressBook :: IO AddressBook
loadAddressBook = do
        file <- tryJust (guard . isDoesNotExistError) (BS.readFile abFilePath)
        case file of 
            Left e -> return ([])
            Right jsonContacts -> case decode jsonContacts of
                            Just contacts -> return (contacts)
                            Nothing -> putStrLn "Error parsing json file" >> return ([])


listContacts :: MonadIO m => m ()
listContacts = liftIO $ loadAddressBook >>= putStrLn . show


addContact :: MonadIO m => m ()
addContact = liftIO $ do
        c <- readContact
        ab <- loadAddressBook
        saveContact ab c


readContact :: IO Contact
readContact = do
        answers <- mapM askQuestion [ "First name: "
                                    , "Last name: "
                                    , "Company: "
                                    , "Home number: "
                                    , "Mobile number: "
                                    ]
        return Contact { firstName  = answers !! 0
                       , lastName   = answers !! 1
                       , company    = answers !! 2
                       , homeNumber = answers !! 3
                       , mobileNumber = answers !! 4
                       }
    where askQuestion :: String -> IO String
          askQuestion q = do
              putStr q 
              getLine


saveContact :: AddressBook -> Contact -> IO ()
saveContact ab c = liftIO $ do
                    ab <- loadAddressBook 
                    BS.writeFile abFilePath $ encodePretty $ insertBag c ab

-------------------------------------------------------------------------------
-- MAIN
-------------------------------------------------------------------------------

contacts :: Application () ()
contacts = def {
        appName = "contacts",
        appVersion = "0.1",
        appAuthors = ["Marco Sero"],
        appBugEmail = "[email protected]",
        appShortDesc = "Simple address book",
        appProject = "Haskell",
        appCmds = [add, list]
}

add :: Command ()
add = defCmd {
        cmdName = "add",
        cmdHandler = addContact,
        cmdCategory = "action",
        cmdShortDesc = "add a new contact to the address book"
}
       
list :: Command ()
list = defCmd {
        cmdName = "list",
        cmdHandler = listContacts,
        cmdCategory = "action",
        cmdShortDesc = "list all contacts in the address book"
}


main = appMain contacts