{-# LANGUAGE PatternGuards #-}

module Main
where

import Data.List ( foldl' )
import qualified Data.Map as Map ( Map, alter, empty )
import Data.Maybe ( catMaybes )
import Data.Monoid ( (<>) )
import Database.HDBC (
  IConnection,
  SqlValue,
  disconnect,
  safeFromSql,
  quickQuery )
import Database.HDBC.PostgreSQL ( connectPostgreSQL )
import System.Console.CmdArgs ( def )

import CommandLine ( get_args )
import Configuration ( Configuration(..), merge_optional )
import qualified OptionalConfiguration as OC ( from_rc )

type Domain = String
type Username = String
type Count = Int

-- | A wrapper around a (domain, count) pair to keep things type-safe.
data DomainCount = DomainCount Domain Count

instance Show DomainCount where
  -- | Display a DomainCount in the form \"domain: count\".
  --
  --   Examples:
  --
  --   >>> let dc = DomainCount "example.com" 100
  --   >>> show dc
  --   "example.com: 100"
  --
  show (DomainCount domain count) = domain ++ ": " ++ (show count)


-- | A wrapper around a (domain, user) pair to keep things type-safe.
data DomainUser =
  DomainUser Domain Username
  deriving (Show)


-- | In the detailed report, we store the usernames as a map from a
--   domain name to a list of usernames. This type synonym is the type
--   of that map.
type DomainUserMap = Map.Map Domain [Username]


-- | Convert a list of [SqlByteString, SqlInt32] to 'DomainCount's. If
--   the conversion doesn't work for some reason (bad data, not enough
--   columns, etc.), we return 'Nothing'.
--
--   Examples:
--
--   >>> import Database.HDBC ( iToSql, toSql )
--
--   >>> list_to_domain_count [toSql "example.com", iToSql 100]
--   Just example.com: 100
--
--   >>> list_to_domain_count [toSql "example.com"]
--   Nothing
--
--   >>> list_to_domain_count [toSql "example.com", toSql "example.com"]
--   Nothing
--
list_to_domain_count :: [SqlValue] -> Maybe DomainCount
list_to_domain_count (domain:count:_)
  | Right d <- safeFromSql domain,
    Right c <- safeFromSql count = Just $ DomainCount d c
list_to_domain_count _ =
  Nothing


-- | Convert a list of [SqlByteString, SqlByteString] to 'DomainUser's. If
--   the conversion doesn't work for some reason (bad data, not enough
--   columns, etc.), we return 'Nothing'.
--
--   Examples:
--
--   >>> import Database.HDBC ( toSql )
--   >>>
--   >>> list_to_domain_user [toSql "example.com", toSql "user1"]
--   Just (DomainUser "example.com" "user1")
--
--   >>> list_to_domain_user [toSql "example.com"]
--   Nothing
--
list_to_domain_user :: [SqlValue] -> Maybe DomainUser
list_to_domain_user (domain:user:_)
  | Right d <- safeFromSql domain,
    Right u <- safeFromSql user = Just $ DomainUser d u
list_to_domain_user _ =
  Nothing


report_summary :: IConnection a => a -> IO String
report_summary conn = do
  list_rows <- quickQuery conn query []
  let maybe_domain_counts = map list_to_domain_count list_rows
  let domain_counts = catMaybes maybe_domain_counts
  return $ header ++ (concatMap show domain_counts)
  where
    header = "mailbox-count summary report" ++
             "----------------------------"

    query = "SELECT domain,COUNT(username) " ++
            "FROM mailbox " ++
            "GROUP BY domain "++
            "ORDER BY domain;"


-- | Construct a Domain -> [Username] (a DomainUserMap) map from a
--   list of 'DomainUser's. We do this with a fold over the list of
--   'DomainUser's, appending each new user to the list associated
--   with the domain that the user is paired with.
--
--   The [Username] lists (the values stored in the map) are kept in
--   the same order as they are given.
--
--   Examples:
--
--   >>> let du1 = DomainUser "example.com" "user1"
--   >>> let du2 = DomainUser "example.com" "user2"
--   >>> let du3 = DomainUser "example.net" "user3"
--   >>> construct_domain_user_map [du1,du2,du3]
--   fromList [("example.com",["user1","user2"]),("example.net",["user3"])]
--
--   >>> construct_domain_user_map [du2,du1,du3]
--   fromList [("example.com",["user2","user1"]),("example.net",["user3"])]
--
construct_domain_user_map :: [DomainUser] -> DomainUserMap
construct_domain_user_map dus =
  foldl' append_this_du Map.empty dus
  where
    append_func :: Username -> (Maybe [Username]) -> (Maybe [Username])
    append_func user maybe_userlist =
      case maybe_userlist of
        Just userlist -> Just (userlist ++ [user])
        Nothing       -> Just [user]

    append_this_du :: DomainUserMap -> DomainUser -> DomainUserMap
    append_this_du du_map (DomainUser domain user) =
      Map.alter (append_func user) domain du_map


report_detail :: IConnection a => a -> IO String
report_detail conn = do
  list_rows <- quickQuery conn query []
  let maybe_domain_users = map list_to_domain_user list_rows
  let domain_users = catMaybes maybe_domain_users
  let domain_users_map = construct_domain_user_map domain_users
  return ""
  where
    query = "SELECT domain,username " ++
            "FROM mailbox " ++
            "ORDER BY domain;"


report_both :: IConnection a => a -> IO String
report_both conn = do
  rs <- report_summary conn
  rd <- report_detail conn
  return (rs ++ rd)

report :: IConnection a => a -> Bool -> Bool -> IO String
report conn do_both do_detail =
  if do_both
  then (report_both conn)
  else if do_detail then (report_detail conn) else (report_summary conn)


connection_string :: Configuration -> String
connection_string cfg =
  "host=" ++ (host cfg) ++ " " ++
  "port=" ++ (show $ port cfg) ++ " " ++
  "user=" ++ (username cfg) ++ " " ++
  "password=" ++ (password cfg) ++ " " ++
  "dbname=" ++ (database cfg)

main :: IO ()
main = do
  rc_cfg <- OC.from_rc
  cmd_cfg <- get_args

    -- Merge the config file options with the command-line ones,
  -- prefering the command-line ones.
  let opt_config = rc_cfg <> cmd_cfg

  -- Update a default config with any options that have been set in
  -- either the config file or on the command-line.  We initialize
  -- logging before the missing parameter checks below so that we can
  -- log the errors.
  let cfg = (def :: Configuration) `merge_optional` opt_config

  -- Check the optional config for missing required options.
  --when (isNothing (OC.password opt_config)) $ do
  --  report_error "No password supplied."
  --  exitWith (ExitFailure exit_no_password)

  --when (isNothing (OC.username opt_config)) $ do
  --  report_error "No username supplied."
  --exitWith (ExitFailure exit_no_username)

  conn <- connectPostgreSQL (connection_string cfg)
  r <- report conn (both cfg) (detail cfg)
  putStrLn r
  disconnect conn