Skip to content
Create a gist now

Instantly share code, notes, and snippets.

Experimenting with the Builder pattern in Control.Lens
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE Arrows #-}
{- Some ideas on the common Builder pattern from the OO world in the context of lenses -}
module Main where
import Control.Arrow
import Control.Lens
import Data.Default
import Data.Void
import qualified Data.Map as Map
import Control.Monad.State
{- Imagine you have a rich data structure with fields like this: -}
data ContactInfo = ContactInfo {
_ciName :: String,
_ciStreet :: String,
_ciCity :: String,
_ciProvince :: String,
_ciPostalCode :: String
} deriving (Eq, Show)
{- And you then do things like this: -}
{- Build a contact from some input; say, from a map: -}
contactMaker1 :: (Map.Map String String) -> Maybe ContactInfo
contactMaker1 m = do
name' <- Map.lookup "name" m
street' <- Map.lookup "street" m
city' <- Map.lookup "city" m
province' <- Map.lookup "state" m
postalCode' <- Map.lookup "zip" m
return $ ContactInfo street' name' city' province' postalCode'
{- But WAIT! That's wrong. street' and name' were used in the wrong order there.
If only we had a way to match the name of the field to what we were pulling: -}
{- Lenses, especially makeFields, help us with that -}
makeFields ''ContactInfo
instance Default ContactInfo where
def = ContactInfo def def def def def
{- So now we can do: -}
contactMaker2 :: (Map.Map String String) -> Maybe ContactInfo
contactMaker2 m = execStateT doIt def
getVal str = lift (Map.lookup str m)
doIt :: StateT ContactInfo Maybe ()
doIt = do name <~ getVal "name"
street <~ getVal "street"
city <~ getVal "city"
province <~ getVal "state"
postalCode <~ getVal "zip"
{- No more argument order issues! You can even swap stuff around: -}
contactMaker2' :: (Map.Map String String) -> Maybe ContactInfo
contactMaker2' m = execStateT doIt def
getVal str = lift (Map.lookup str m)
doIt :: StateT ContactInfo Maybe ()
doIt = do name <~ getVal "name"
city <~ getVal "city"
street <~ getVal "street"
province <~ getVal "state"
postalCode <~ getVal "zip"
{- And that's cool, but you can also do this, and have it compile: -}
contactMaker3 :: (Map.Map String String) -> Maybe ContactInfo
contactMaker3 m = execStateT doIt def
getVal str = lift (Map.lookup str m)
doIt :: StateT ContactInfo Maybe ()
doIt = do name <~ getVal "name"
street <~ getVal "street"
{- Missing field! -}
province <~ getVal "state"
postalCode <~ getVal "zip"
{- So here's something to address that: it provides type-safety guarantees
that you have all the fields, but provides nice order independence by
connecting the fields to the values that fill them.
{- imagine something like makeFields that autogenerated this, so in real code
you wouldn't need to read this, you'd just see something like
makeBuilder ''ContactInfo
data B'CI q = B'CI q
b'name :: Setter (B'CI (Void, a, b, c, d)) (B'CI (String, a, b, c, d)) Void String
b'name = sets (\m (B'CI q) -> B'CI ((_1 %~ m) q))
b'street :: Setter (B'CI (a, Void, b, c, d)) (B'CI (a, String, b, c, d)) Void String
b'street = sets (\m (B'CI q) -> B'CI ((_2 %~ m) q))
b'city :: Setter (B'CI (a, b, Void, c, d)) (B'CI (a, b, String, c, d)) Void String
b'city = sets (\m (B'CI q) -> B'CI ((_3 %~ m) q))
b'province :: Setter (B'CI (a, b, c, Void, d)) (B'CI (a, b, c, String, d)) Void String
b'province = sets (\m (B'CI q) -> B'CI ((_4 %~ m) q))
b'postalCode :: Setter (B'CI (a, b, c, d, Void)) (B'CI (a, b, c, d, String)) Void String
b'postalCode = sets (\m (B'CI q) -> B'CI ((_5 %~ m) q))
b'ContactInfo :: B'CI (String, String, String, String, String)
-> ContactInfo
b'ContactInfo (B'CI (a, b, c, d, e)) = ContactInfo a b c d e
emptyB'CI :: B'CI (Void, Void, Void, Void, Void)
emptyB'CI = B'CI (undefined, undefined, undefined, undefined, undefined)
{- Now also imagine a Control.Lens.Arrow package with this in it: -}
(<~~) :: (Arrow ar) => ASetter s t a b -> ar s b -> ar s t
setter <~~ arrval = proc x -> do
bval <- arrval -< x
returnA -< x & setter .~ bval
-- (arr (flip $ set setter) &&& arrval) >>> first (arr arr) >>> app
{- Now we can do this: -}
contactMaker4 :: (Map.Map String String) -> Maybe ContactInfo
contactMaker4 m = runKleisli doIt emptyB'CI
getVal str = Kleisli (const $ Map.lookup str m)
doIt = b'name <~~ getVal "name"
>>> b'province <~~ getVal "state"
>>> b'postalCode <~~ getVal "zip"
>>> b'city <~~ getVal "city"
>>> b'street <~~ getVal "street"
>>> arr b'ContactInfo
{- And voila - order independence but with compile-time guarantees that
I didn't forget one of the fields -}
{- Just to prove that it doesn't merely compile, actually works: -}
main :: IO ()
main = do let m = Map.fromList [("name", "Mary Sue"),
("state", "DE"),
("city", "Newark"),
("street", "134 Lukas St."),
("zip", "18765")]
print (contactMaker4 m)
fizbin commented Mar 24, 2014

Note that (<~~) now exists as Control.Lens.Setter.assignA

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.