[Haskell-beginners] Lens

Emmanuel Surleau emmanuel.surleau at gmail.com
Sun Jul 14 22:47:16 CEST 2013


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
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/beginners/attachments/20130714/0331337e/attachment.htm>


More information about the Beginners mailing list