Can I reflect messages out of a Haskell program at runtime? - haskell

Question

I’m writing a program that validates a complex data structure according to a number of complex rules. It inputs the data and outputs a list of messages indicating problems with the data.
Think along these lines:
import Control.Monad (when)
import Control.Monad.Writer (Writer, tell)
data Name = FullName String String | NickName String
data Person = Person { name :: Name, age :: Maybe Int }
data Severity = E | W | C -- error/warning/comment
data Message = Message { severity :: Severity, code :: Int, title :: String }
type Validator = Writer [Message]
report :: Severity -> Int -> String -> Validator ()
report s c d = tell [Message s c d]
checkPerson :: Person -> Validator ()
checkPerson person = do
case age person of
Nothing -> return ()
Just years -> do
when (years < 0) $ report E 1001 "negative age"
when (years > 200) $ report W 1002 "age too large"
case name person of
FullName firstName lastName -> do
when (null firstName) $ report E 1003 "empty first name"
NickName nick -> do
when (null nick) $ report E 1004 "empty nickname"
For documentation, I also want to compile a list of all messages this program can output. That is, I want to obtain the value:
[ Message E 1001 "negative age"
, Message W 1002 "age too large"
, Message E 1003 "empty first name"
, Message E 1004 "empty nickname"
]
I could move the messages out of checkPerson into some external data structure, but I like it when the messages are defined right at the spot where they are used.
I could (and probably should) extract the messages from the AST at compile time.
But the touted flexibility of Haskell made me thinking: can I achieve that at runtime? That is, can I write a function
allMessages :: (Person -> Validator ()) -> [Message]
such that allMessages checkPerson would give me the above list?
Of course, checkPerson and Validator need not stay the same.
I can almost (not quite) see how I could make a custom Validator monad with a “backdoor” that would run checkPerson in a sort of “reflection mode,” traversing all paths and returning all Messages encountered. I would have to write a custom when function that would know to ignore its first argument under some circumstances (which ones?). So, a kind of a DSL. Perhaps I could even emulate pattern matching?
So: can I do something like this, how, and what would I have to sacrifice?
Please feel free to suggest any solutions even if they do not exactly fit the above description.

Answer 1

This kind of half-static analysis is basically exactly what arrows were invented for. So let's make an arrow! Our arrow will basically be just a Writer action, but one that remembers what messages it might have spit out at any given moment. First, some boilerplate:
{-# LANGUAGE Arrows #-}
import Control.Arrow
import Control.Category
import Control.Monad.Writer
import Prelude hiding (id, (.))
Now, the type described above:
data Validator m a b = Validator
{ possibleMessages :: [m]
, action :: Kleisli (Writer m) a b
}
runValidator :: Validator m a b -> a -> Writer m b
runValidator = runKleisli . action
There are some straightforward instances to put in place. Of particular interest: the composition of two validators remembers messages from both the first action and the second action.
instance Monoid m => Category (Validator m) where
id = Validator [] id
Validator ms act . Validator ms' act' = Validator (ms ++ ms') (act . act')
instance Monoid m => Arrow (Validator m) where
arr f = Validator [] (arr f)
first (Validator ms act) = Validator ms (first act)
instance Monoid m => ArrowChoice (Validator m) where
left (Validator ms act) = Validator ms (left act)
All the magic is in the operation that actually lets you report something:
reportWhen :: Monoid m => m -> (a -> Bool) -> Validator m a ()
reportWhen m f = Validator [m] (Kleisli $ \a -> when (f a) (tell m))
This is the operation that notices when you're about to output a possible message, and makes a note of it. Let's copy your types and show how to code up checkPerson as an arrow. I've simplified your messages a little bit, but nothing important is different there -- just less syntactic overhead in the example.
type Message = String
data Name = FullName String String | NickName String -- http://www.kalzumeus.com/2010/06/17/falsehoods-programmers-believe-about-names/
data Person = Person { name :: Name, age :: Maybe Int }
checkPerson :: Validator Message Person ()
checkPerson = proc person -> do
case age person of
Nothing -> returnA -< ()
Just years -> do
"negative age" `reportWhen` (< 0) -< years
"age too large" `reportWhen` (>200) -< years
case name person of
FullName firstName lastName -> do
"empty first name" `reportWhen` null -< firstName
NickName nick -> do
"empty nickname" `reportWhen` null -< nick
I hope you'll agree that this syntax is not too far removed from what you originally wrote. Let's see it in action in ghci:
> runWriter (runValidator checkPerson (Person (NickName "") Nothing))
((),"empty nickname")
> possibleMessages checkPerson
["empty nickname","empty first name","age too large","negative age"]