
Hello there, I'm starting to use a bit more extensively the lens package. It is clearly very powerful, but it feels like a maze of related components (Setting/Setter/Lens'/LensLike/Lens/Traversal/Traversal') which can be swapped for one another except when they can't. The first (concrete) problem I ran into is how to update the members of a set with the result of an IO action. I have managed to do this with a pure function (prefixName) but I'm not sure of how to do this with promptName. Full program below: {-# LANGUAGE TemplateHaskell #-} import Control.Lens import Data.Set import Data.Set.Lens data Dog = Dog { _name :: String, _legs :: Int } deriving (...) makeLenses ''Dog data Dogs = Dogs { _dogs :: Set Dog } deriving Show makeLenses ''Dogs fourLegs :: Traversal' Dog Dog fourLegs = filtered (λd -> d^.legs == 4) promptName :: String -> IO String promptName dogName = do putStr $ "New name for " ++ dogName getLine prefixName :: Dog -> Dog prefixName dog = set name ("PREFIXED: " ++ dog^.name) dog main :: IO () main = do let fido = Dog "fido" 4 let milou = Dog "milou" 4 let cripple = Dog "cripple" 3 let doggies = Dogs $ fromList [fido, milou, cripple] -- prefix dog names via a pure function let doggies' = over (dogs.setmapped) prefixName doggies print doggies' -- change dog names by prompting the user ? return () Help would be appreciated (in particular, 'cripple' would love to be renamed). Since I was struggling with the library, I had the idea to look at the internals, but got stuck at the definition of Lens: type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t a) I'm not sure why the explicit forall is needed here (isn't this equivalent to just Functor f => ...)? b) My understanding is that a lens packs both getter and setters, but I don't know which is supposed to be which here... c) Is there any kind of in-depth guide to Control.Lens somewhere? I have found some examples and tutorials but nothing that seemed to do more than scratch the surface. Thanks, Emm