{-# 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(..) ) import Test.Tasty ( TestTree, testGroup ) import Test.Tasty.HUnit ( (@?=), testCase ) import Configuration ( Configuration(..) ) -- 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"