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 )
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
-- | 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 =
-- >>> 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
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
-- 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 =
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
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)
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"
projects / mailbox-count.git / blobdiff