1 {-# LANGUAGE PatternGuards #-}
8 import Data.List ( foldl' )
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 Test.Tasty ( TestTree, testGroup )
19 import Test.Tasty.HUnit ( (@?=), testCase )
22 -- Type synonyms to make the signatures below a little more clear.
24 type Username = String
28 -- | A wrapper around a (domain, count) pair to keep things type-safe.
29 data DomainCount = DomainCount Domain Count
31 instance Show DomainCount where
32 -- | Display a DomainCount in the form \"domain: count\".
36 -- >>> let dc = DomainCount "example.com" 100
40 show (DomainCount domain count) = domain ++ ": " ++ (show count)
43 -- | A wrapper around a (domain, user) pair to keep things type-safe.
45 DomainUser Domain Username
49 -- | In the detailed report, we store the usernames as a map from a
50 -- domain name to a list of usernames. This type synonym is the type
52 type DomainUserMap = Map.Map Domain [Username]
55 -- | Convert a list of [SqlByteString, SqlInt32] to 'DomainCount's. If
56 -- the conversion doesn't work for some reason (bad data, not enough
57 -- columns, etc.), we return 'Nothing'.
61 -- >>> import Database.HDBC ( iToSql, toSql )
63 -- >>> list_to_domain_count [toSql "example.com", iToSql 100]
64 -- Just example.com: 100
66 -- >>> list_to_domain_count [toSql "example.com"]
69 -- >>> list_to_domain_count [toSql "example.com", toSql "example.com"]
72 list_to_domain_count :: [SqlValue] -> Maybe DomainCount
73 list_to_domain_count (domain:count:_)
74 | Right d <- safeFromSql domain,
75 Right c <- safeFromSql count = Just $ DomainCount d c
76 list_to_domain_count _ =
80 -- | Convert a list of [SqlByteString, SqlByteString] to 'DomainUser's. If
81 -- the conversion doesn't work for some reason (bad data, not enough
82 -- columns, etc.), we return 'Nothing'.
86 -- >>> import Database.HDBC ( toSql )
88 -- >>> list_to_domain_user [toSql "example.com", toSql "user1"]
89 -- Just (DomainUser "example.com" "user1")
91 -- >>> list_to_domain_user [toSql "example.com"]
94 list_to_domain_user :: [SqlValue] -> Maybe DomainUser
95 list_to_domain_user (domain:user:_)
96 | Right d <- safeFromSql domain,
97 Right u <- safeFromSql user = Just $ DomainUser d u
98 list_to_domain_user _ =
102 summary_header :: String
103 summary_header = "Summary (number of mailboxes per domain)\n" ++
104 "----------------------------------------"
106 report_summary :: IConnection a => a -> IO String
107 report_summary conn = do
108 list_rows <- quickQuery conn query []
109 let maybe_domain_counts = map list_to_domain_count list_rows
110 let domain_counts = catMaybes maybe_domain_counts
111 let report_lines = summary_header : (map show domain_counts)
112 return $ join "\n" report_lines
114 query = "SELECT domain,COUNT(username) " ++
120 -- | Construct a Domain -> [Username] (a DomainUserMap) map from a
121 -- list of 'DomainUser's. We do this with a fold over the list of
122 -- 'DomainUser's, appending each new user to the list associated
123 -- with the domain that the user is paired with.
125 -- The [Username] lists (the values stored in the map) are kept in
126 -- the same order as they are given.
130 -- >>> let du1 = DomainUser "example.com" "user1"
131 -- >>> let du2 = DomainUser "example.com" "user2"
132 -- >>> let du3 = DomainUser "example.net" "user3"
133 -- >>> construct_domain_user_map [du1,du2,du3]
134 -- fromList [("example.com",["user1","user2"]),("example.net",["user3"])]
136 -- >>> construct_domain_user_map [du2,du1,du3]
137 -- fromList [("example.com",["user2","user1"]),("example.net",["user3"])]
139 construct_domain_user_map :: [DomainUser] -> DomainUserMap
140 construct_domain_user_map dus =
141 foldl' append_this_du Map.empty dus
143 append_func :: Username -> (Maybe [Username]) -> (Maybe [Username])
144 append_func user maybe_userlist =
145 case maybe_userlist of
146 Just userlist -> Just (userlist ++ [user])
147 Nothing -> Just [user]
149 append_this_du :: DomainUserMap -> DomainUser -> DomainUserMap
150 append_this_du du_map (DomainUser domain user) =
151 Map.alter (append_func user) domain du_map
154 detail_header :: String
155 detail_header = "Detail (list of all mailboxes by domain)\n" ++
156 "----------------------------------------"
158 report_detail :: IConnection a => a -> IO String
159 report_detail conn = do
160 list_rows <- quickQuery conn query []
161 let maybe_domain_users = map list_to_domain_user list_rows
162 let domain_users = catMaybes maybe_domain_users
163 let domain_users_map = construct_domain_user_map domain_users
165 -- This maps domains to a string listing their users
166 let domain_report_map = Map.mapWithKey format_domain domain_users_map
167 let report_body = Map.foldl (++) "" domain_report_map
168 return $ detail_header ++ report_body
170 query = "SELECT domain,username " ++
174 format_domain :: Domain -> [Username] -> String
175 format_domain domain users =
176 (join "\n" (domain_header : indented_users)) ++ "\n"
178 domain_header = "\n" ++ domain ++ ":"
179 indented_users = map (" " ++) users
182 report_both :: IConnection a => a -> IO String
183 report_both conn = do
184 rs <- report_summary conn
185 rd <- report_detail conn
188 report :: IConnection a => a -> Bool -> Bool -> IO String
189 report conn do_both do_detail =
191 then (report_both conn)
192 else if do_detail then (report_detail conn) else (report_summary conn)
198 report_tests :: TestTree
200 testGroup "Report Tests" [ test_summary_report, test_detail_report ]
203 test_summary_report :: TestTree
204 test_summary_report =
206 conn <- connectSqlite3 "test/fixtures/postfixadmin.sqlite3"
207 actual <- report_summary conn
210 desc = "Summary report looks like it should"
211 expected = summary_header ++
213 "example.com: 3\n" ++
214 "example.net: 2\n" ++
218 test_detail_report :: TestTree
221 conn <- connectSqlite3 "test/fixtures/postfixadmin.sqlite3"
222 actual <- report_detail conn
225 desc = "Detail report looks like it should"
226 expected = detail_header ++