X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FReport.hs;h=96c3150bcc10e0fe8060fbcf43c8a1d5c15fe739;hb=HEAD;hp=e248879225323cfd32f0ba5e213192db659b42af;hpb=0f6ab35ca71299d1c9db63a12df2329acf123284;p=mailbox-count.git diff --git a/src/Report.hs b/src/Report.hs index e248879..96c3150 100644 --- a/src/Report.hs +++ b/src/Report.hs @@ -5,7 +5,7 @@ module Report ( report_tests ) where -import Data.List ( foldl' ) +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 ) @@ -15,9 +15,11 @@ import Database.HDBC ( 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 @@ -26,19 +28,9 @@ 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) - +data DomainCount = + DomainCount Domain Count + deriving (Show) -- | A wrapper around a (domain, user) pair to keep things type-safe. data DomainUser = @@ -61,7 +53,7 @@ type DomainUserMap = Map.Map Domain [Username] -- >>> import Database.HDBC ( iToSql, toSql ) -- -- >>> list_to_domain_count [toSql "example.com", iToSql 100] --- Just example.com: 100 +-- Just (DomainCount "example.com" 100) -- -- >>> list_to_domain_count [toSql "example.com"] -- Nothing @@ -99,22 +91,59 @@ 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" ++ "----------------------------------------" -report_summary :: IConnection a => a -> IO String -report_summary conn = do + +-- | 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 report_lines = summary_header : (map show 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 - query = "SELECT domain,COUNT(username) " ++ - "FROM mailbox " ++ - "GROUP BY domain "++ - "ORDER BY domain;" + -- | 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 @@ -137,8 +166,8 @@ report_summary conn = do -- 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 +construct_domain_user_map = + foldl' append_this_du Map.empty where append_func :: Username -> (Maybe [Username]) -> (Maybe [Username]) append_func user maybe_userlist = @@ -151,12 +180,17 @@ construct_domain_user_map dus = 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" ++ "----------------------------------------" -report_detail :: IConnection a => a -> IO String -report_detail conn = do + +-- | 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 @@ -167,29 +201,23 @@ report_detail conn = do let report_body = Map.foldl (++) "" domain_report_map return $ detail_header ++ report_body where - query = "SELECT domain,username " ++ - "FROM mailbox " ++ - "ORDER BY domain;" - format_domain :: Domain -> [Username] -> String format_domain domain users = (join "\n" (domain_header : indented_users)) ++ "\n" where - domain_header = "\n" ++ domain ++ ":" + count = length users + domain_header = "\n" ++ domain ++ " (" ++ (show count) ++ ")" ++ ":" indented_users = map (" " ++) users -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) +-- | 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) @@ -204,35 +232,41 @@ test_summary_report :: TestTree test_summary_report = testCase desc $ do conn <- connectSqlite3 "test/fixtures/postfixadmin.sqlite3" - actual <- report_summary conn + 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.net: 2\n" ++ - "example.org: 1" + "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" - actual <- report_detail conn + 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:\n" ++ + "example.com (3):\n" ++ " user1\n" ++ " user3\n" ++ " user5\n" ++ "\n" ++ - "example.net:\n" ++ + "example.invalid (1):\n" ++ + " user7\n" ++ + "\n" ++ + "example.net (2):\n" ++ " user2\n" ++ " user4\n" ++ "\n" ++ - "example.org:\n" ++ + "example.org (1):\n" ++ " user6\n"