A pedant that hangs out in the dark corner-cases of the web.

Wednesday, December 31, 2014

Using SQL Type Providers and FSharp.Charting to generate an email report with inline charts in F#


open System
// Needed to send an email with the charts.
open System.Net.Mail
open System.Net.Mime
// Needed for FSharp.Charting's ShowChart() method.
#r "System.Windows.Forms.DataVisualization"

// Tip: Create a paket.dependencies file to install FSharp.Data.SqlClient and FSharp.Charting.
//   see http://fsprojects.github.io/Paket/
#I @".\packages\FSharp.Data.SqlClient\lib\net40"
#r "FSharp.Data.SqlClient"
open FSharp.Data
#I @".\packages\FSharp.Charting\lib\net40"
#r "FSharp.Charting"
open FSharp.Charting

// Install the AdventureWorks2014 database from 
// https://msftdbprodsamples.codeplex.com/releases/view/125550
// With VS installed, you should be able to unzip 
// Adventure Works 2014 OLTP Script.zip into
// C:\Program Files\Microsoft SQL Server\120\Tools\Samples\Adventure Works 2014 OLTP Script
// (depending on version) then run something like
// sqlcmd.exe -E -S "(localdb)\ProjectV12" -i instawdb.sql
// (from that directory, running in a PowerShell or cmd prompt as admin).

/// Use the SQL Server Type Provider to define a type-safe query for the top products (by $ amount)
/// summary order amount statistics by date.
type OrderCmd = SqlCommandProvider<"
select p.Name, p.ProductID, o.OrderDate, sum(od.LineTotal) Total, 
       min(od.LineTotal) MinAmt, max(od.LineTotal) MaxAmt, 
       avg(od.LineTotal) AvgAmt, coalesce(stdev(od.LineTotal),0.0) StDevAmt, 
       (max(od.LineTotal) - min(od.LineTotal)) / 2 + min(od.LineTotal) MedianAmt
  from Production.Product p
  join Sales.SalesOrderDetail od
    on p.ProductID = od.ProductID
  join Sales.SalesOrderHeader o
    on od.SalesOrderID = o.SalesOrderID
 where p.ProductID in (select top 5 pod.ProductID from Sales.SalesOrderDetail pod 
       group by pod.ProductID order by sum(pod.LineTotal) desc)
   and o.OrderDate between '2014-03-01' and '2014-03-31'
 group by p.ProductID, p.Name, o.OrderDate
 order by p.ProductID, o.OrderDate
","server=(localdb)\ProjectsV12;database=AdventureWorks2014;integrated security=SSPI">
/// An instance of the query type.
let getOrders = new OrderCmd()

/// Converts a product name, record sequence tuple into a product name, sum total amount tuple.
let productTotal (n,p:OrderCmd.Record seq) = 
    n, Seq.sumBy (fun (d:OrderCmd.Record) -> d.Total.Value) p
/// Converts a record into a date, max amount tuple if it differs from the average amount.
let dateMax = 
    function 
    | (d:OrderCmd.Record) when d.MaxAmt.Value <> d.AvgAmt.Value 
        -> Some (d.OrderDate, d.MaxAmt.Value) 
    | _ -> None
/// Converts a record into a date, standard deviation of amount tuple if one exists.
let dateStDev = 
    function 
    | (d:OrderCmd.Record) when d.StDevAmt.Value <> 0.0 
        -> Some (d.OrderDate, float d.AvgAmt.Value + d.StDevAmt.Value) 
    | _ -> None
/// Converts a record into a date, average amount tuple.
let dateAvg (d:OrderCmd.Record) = d.OrderDate, d.AvgAmt.Value

/// Collects the records by product name, caching to prevent re-reading from a closed data reader.
let products = getOrders.Execute() |> Seq.cache |> Seq.groupBy (fun o -> o.Name)

/// Saves a chart to a temporary file, and returns a LinkedResource object for emailing.
let saveChart (c:ChartTypes.GenericChart) = 
    let file = IO.Path.ChangeExtension(IO.Path.GetTempFileName(),"png")
    // Needed to render to file. This is a workaround for bug #38
    // see https://github.com/fsharp/FSharp.Charting/issues/38
    // (This will display a window with the chart.)
    c.ShowChart() |> ignore
    c.SaveChartAs(file,ChartTypes.ChartImageFormat.Png)
    new LinkedResource(file,"image/png")

