Last active

Embed URL

HTTPS clone URL

SSH clone URL

You can clone with HTTPS or SSH.

Download Gist

Experimenting with the Builder pattern in Control.Lens

View LensBuilder.hs
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148
{-# 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
where
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
where
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
where
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
where
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)
Owner

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.