1 {-# LANGUAGE PatternGuards #-}
8 import Data.List ( foldl', maximumBy )
9 import qualified Data.Map as Map ( Map, alter, empty, foldl, mapWithKey )
10 import Data.Maybe ( catMaybes )
11 import Data.String.Utils ( join )
12 import Database.HDBC (
17 import Database.HDBC.Sqlite3 ( connectSqlite3 )
18 import System.Console.CmdArgs.Default ( Default( def ) )
19 import Test.Tasty ( TestTree, testGroup )
20 import Test.Tasty.HUnit ( (@?=), testCase )
22 import Configuration ( Configuration( detail, detail_query, summary_query ) )
24 -- Type synonyms to make the signatures below a little more clear.
26 type Username = String
30 -- | A wrapper around a (domain, count) pair to keep things type-safe.
32 DomainCount Domain Count
35 -- | A wrapper around a (domain, user) pair to keep things type-safe.
37 DomainUser Domain Username
41 -- | In the detailed report, we store the usernames as a map from a
42 -- domain name to a list of usernames. This type synonym is the type
44 type DomainUserMap = Map.Map Domain [Username]
47 -- | Convert a list of [SqlByteString, SqlInt32] to 'DomainCount's. If
48 -- the conversion doesn't work for some reason (bad data, not enough
49 -- columns, etc.), we return 'Nothing'.
53 -- >>> import Database.HDBC ( iToSql, toSql )
55 -- >>> list_to_domain_count [toSql "example.com", iToSql 100]
56 -- Just (DomainCount "example.com" 100)
58 -- >>> list_to_domain_count [toSql "example.com"]
61 -- >>> list_to_domain_count [toSql "example.com", toSql "example.com"]
64 list_to_domain_count :: [SqlValue] -> Maybe DomainCount
65 list_to_domain_count (domain:count:_)
66 | Right d <- safeFromSql domain,
67 Right c <- safeFromSql count = Just $ DomainCount d c
68 list_to_domain_count _ =
72 -- | Convert a list of [SqlByteString, SqlByteString] to 'DomainUser's. If
73 -- the conversion doesn't work for some reason (bad data, not enough
74 -- columns, etc.), we return 'Nothing'.
78 -- >>> import Database.HDBC ( toSql )
80 -- >>> list_to_domain_user [toSql "example.com", toSql "user1"]
81 -- Just (DomainUser "example.com" "user1")
83 -- >>> list_to_domain_user [toSql "example.com"]
86 list_to_domain_user :: [SqlValue] -> Maybe DomainUser
87 list_to_domain_user (domain:user:_)
88 | Right d <- safeFromSql domain,
89 Right u <- safeFromSql user = Just $ DomainUser d u
90 list_to_domain_user _ =
94 -- | Pad each count on the left with spaces so that they start on the
95 -- same column. The 'Int' argument is the length of the longest
96 -- domain name with which this one will be aligned, so when you take
97 -- into consideration the colon and subsequent space, the count will
98 -- be placed in column @longest_length + 3@.
102 -- >>> let dc = DomainCount "example.com" 20
103 -- >>> format_domain_count 20 dc
106 format_domain_count :: Int -> DomainCount -> String
107 format_domain_count longest_length (DomainCount d c) =
108 d ++ ": " ++ (replicate num_spaces ' ') ++ (show c)
110 num_spaces = longest_length - length d
113 -- | The header that gets output before the summary report.
115 summary_header :: String
116 summary_header = "Summary (number of mailboxes per domain)\n" ++
117 "----------------------------------------"
120 -- | Given a connection, produces the summary report as a 'String'.
122 report_summary :: IConnection a => a -> String -> IO String
123 report_summary conn query = do
124 list_rows <- quickQuery conn query []
125 let maybe_domain_counts = map list_to_domain_count list_rows
126 let domain_counts = catMaybes maybe_domain_counts
127 let n = longest_dc_length domain_counts
128 let formatted_domain_counts = map (format_domain_count n) domain_counts
129 let report_lines = summary_header : formatted_domain_counts
130 return $ join "\n" report_lines
132 -- | Compare two 'DomainCount's by the length of their domain. The
133 -- one with the longest domain is \"bigger\".
134 compare_dcs_by_length :: DomainCount -> DomainCount -> Ordering
135 compare_dcs_by_length (DomainCount x _) (DomainCount y _) =
136 compare (length x) (length y)
138 -- | Find the length of the 'DomainCount' in the list that has the
139 -- longest domain. We need to know this in order to pad the
140 -- counts on the left by the correct number of spaces.
141 longest_dc_length :: [DomainCount] -> Int
142 longest_dc_length dcs =
143 let (DomainCount d _) = longest in length d
145 longest = maximumBy compare_dcs_by_length dcs
149 -- | Construct a Domain -> [Username] (a DomainUserMap) map from a
150 -- list of 'DomainUser's. We do this with a fold over the list of
151 -- 'DomainUser's, appending each new user to the list associated
152 -- with the domain that the user is paired with.
154 -- The [Username] lists (the values stored in the map) are kept in
155 -- the same order as they are given.
159 -- >>> let du1 = DomainUser "example.com" "user1"
160 -- >>> let du2 = DomainUser "example.com" "user2"
161 -- >>> let du3 = DomainUser "example.net" "user3"
162 -- >>> construct_domain_user_map [du1,du2,du3]
163 -- fromList [("example.com",["user1","user2"]),("example.net",["user3"])]
165 -- >>> construct_domain_user_map [du2,du1,du3]
166 -- fromList [("example.com",["user2","user1"]),("example.net",["user3"])]
168 construct_domain_user_map :: [DomainUser] -> DomainUserMap
169 construct_domain_user_map =
170 foldl' append_this_du Map.empty
172 append_func :: Username -> (Maybe [Username]) -> (Maybe [Username])
173 append_func user maybe_userlist =
174 case maybe_userlist of
175 Just userlist -> Just (userlist ++ [user])
176 Nothing -> Just [user]
178 append_this_du :: DomainUserMap -> DomainUser -> DomainUserMap
179 append_this_du du_map (DomainUser domain user) =
180 Map.alter (append_func user) domain du_map
183 -- | The header that gets output before the detail report.
185 detail_header :: String
186 detail_header = "Detail (list of all mailboxes by domain)\n" ++
187 "----------------------------------------"
190 -- | Given a connection, produces the detail report as a 'String'.
192 report_detail :: IConnection a => a -> String -> IO String
193 report_detail conn query = do
194 list_rows <- quickQuery conn query []
195 let maybe_domain_users = map list_to_domain_user list_rows
196 let domain_users = catMaybes maybe_domain_users
197 let domain_users_map = construct_domain_user_map domain_users
199 -- This maps domains to a string listing their users
200 let domain_report_map = Map.mapWithKey format_domain domain_users_map
201 let report_body = Map.foldl (++) "" domain_report_map
202 return $ detail_header ++ report_body
204 format_domain :: Domain -> [Username] -> String
205 format_domain domain users =
206 (join "\n" (domain_header : indented_users)) ++ "\n"
209 domain_header = "\n" ++ domain ++ " (" ++ (show count) ++ ")" ++ ":"
210 indented_users = map (" " ++) users
213 -- | Given a connection and a 'Configuration', produces the report as
216 report :: IConnection a => Configuration -> a -> IO String
219 then report_detail conn (detail_query cfg)
220 else report_summary conn (summary_query cfg)
226 report_tests :: TestTree
228 testGroup "Report Tests" [ test_summary_report, test_detail_report ]
231 test_summary_report :: TestTree
232 test_summary_report =
234 conn <- connectSqlite3 "test/fixtures/postfixadmin.sqlite3"
235 let cfg = def :: Configuration
236 actual <- report_summary conn (summary_query cfg)
239 desc = "Summary report looks like it should"
240 expected = summary_header ++
242 "example.com: 3\n" ++
243 "example.invalid: 1\n" ++
244 "example.net: 2\n" ++
248 test_detail_report :: TestTree
251 conn <- connectSqlite3 "test/fixtures/postfixadmin.sqlite3"
252 let cfg = def :: Configuration
253 actual <- report_detail conn (detail_query cfg)
256 desc = "Detail report looks like it should"
257 expected = detail_header ++
259 "example.com (3):\n" ++
264 "example.invalid (1):\n" ++
267 "example.net (2):\n" ++
271 "example.org (1):\n" ++