// For each product, build a compound chart, then append those to a list containing the 
// summary pie chart, and save them all for emailing.
/// The collection of charts, as LinkResource objects for emailing.
let charts =
    products 
        |> Seq.toList
        |> List.map 
            (fun (p,o) -> 
                Chart.Combine(charts=
                    [ Chart.Point(Title=p,Color=Drawing.Color.Red,
                        data=Seq.choose dateMax o)
                      Chart.Point(Color=Drawing.Color.DarkOrange,
                        data=Seq.choose dateStDev o)
                      Chart.Column(Color=Drawing.Color.Blue,
                        data=Seq.map dateAvg o) ]))
        |> List.append 
            [Chart.Pie(Title="Top 5 Products, March 2014",
                data=Seq.map productTotal products)]
        |> List.map saveChart

/// Sends an email to the given address, with the given subject, using the LinkedResource 
/// objects as inline images in the body of the message.
let sendCharts (t:string) s c =
    /// The email message, initialized with the subject value.
    /// The default from address is set in machine.config's
    /// /configuration/system.net/mailSettings/smtp/@from
    let email = new MailMessage(Subject=s)
    email.To.Add(t)
    /// The HTML body of the email: inline images of the provided LinkedResource objects.
    let body = 
        List.map (fun (i:LinkedResource) -> 
                    sprintf "<div><img src='cid:%s' /></div>" i.ContentId) c 
            |> String.concat "\n"
    /// Create the body as an AlternateView object, to support inline images.
    use view = 
        AlternateView.CreateAlternateViewFromString(body, 
            ContentType MediaTypeNames.Text.Html)
    Seq.iter view.LinkedResources.Add c
    email.AlternateViews.Add(view)
    /// The SMTP sender, configured in the machine.config's
    /// /configuration/system.net/mailSettings element.
    use send = new SmtpClient()
    send.Send(email)

// Send the email.
sendCharts "test@example.net" "Top Products Charts" charts

Thursday, August 07, 2014

Macro to set Outlook email expiration with subject hashtag

When you return from vacation, you probably have a ton of irrelevant spam for events that happened while you were gone but are no longer useful, like:
  • people leaving early/coming in late
  • lunch/available food
  • server reboots
  • weather/traffic warnings
One way to reduce this noise is to set an expiration on emails of this nature. Sadly, Microsoft Outlook has deeply hidden the UI to do this, so most people don't remember, can't figure it out, or can't be bothered.
Here is a macro that lets you set the expiration date for an email by just adding certain hashtags to your subject. Adding #today sets the expiration for the end of the day, otherwise you can use ISO 8601 durations as hashtags, like #PT2H for two hours, or #P1W for a week.

Public WithEvents Item As Outlook.MailItem

Private Function DateUnit(ByVal isoUnit, ByVal isYmwdPart) As String
    Select Case isoUnit
        Case "Y": DateUnit = "yyyy"
        Case "W": DateUnit = "ww"
        Case "M":
            If isYmwdPart Then
                DateUnit = "m"
            Else
                DateUnit = "n"
            End If
        Case Else: DateUnit = isoUnit
    End Select
End Function

Private Function AddIsoDuration(ByVal start As Date, ByVal isoDuration As String) As Date
    Dim value, durationMatch, nextPart
    value = start
    Set durationMatch = New RegExp
    durationMatch.Pattern = "^(P((\d+[YMWD])*)(T((\d+[HMS])+))?)$"
    Set nextPart = New RegExp
    nextPart.Pattern = "^(\d+)([YMWDHMS])"
    Set matched = durationMatch.Execute(isoDuration)(0)
    ymwd = matched.SubMatches(1)
    hms = matched.SubMatches(4)
    Do Until Len(ymwd) = 0
        Set part = nextPart.Execute(ymwd)(0)
        value = DateAdd(DateUnit(part.SubMatches(1), True), CInt(part.SubMatches(0)), value)
        ymwd = Mid(ymwd, Len(part) + 1)
    Loop
    Do Until Len(hms) = 0
        Set part = nextPart.Execute(hms)(0)
        value = DateAdd(DateUnit(part.SubMatches(1), False), CInt(part.SubMatches(0)), value)
        hms = Mid(hms, Len(part) + 1)
    Loop
    AddIsoDuration = value
End Function

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Dim durationMatch
    Set durationMatch = New RegExp
    durationMatch.Pattern = "#(P(\d+[YMWD])*(T(\d+[HMS])+)?)\b"
    ExpiryTime = Item.ExpiryTime
    If InStr(1, Item.Subject, "#today", vbTextCompare) > 0 Then
        If ExpiryTime = #1/1/4501# Then
            Item.ExpiryTime = DateAdd("d", 1, Date)
        End If
    ElseIf durationMatch.Test(Item.Subject) Then
        If ExpiryTime = #1/1/4501# Then
            Item.ExpiryTime = AddIsoDuration(Now, durationMatch.Execute(Item.Subject)(0).SubMatches(0))
        End If
    End If
    Item.Save
End Sub