In Haskell is dependency injection using ExistentialQuantification an anti-pattern? - haskell

I am a Haskell newbie, and I am thinking about how I can modularize my Rest application, which essentially passes around a ReaderT everywhere. I have devised a primitive working example of how to do that (below) using ExistentialQuantification. In a comment to a relevant answer, user MathematicalOrchid claimed something similar to be an anti-pattern. Is this an anti-pattern? In newbie terms, can you explain why if so and show a better alternative?
{-# LANGUAGE ExistentialQuantification #-}
import Control.Monad.Reader
import Control.Monad.Trans
import Data.List (intersect)
data Config = Config Int Bool
data User = Jane | John | Robot deriving (Show)
listUsers = [Jane, John, Robot]
class Database d where
search :: d -> String -> IO [User]
fetch :: d -> Int -> IO (Maybe User)
data LiveDb = LiveDb
instance Database LiveDb where
search d q = return $ filter ((q==) . intersect q . show) listUsers
fetch d i = return $ if i<3 then Just $ listUsers!!i else Nothing
data TestDb = TestDb
instance Database TestDb where
search _ _ = return [Robot]
fetch _ _ = return $ Just Robot
data Context = forall d. (Database d) => Context {
db :: d
, config :: Config
}
liveContext = Context { db = LiveDb, config = Config 123 True }
testContext = Context { db = TestDb, config = Config 123 True }
runApi :: String -> ReaderT Context IO String
runApi query = do
Context { db = db } <- ask
liftIO . fmap show $ search db query
main = do
let q = "Jn"
putStrLn $ "searching users for " ++ q
liveResult <- runReaderT (runApi q) liveContext
putStrLn $ "live result " ++ liveResult
testResult <- runReaderT (runApi q) testContext
putStrLn $ "test result " ++ testResult
Edit: a working example based on the accepted answer
import Control.Monad.Reader
import Control.Monad.Trans
import Data.List (intersect)
data Config = Config Int Bool
data User = Jane | John | Robot deriving (Show)
listUsers = [Jane, John, Robot]
data Database = Database {
search :: String -> IO [User]
, fetch :: Int -> IO (Maybe User)
}
liveDb :: Database
liveDb = Database search fetch where
search q = return $ filter ((q==) . intersect q . show) listUsers
fetch i = return $ if i<3 then Just $ listUsers!!i else Nothing
testDb :: Database
testDb = Database search fetch where
search _ = return [Robot]
fetch _ = return $ Just Robot
data Context = Context {
db :: Database
, config :: Config
}
liveContext = Context { db = liveDb, config = Config 123 True }
testContext = Context { db = testDb, config = Config 123 True }
runApi :: String -> ReaderT Context IO String
runApi query = do
d <- fmap db $ ask
liftIO . fmap show $ search d $ query
main = do
let q = "Jn"
putStrLn $ "searching users for " ++ q
liveResult <- runReaderT (runApi q) liveContext
putStrLn $ "live result " ++ liveResult
testResult <- runReaderT (runApi q) testContext
putStrLn $ "test result " ++ testResult

When you pattern-match on a Context, you get in the db field a value of a type that you can never know precisely; all you're allowed to know about it is that it's a Database instance, and thus you can use that class' methods with it. But that means that, from the point of view of the Context type, the existential d type affords it no more capabilities than this type does:
-- The "record of methods" pattern
data Database =
Database { search :: String -> IO [User]
, fetch :: Int -> IO (Maybe User)
}
liveDb :: Database
liveDb = Database search fetch
where search d q = return $ filter ((q==) . intersect q . show) listUsers
fetch d i = return $ if i<3 then Just $ listUsers!!i else Nothing
testDb :: Database
testDb = Database search fetch
where search _ _ = return [Robot]
fetch _ _ = return (Just Robot)
data Context =
Context { db :: Database
, config :: Config
}
That's the core argument against using existential types in the manner that you've done—there is a completely equivalent alternative that doesn't require existential types.

The argument against existential types is quite simple (and strong): often, you can avoid both the existential type and type class machinery, and use plain functions instead.
This is clearly the case where your class has the form
class D a where
method1 :: a -> T1
method2 :: a -> T2
-- ...
as in the posted Database example, since its instances can be replaced by values in a plain record type
data D = {
method1 :: T1
, method2 :: T2
-- ...
}
This is, essentially, the solution by #LuisCasillas .
However, note that the above translation relies on types T1,T2 not to depend on a. What if this is not the case? E.g. what if we had
class Database d where
search :: d -> String -> [User]
fetch :: d -> Int -> Maybe User
insert :: d -> User -> d
The above is a "pure" (no-IO) interface to a database, also allowing updates through insert. An instance could then be
data LiveDb = LiveDb [User]
instance Database LiveDb where
search (LiveDb d) q = filter ((q==) . intersect q . show) d
fetch (LiveDb d) i = case drop i d of [] -> Nothing ; (x:_) -> Just x
insert (LiveDb d) u = LiveDb (u:d)
Note that here we do use the parameter d, unlike in the original case where it was a placeholder.
Can we do without classes and existentials here?
data Database =
Database { search :: String -> [User]
, fetch :: Int -> Maybe User
, insert :: User -> Database
}
Notice that above we are returning an abstract Database in insert. This interface is more general than the existential-classy one, since it allows insert to change the underlying representation for the database. I.e., insert could move from a list-based representation to a tree-based one. This is like having insert acting from the existentially-quantified Database to itself, instead of from a concrete instance to itself.
Anyway, let's write LiveDb in the record-style way:
liveDb :: Database
liveDb = Database (search' listUsers) (fetch' listUsers) (insert' listUsers)
where search' d q = filter ((q==) . intersect q . show) d
fetch' d i = case drop i d of [] -> Nothing ; (x:_) -> Just x
insert' d u = Database (search' d') (fetch' d') (insert' d')
where d' = u:d
listUsers = [Jane, John, Robot]
Above I had to pass the underlying state d to each function, and in insert I had to update such state.
Overall, I find the above more involved than the instance Database LiveDb methods, which require no state-passing. Surely, we can apply a little refactoring and clarify the code:
makeLiveDb :: [User] -> Database
makeLiveDb d = Database search fetch insert
where search q = filter ((q==) . intersect q . show) d
fetch i = case drop i d of [] -> Nothing ; (x:_) -> Just x
insert u = makeLiveDb (u:d)
liveDb :: Database
liveDb = makeLiveDb [Jane, John, Robot]
This is a bit better, yet not as simple than the plain instance. There is no straightforward winner in this case, and which style to use is a matter of personal preference.
Personally, I stay away from existentially-quantified classes as much as possible, since in many, many cases they lose to much simpler approaches. However, I'm not dogmatic about them, and allow myself to use the "anti-pattern" when the alternative starts becoming too clumsy.
As an alternative, one could use an external function working at the abstract level, only:
data Database =
Database { search :: String -> [User]
-- let's neglect other methods for simplicity's sake
}
insert :: Database -> User -> Database
insert (Database s) u = Database s'
where s' str = s str ++ [ u | show u == str ] -- or something similar
The advantage of doing this is that insert works on the abstract Database, whatever its underlying data structure is. The disadvantage is that, in this way, insert can only access the database through its "methods", and can only work by building closures upon closures. If we also implemented a remove method, applying insert and delete many times will cause a larger and larger memory footprint, since remove can not remove the element from the underlying data structure, but can only build yet another closure which skips over the removed element. More pragmatically, it would be as if insert and remove simply appended to a log, and search scanned the log to see if the most recent action on an element was an insertion or a removal. This will not have a great performance.

Related

Can i get a record while pattern matching on its contents?

Basically, i want to pattern match on the contents of a record, and then return a modification of said record. So i have this sort of situation cropping up a lot:
updateChr :: Database -> Database -> Database
updateChr db Database{mode=1, characters=chr} = db{characters=(map someFunc chr)}
updateChr db Database{mode=2, characters=chr} = db{characters=(map someOtherFunc chr)}
Where the two Database arguments should always be the same record. Is there a way i can do this while only passing the record once?
You can make use an as pattern [Haskell-report]:
updateChr :: Database -> Database
updateChr db#Database{mode=1, characters=chr} = db {characters=(map someFunc chr)}
updateChr db#Database{mode=2, characters=chr} = db {characters=(map someOtherFunc chr)}
If you however always want to map the characters, you can here make use a guard:
updateChr :: Database -> Database
updateChr db#Database{mode=m, characters=chr} = db {characters=map f chr}
where f | m == 1 = someFunction
| otherwise = someOtherFunction

QuickCheck sequential Map key generation

I am trying to test a logic of custom data type. It receives a Map Int String as a parameter and then I need to add an element into the Map inside the object.
Type declaration and insertion function look like this:
import qualified Data.IntMap.Strict as M
import Data.UUID (UUID)
import Control.Monad.State
import System.Random
type StrMap = M.IntMap String
type MType = State StdGen
data MyType = MyType {
uuid :: UUID,
strs :: StrMap
} deriving (Show)
create :: StrMap -> MType MyType
create pm = do
state <- get
let (uuid, newState) = random state
put newState
return $ MyType uuid pm
strsSize :: MyType -> Int
strsSize e = M.size $ strs e
addStr :: MyType -> String -> MyType
addStr e p = e { strs = M.insert (strsSize e) p $ strs e }
It is important to have sequential keys in the Map, so having [0, 1, 3] is not acceptable.
I was trying to test it using HSpec with QuickCheck:
main :: IO ()
main = hspec spec
spec :: Spec
spec = describe "Creation and update" $ do
QuickCheck.prop "Check map addition" $ do
\xs str -> monadicIO $ do
state <- run(getStdGen)
let (result, newState) = runState (create xs) state
run(setStdGen newState)
let result' = addStr result str
assert $ (strsSize result) + 1 == strsSize result' -- fails here
The problem is that QuickCheck generates random keys and I am not sure how do I force it to generate a sequential keys for the Map. The problem with absense of the sequense is that function addStr may override values in case of repetetive keys, which is not desirable behavior.
UPDATE
Thanks for all the help! After a long discussion and some kind of a thinking I ended up with the following solution:
spec :: Spec
spec = describe "Creation and update" $ do
QuickCheck.prop "Check map addition" $ do
\xs str -> not (null xs) Property.==> monadicIO $ do
state <- run(getStdGen)
let mp = M.fromList $ zip [0..(length xs)] xs
let (result, newState) = runState (create mp) state
run(setStdGen newState)
let result' = addStr result str
assert $ (strsSize result) + 1 == strsSize result'
Basically, I had to generate some random set of strings and them convert in into a map manually. It is probably not the most elegant solution, but it works as needed.
Instead of using QuickCheck to generate arbitrary data that satisfies some complex invariant, which can be difficult, you can use QuickCheck to generate fully arbitrary data from which you can then construct data that satisfies the invariant (by some method external to the system being tested which you trust to be correct).
The invariant in this case is given as "keys must be contiguous", but is actually "keys must be contiguous and start from 0". This is sufficient, but more than necessary. The minimal invariant required by addStr is "the map must not contain a key that is the size of the map", since that is the key we intend to insert. By simplifying the constraint, we also make it easier to satisfy: we can generate an arbitrary map (which may contain the bad key) and then delete the bad key, giving a satisfactory map.
I'll also note that the UUID (and thus the mechanism for generating it, which requires State and perhaps IO) is irrelevant to the property being tested. This means we can construct the MyType with any UUID we have lying around (like the nil UUID provided by the package) and avoid the monadic stuff:
spec :: Spec
spec = describe "Creation and update" $ do
QuickCheck.prop "Check map addition" $ do
\strmap -> -- we don't actually care what the String being inserted is for this test
let myType = MyType UUID.nil (M.delete (M.size strmap) strmap) -- Enforce the invariant
in assert $ strsSize (addStr myType "") = strsSize myType + 1
If you wanted to, you could also make an instance of Arbitrary for MyType that does something like this, or something that satisfies the stronger invariant (which may be required for other tests). I'll leave that as an exercise for you, but feel free to ask more questions if you get stuck trying it.

Haskell Type Polymorphism -- Mapping to String

I am new to Haskell, so maybe I am missing some fundamental concepts here (or maybe failed to find the appropriate extension). I was wondering if there was a way to optimize or further abstract the following scenario. This code seems very redundant.
Let's say I have the following data classes:
data Person = Person
{ personName :: !String
, personAge :: !Int
} deriving Show
data Dog = Dog
{ dogName :: !String
, dogAge :: !Int
} deriving Show
Let's say I have a service and I'm only concerned with outputing records as strings. In reality, the strings will probably be JSON and the records fetched from the DB, but let's take a simpler case. I basically need a URL token to fetch an appropriate object (say, the string "dog" will get me a Dog, or even just the Haskell "show" string, without expressly declaring it as (value)::Dog).
I have attempted to implement this in several ways...the only thing that seems to work is the following:
data Creature = DogC Dog
| PersonC Person
deriving Show
fromString :: String -> Maybe Creature
fromString "dog" = Just $ DogC $ Dog "muffin" 8
fromString "person" = Just $ PersonC $ Person "John" 22
fromString _ = Nothing
main :: IO ()
main = do
putStrLn $ show $ fromString "dog"
I'm not entirely fond of the new type, nor the list of fromString declarations. And to benefit from the original data declarations, I would probably need to write a similarly tedious expression (eg, "fromCreature") to revert Creature back into my original types. This information might change, so I would probably need TH for a few of the declarations...
Is there a way around some of this? I fiddled with GADTs and classes, but both seemed to be dependent on type- rather than value- based polymorphism (A string identifier tends to cause issues with ambiguous instances). It would be nice to map the constructor to a string (Say, with Data.Map), but constructors often have different kinds.
Update
So, I went with an approach that isn't exactly relevant to the question I had asked, but it may be useful to someone. I did want to maintain some record types, but most didn't add much value and were getting in my way. The steps I had followed went something like:
Use a different/lower-level DB driver, that returns workable types (eg, [ColumnDef] and [[SQLValue]] instead of tuples and records...).
Create ToJSON instances for SQLValue -- most of the types were covered, except a few ByteString types, and I had to handle the conversion of SQLNull to Null. To maintain compatibility with some record types, my default handler looked like: toJSON = genericToJSON defaultOptions { sumEncoding = UnTaggedValue} The untagged value should allow one to read the JSON into defined data types (eg, Dog / Person ) if desired....
Given that column name is accessible from ColumnDef, I wrote an expression that zips [ColumnDef] and [SqlValue] to a list of Aeson-compatible key-value pairs, eg: toJsPairs :: [ColumnDef] -> [SqlValue] -> [(Text,Value)]
Then, I wrote an expression to fetch the JSON from a table name, which more or less serves as my "universal dispatcher." It references a list of authorized tables, so it's less crazy than it might sound.
The code looked a bit like this (using mysql-haskell).
{-# LANGUAGE OverloadedStrings #-}
import qualified Control.Applicative as App
import Database.MySQL.Base
import qualified System.IO.Streams as Streams
import Data.Aeson (FromJSON, ToJSON)
import Data.Aeson.Encode.Pretty (encodePretty)
import Data.Aeson.Types
import Data.Text.Encoding
import Data.String (fromString)
import Data.ByteString.Internal
import qualified Data.ByteString.Lazy.Internal as BLI
import Data.HashMap.Strict (fromList)
appConnectInfo = defaultConnectInfo {
ciUser = "some_user"
, ciPassword = "some_password"
, ciDatabase = "some_db"
}
instance FromJSON ByteString where
parseJSON (String s) = pure $ encodeUtf8 s
parseJSON _ = App.empty
instance ToJSON ByteString where
toJSON = String . decodeUtf8
instance ToJSON MySQLValue where
toJSON (MySQLNull) = Null
toJSON x = genericToJSON defaultOptions
{ sumEncoding = UntaggedValue } x
-- This expression should fail on dimensional mismatch.
-- It's stupidly lenient, but really dimensional mismatch should
-- never occur...
toJsPairs :: [ColumnDef] -> [MySQLValue] -> [(Text,Value)]
toJsPairs [] _ = []
toJsPairs _ [] = []
toJsPairs (x:xs) (y:ys) = (txt x, toJSON y):toJsPairs xs ys
where
-- Implement any modifications to the key names here
txt = decodeUtf8.columnName
listRecords :: String -> IO BLI.ByteString
listRecords tbl = do
conn <- connect appConnectInfo
-- This is clearly an injection vulnerability.
-- Implemented, however, the values for 'tbl' are intensely
-- vetted. This is just an example.
(defs, is) <- query_ conn $ fromString ( "SELECT * FROM `" ++ tbl ++ "` LIMIT 100")
rcrds <- Streams.toList is
return $ encodePretty $ map (jsnobj defs) rcrds
where
jsnobj :: [ColumnDef] -> [MySQLValue] -> Value
jsnobj defs x = Object $ fromList $ toJsPairs defs x
If what you want to consume at the end is json value - it might make sense to
represent result as json value using aeson library:
{-# LANGUAGE DeriveGeneric #-}
import Data.Aeson
import GHC.Generics
data Dog = Dog Int String deriving (Show, Generic)
data Cat = Cat Int String deriving (Show, Generic)
-- here I'm using instance derived with generics, but you can write one by
-- hands
instance ToJSON Dog
instance ToJSON Cat
-- actions to get stuff from db
getDog :: Monad m => Int -> m Dog
getDog i = return (Dog i (show i))
getCat :: Monad m => Int -> m Cat
getCat i = return (Cat i (show i))
-- dispatcher - picks which action to use
getAnimal :: Monad m => String -> Int -> m (Maybe Value)
getAnimal "dog" i = Just . toJSON <$> getDog i
getAnimal "cat" i = Just . toJSON <$> getCat i
getAnimal _ _ = return Nothing
main :: IO ()
main = do
getAnimal "dog" 2 >>= print
getAnimal "cat" 3 >>= print
getAnimal "chupakabra" 12 >>= print
High energy magic version
class Monad m => MonadAnimal m where
-- basically you want something that fetches extra argumets from HTTP or
-- whatevere, perform DB query and so on.
class Animal a where
animalName :: Proxy a -> String
animalGetter :: MonadAnimal m => m a
locateAnimals :: MonadAnimal m => Q [(String, m Value)]
locateAnimals -- implement using TH (reify function is your friend). It should look for
-- all the animal instances in scope and make a list from them with serialized
-- fetcher.
-- with that in place dispatcher should be easy to implement

Hide a function parameter in Haskell?

I need to backup some data to access it later.
At the interface level, I have two functions:
put: backs up data and returns a backup_Id.
get: retrieves data given a backup_Id.
My current code requires me to supply these two functions with the backup parameter.
import Data.Maybe
data Data = Data String deriving Show
type Backup = [(String,Data)]
put :: Backup -> String -> IO Backup
put boilerPlate a =
do let id = "id" ++ show(length (boilerPlate))
putStrLn $ id ++": " ++ a
return ((id,(Data a)):boilerPlate)
get :: Backup -> String -> Maybe Data
get boilerPlate id = lookup id (boilerPlate)
It works OK.
In the following sample, two values are backed up. The second one is retrieved.
main :: IO ()
main = do
let bp0 = []
bp1 <- put bp0 "a"
bp2 <- put bp1 "b"
let result = get bp2 "id1"
putStrLn $ "Looking for id1: " ++ show (fromJust(result))
But I need to simplify the signatures of put and get by getting rid of all the backup parameters.
I need something that looks like this:
main = do
put "a"
put "b"
let result = get "id1"
What is the simplest way to achieve this?
Here's an example using StateT. Note that the function names are changed because State and StateT already have get and put functions.
module Main where
import Control.Monad.State
data Data = Data String deriving Show
type Backup = [(String,Data)]
save :: String -> StateT Backup IO ()
save a = do
backup <- get
let id = "id" ++ ((show . length) backup)
liftIO $ putStrLn $ id ++ ": " ++ a
put ((id, Data a):backup)
retrieve :: String -> StateT Backup IO (Maybe Data)
retrieve id = do
backup <- get
return $ lookup id backup
run :: IO (Maybe Data)
run = flip evalStateT [] $ do
save "a"
save "b"
retrieve "id1"
main :: IO ()
main = do
result <- run
print result
The State monad threads a 'mutable' value through a computation. StateT combines State with other monads; in this case, allowing the use of IO.
As dfeuer mentioned, it is possible to make save and retrieve a bit more general with these types:
save :: (MonadState Backup m, MonadIO m) => String -> m ()
retrieve :: (MonadState Backup m, MonadIO m) => String -> m (Maybe Data)
(This also requires {-# LANGUAGE FlexibleContexts #-}) The advantage of this approach is that it allows our functions to work with any monad that provides the Backup state and IO. In particular, we can add effects to the monad and the functions will still work.
All this monad / monad transformer stuff can be pretty confusing at first, but it's actually pretty elegant once you get used to it. The advantage is that you can easily see what kind of effects are required in each function. That being said, I don't want you to think that there are things that Haskell can't do, so here's another way to achieve your goal which does away with the state monad in favor of a mutable reference.
module Main where
import Data.IORef
data Data = Data String deriving Show
type Backup = [(String,Data)]
mkSave :: IORef Backup -> String -> IO ()
mkSave r a = do
backup <- readIORef r
let id = "id" ++ ((show . length) backup)
putStrLn $ id ++ ": " ++ a
writeIORef r ((id, Data a):backup)
mkRetrieve :: IORef Backup -> String -> IO (Maybe Data)
mkRetrieve r id = do
backup <- readIORef r
return $ lookup id backup
main :: IO ()
main = do
ref <- newIORef []
let save = mkSave ref
retrieve = mkRetrieve ref
save "a"
save "b"
result <- retrieve "id0"
print result
Just be warned that this isn't usually the recommended approach.

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

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.
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"]

Resources