src/Report.hs

   1 {-# LANGUAGE PatternGuards #-}
   2
   3 module Report (
   4   report,
   5   report_tests )
   6 where
   7
   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 (
  13   IConnection,
  14   SqlValue,
  15   safeFromSql,
  16   quickQuery )
  17 import Database.HDBC.Sqlite3 ( connectSqlite3 )
  18 import System.Console.CmdArgs.Default ( Default(..) )
  19 import Test.Tasty ( TestTree, testGroup )
  20 import Test.Tasty.HUnit ( (@?=), testCase )
  21
  22 import Configuration ( Configuration(..) )
  23
  24 -- Type synonyms to make the signatures below a little more clear.
  25 type Domain = String
  26 type Username = String
  27 type Count = Int
  28
  29
  30 -- | A wrapper around a (domain, count) pair to keep things type-safe.
  31 data DomainCount =
  32   DomainCount Domain Count
  33   deriving (Show)
  34
  35 -- | A wrapper around a (domain, user) pair to keep things type-safe.
  36 data DomainUser =
  37   DomainUser Domain Username
  38   deriving (Show)
  39
  40
  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
  43 --   of that map.
  44 type DomainUserMap = Map.Map Domain [Username]
  45
  46
  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'.
  50 --
  51 --   Examples:
  52 --
  53 --   >>> import Database.HDBC ( iToSql, toSql )
  54 --
  55 --   >>> list_to_domain_count [toSql "example.com", iToSql 100]
  56 --   Just (DomainCount "example.com" 100)
  57 --
  58 --   >>> list_to_domain_count [toSql "example.com"]
  59 --   Nothing
  60 --
  61 --   >>> list_to_domain_count [toSql "example.com", toSql "example.com"]
  62 --   Nothing
  63 --
  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 _ =
  69   Nothing
  70
  71
  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'.
  75 --
  76 --   Examples:
  77 --
  78 --   >>> import Database.HDBC ( toSql )
  79 --   >>>
  80 --   >>> list_to_domain_user [toSql "example.com", toSql "user1"]
  81 --   Just (DomainUser "example.com" "user1")
  82 --
  83 --   >>> list_to_domain_user [toSql "example.com"]
  84 --   Nothing
  85 --
  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 _ =
  91   Nothing
  92
  93
  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@.
  99 --
 100 --   Examples:
 101 --
 102 --   >>> let dc = DomainCount "example.com" 20
 103 --   >>> format_domain_count 20 dc
 104 --   "example.com:          20"
 105 --
 106 format_domain_count :: Int -> DomainCount -> String
 107 format_domain_count longest_length (DomainCount d c) =
 108   d ++ ": " ++ (replicate num_spaces ' ') ++ (show c)
 109   where
 110     num_spaces = longest_length - length d
 111
 112
 113 -- | The header that gets output before the summary report.
 114 --
 115 summary_header :: String
 116 summary_header = "Summary (number of mailboxes per domain)\n" ++
 117                  "----------------------------------------"
 118
 119
 120 -- | Given a connection, produces the summary report as a 'String'.
 121 --
 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
 131   where
 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)
 137
 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
 144       where
 145         longest = maximumBy compare_dcs_by_length dcs
 146
 147
 148
 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.
 153 --
 154 --   The [Username] lists (the values stored in the map) are kept in
 155 --   the same order as they are given.
 156 --
 157 --   Examples:
 158 --
 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"])]
 164 --
 165 --   >>> construct_domain_user_map [du2,du1,du3]
 166 --   fromList [("example.com",["user2","user1"]),("example.net",["user3"])]
 167 --
 168 construct_domain_user_map :: [DomainUser] -> DomainUserMap
 169 construct_domain_user_map =
 170   foldl' append_this_du Map.empty
 171   where
 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]
 177
 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
 181
 182
 183 -- | The header that gets output before the detail report.
 184 --
 185 detail_header :: String
 186 detail_header = "Detail (list of all mailboxes by domain)\n" ++
 187                 "----------------------------------------"
 188
 189
 190 -- | Given a connection, produces the detail report as a 'String'.
 191 --
 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
 198
 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
 203   where
 204     format_domain :: Domain -> [Username] -> String
 205     format_domain domain users =
 206       (join "\n" (domain_header : indented_users)) ++ "\n"
 207       where
 208         count = length users
 209         domain_header = "\n" ++ domain ++ " (" ++ (show count) ++ ")" ++ ":"
 210         indented_users = map ("  " ++) users
 211
 212
 213 -- | Given a connection and a 'Configuration', produces the report as
 214 --   a 'String'.
 215 --
 216 report :: IConnection a => Configuration -> a -> IO String
 217 report cfg conn =
 218   if (detail cfg)
 219   then report_detail conn (detail_query cfg)
 220   else report_summary conn (summary_query cfg)
 221
 222
 223
 224 -- * Tests
 225
 226 report_tests :: TestTree
 227 report_tests =
 228   testGroup "Report Tests" [ test_summary_report, test_detail_report ]
 229
 230
 231 test_summary_report :: TestTree
 232 test_summary_report =
 233   testCase desc $ do
 234     conn <- connectSqlite3 "test/fixtures/postfixadmin.sqlite3"
 235     let cfg = def :: Configuration
 236     actual <- report_summary conn (summary_query cfg)
 237     actual @?= expected
 238   where
 239     desc = "Summary report looks like it should"
 240     expected = summary_header ++
 241                "\n" ++
 242                "example.com:     3\n" ++
 243                "example.invalid: 1\n" ++
 244                "example.net:     2\n" ++
 245                "example.org:     1"
 246
 247
 248 test_detail_report :: TestTree
 249 test_detail_report =
 250   testCase desc $ do
 251     conn <- connectSqlite3 "test/fixtures/postfixadmin.sqlite3"
 252     let cfg = def :: Configuration
 253     actual <- report_detail conn (detail_query cfg)
 254     actual @?= expected
 255   where
 256     desc = "Detail report looks like it should"
 257     expected = detail_header ++
 258                "\n" ++
 259                "example.com (3):\n" ++
 260                "  user1\n" ++
 261                "  user3\n" ++
 262                "  user5\n" ++
 263                "\n" ++
 264                "example.invalid (1):\n" ++
 265                "  user7\n" ++
 266                "\n" ++
 267                "example.net (2):\n" ++
 268                "  user2\n" ++
 269                "  user4\n" ++
 270                "\n" ++
 271                "example.org (1):\n" ++
 272                "  user6\n"