X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FReport.hs;fp=src%2FReport.hs;h=e248879225323cfd32f0ba5e213192db659b42af;hb=0f6ab35ca71299d1c9db63a12df2329acf123284;hp=0000000000000000000000000000000000000000;hpb=72482968102ebd7ad0abeef958fed2a02a126dd2;p=mailbox-count.git

diff --git a/src/Report.hs b/src/Report.hs
new file mode 100644
index 0000000..e248879
--- /dev/null
+++ b/src/Report.hs
@@ -0,0 +1,238 @@
+{-# LANGUAGE PatternGuards #-}
+
+module Report (
+  report,
+  report_tests )
+where
+
+import Data.List ( foldl' )
+import qualified Data.Map as Map ( Map, alter, empty, foldl, mapWithKey )
+import Data.Maybe ( catMaybes )
+import Data.String.Utils ( join )
+import Database.HDBC (
+  IConnection,
+  SqlValue,
+  safeFromSql,
+  quickQuery )
+import Database.HDBC.Sqlite3 ( connectSqlite3 )
+import Test.Tasty ( TestTree, testGroup )
+import Test.Tasty.HUnit ( (@?=), testCase )
+
+
+-- Type synonyms to make the signatures below a little more clear.
+type Domain = String
+type Username = String
+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)
+
+
+-- | A wrapper around a (domain, user) pair to keep things type-safe.
+data DomainUser =
+  DomainUser Domain Username
+  deriving (Show)
+
+
+-- | In the detailed report, we store the usernames as a map from a
+--   domain name to a list of usernames. This type synonym is the type
+--   of that map.
+type DomainUserMap = Map.Map Domain [Username]
+
+
+-- | Convert a list of [SqlByteString, SqlInt32] to 'DomainCount's. If
+--   the conversion doesn't work for some reason (bad data, not enough
+--   columns, etc.), we return 'Nothing'.
+--
+--   Examples:
+--
+--   >>> import Database.HDBC ( iToSql, toSql )
+--
+--   >>> list_to_domain_count [toSql "example.com", iToSql 100]
+--   Just example.com: 100
+--
+--   >>> list_to_domain_count [toSql "example.com"]
+--   Nothing
+--
+--   >>> list_to_domain_count [toSql "example.com", toSql "example.com"]
+--   Nothing
+--
+list_to_domain_count :: [SqlValue] -> Maybe DomainCount
+list_to_domain_count (domain:count:_)
+  | Right d <- safeFromSql domain,
+    Right c <- safeFromSql count = Just $ DomainCount d c
+list_to_domain_count _ =
+  Nothing
+
+
+-- | Convert a list of [SqlByteString, SqlByteString] to 'DomainUser's. If
+--   the conversion doesn't work for some reason (bad data, not enough
+--   columns, etc.), we return 'Nothing'.
+--
+--   Examples:
+--
+--   >>> import Database.HDBC ( toSql )
+--   >>>
+--   >>> list_to_domain_user [toSql "example.com", toSql "user1"]
+--   Just (DomainUser "example.com" "user1")
+--
+--   >>> list_to_domain_user [toSql "example.com"]
+--   Nothing
+--
+list_to_domain_user :: [SqlValue] -> Maybe DomainUser
+list_to_domain_user (domain:user:_)
+  | Right d <- safeFromSql domain,
+    Right u <- safeFromSql user = Just $ DomainUser d u
+list_to_domain_user _ =
+  Nothing
+
+
+summary_header :: String
+summary_header = "Summary (number of mailboxes per domain)\n" ++
+                 "----------------------------------------"
+
+report_summary :: IConnection a => a -> IO String
+report_summary conn = 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)
+  return $ join "\n" report_lines
+  where
+    query = "SELECT domain,COUNT(username) " ++
+            "FROM mailbox " ++
+            "GROUP BY domain "++
+            "ORDER BY domain;"
+
+
+-- | Construct a Domain -> [Username] (a DomainUserMap) map from a
+--   list of 'DomainUser's. We do this with a fold over the list of
+--   'DomainUser's, appending each new user to the list associated
+--   with the domain that the user is paired with.
+--
+--   The [Username] lists (the values stored in the map) are kept in
+--   the same order as they are given.
+--
+--   Examples:
+--
+--   >>> let du1 = DomainUser "example.com" "user1"
+--   >>> let du2 = DomainUser "example.com" "user2"
+--   >>> let du3 = DomainUser "example.net" "user3"
+--   >>> construct_domain_user_map [du1,du2,du3]
+--   fromList [("example.com",["user1","user2"]),("example.net",["user3"])]
+--
+--   >>> construct_domain_user_map [du2,du1,du3]
+--   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
+  where
+    append_func :: Username -> (Maybe [Username]) -> (Maybe [Username])
+    append_func user maybe_userlist =
+      case maybe_userlist of
+        Just userlist -> Just (userlist ++ [user])
+        Nothing       -> Just [user]
+
+    append_this_du :: DomainUserMap -> DomainUser -> DomainUserMap
+    append_this_du du_map (DomainUser domain user) =
+      Map.alter (append_func user) domain du_map
+
+
+detail_header :: String
+detail_header = "Detail (list of all mailboxes by domain)\n" ++
+                "----------------------------------------"
+
+report_detail :: IConnection a => a -> IO String
+report_detail conn = 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 domain_users_map = construct_domain_user_map domain_users
+
+  -- This maps domains to a string listing their users
+  let domain_report_map = Map.mapWithKey format_domain domain_users_map
+  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 ++ ":"
+        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)
+
+
+
+-- * Tests
+
+report_tests :: TestTree
+report_tests =
+  testGroup "Report Tests" [ test_summary_report, test_detail_report ]
+
+
+test_summary_report :: TestTree
+test_summary_report =
+  testCase desc $ do
+    conn <- connectSqlite3 "test/fixtures/postfixadmin.sqlite3"
+    actual <- report_summary conn
+    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"
+
+
+test_detail_report :: TestTree
+test_detail_report =
+  testCase desc $ do
+    conn <- connectSqlite3 "test/fixtures/postfixadmin.sqlite3"
+    actual <- report_detail conn
+    actual @?= expected
+  where
+    desc = "Detail report looks like it should"
+    expected = detail_header ++
+               "\n" ++
+               "example.com:\n" ++
+               "  user1\n" ++
+               "  user3\n" ++
+               "  user5\n" ++
+               "\n" ++
+               "example.net:\n" ++
+               "  user2\n" ++
+               "  user4\n" ++
+               "\n" ++
+               "example.org:\n" ++
+               "  user6\n"