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)

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