{-# LANGUAGE PatternGuards #-}

module Report (
  report,
  report_tests )
where

import Data.List ( foldl', maximumBy )
import qualified Data.Map as Map ( Map, alter, empty, foldl, mapWithKey )
import Data.Maybe ( catMaybes )
import Data.String.Utils ( join )
import Database.HDBC (
  IConnection,
  SqlValue,
  safeFromSql,
  quickQuery )
import Database.HDBC.Sqlite3 ( connectSqlite3 )
import System.Console.CmdArgs.Default ( Default( def ) )
import Test.Tasty ( TestTree, testGroup )
import Test.Tasty.HUnit ( (@?=), testCase )

import Configuration ( Configuration( detail, detail_query, summary_query ) )

-- Type synonyms to make the signatures below a little more clear.
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
  deriving (Show)

-- | 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 (DomainCount "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


-- | Pad each count on the left with spaces so that they start on the
--   same column. The 'Int' argument is the length of the longest
--   domain name with which this one will be aligned, so when you take
--   into consideration the colon and subsequent space, the count will
--   be placed in column @longest_length + 3@.
--
--   Examples:
--
--   >>> let dc = DomainCount "example.com" 20
--   >>> format_domain_count 20 dc
--   "example.com:          20"
--
format_domain_count :: Int -> DomainCount -> String
format_domain_count longest_length (DomainCount d c) =
  d ++ ": " ++ (replicate num_spaces ' ') ++ (show c)
  where
    num_spaces = longest_length - length d


-- | The header that gets output before the summary report.
--
summary_header :: String
summary_header = "Summary (number of mailboxes per domain)\n" ++
                 "----------------------------------------"


-- | Given a connection, produces the summary report as a 'String'.
--
report_summary :: IConnection a => a -> String -> IO String
report_summary conn query = do
  list_rows <- quickQuery conn query []
  let maybe_domain_counts = map list_to_domain_count list_rows
  let domain_counts = catMaybes maybe_domain_counts
  let n = longest_dc_length domain_counts
  let formatted_domain_counts = map (format_domain_count n) domain_counts
  let report_lines = summary_header : formatted_domain_counts
  return $ join "\n" report_lines
  where
    -- | Compare two 'DomainCount's by the length of their domain. The
    --   one with the longest domain is \"bigger\".
    compare_dcs_by_length :: DomainCount -> DomainCount -> Ordering
    compare_dcs_by_length (DomainCount x _) (DomainCount y _) =
      compare (length x) (length y)

    -- | Find the length of the 'DomainCount' in the list that has the
    --   longest domain. We need to know this in order to pad the
    --   counts on the left by the correct number of spaces.
    longest_dc_length :: [DomainCount] -> Int
    longest_dc_length dcs =
      let (DomainCount d _) = longest in length d
      where
        longest = maximumBy compare_dcs_by_length dcs



-- | 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 =
  foldl' append_this_du Map.empty
  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


-- | The header that gets output before the detail report.
--
detail_header :: String
detail_header = "Detail (list of all mailboxes by domain)\n" ++
                "----------------------------------------"


-- | Given a connection, produces the detail report as a 'String'.
--
report_detail :: IConnection a => a -> String -> IO String
report_detail conn query = 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

  -- This maps domains to a string listing their users
  let domain_report_map = Map.mapWithKey format_domain domain_users_map
  let report_body = Map.foldl (++) "" domain_report_map
  return $ detail_header ++ report_body
  where
    format_domain :: Domain -> [Username] -> String
    format_domain domain users =
      (join "\n" (domain_header : indented_users)) ++ "\n"
      where
        count = length users
        domain_header = "\n" ++ domain ++ " (" ++ (show count) ++ ")" ++ ":"
        indented_users = map ("  " ++) users


-- | Given a connection and a 'Configuration', produces the report as
--   a 'String'.
--
report :: IConnection a => Configuration -> a -> IO String
report cfg conn =
  if (detail cfg)
  then report_detail conn (detail_query cfg)
  else report_summary conn (summary_query cfg)



-- * Tests

report_tests :: TestTree
report_tests =
  testGroup "Report Tests" [ test_summary_report, test_detail_report ]


test_summary_report :: TestTree
test_summary_report =
  testCase desc $ do
    conn <- connectSqlite3 "test/fixtures/postfixadmin.sqlite3"
    let cfg = def :: Configuration
    actual <- report_summary conn (summary_query cfg)
    actual @?= expected
  where
    desc = "Summary report looks like it should"
    expected = summary_header ++
               "\n" ++
               "example.com:     3\n" ++
               "example.invalid: 1\n" ++
               "example.net:     2\n" ++
               "example.org:     1"


test_detail_report :: TestTree
test_detail_report =
  testCase desc $ do
    conn <- connectSqlite3 "test/fixtures/postfixadmin.sqlite3"
    let cfg = def :: Configuration
    actual <- report_detail conn (detail_query cfg)
    actual @?= expected
  where
    desc = "Detail report looks like it should"
    expected = detail_header ++
               "\n" ++
               "example.com (3):\n" ++
               "  user1\n" ++
               "  user3\n" ++
               "  user5\n" ++
               "\n" ++
               "example.invalid (1):\n" ++
               "  user7\n" ++
               "\n" ++
               "example.net (2):\n" ++
               "  user2\n" ++
               "  user4\n" ++
               "\n" ++
               "example.org (1):\n" ++
               "  user6\n"
