How to abstract over a “back and forth” transformation?

Question

Consider this example (from https://codereview.stackexchange.com/questions/23456/crtitique-my-haskell-function-capitalize):

import Data.Char

capWord [] = []
cap         


        

Answer 1

You could use a lens for this. Lenses are quite a lot more general than this I think, but anything where you have such bidirectional functions can be made into a lens.

For example, given words and unwords, we can make a worded lens:

worded :: Simple Iso String [String]
worded = iso words unwords

Then you can use it to apply a function inside the lens, e.g. lifted f x becomes (worded %~ f) x. The only downside of lenses is that the library is extremely complicated, and has many obscure operators like %~, even though the core idea of a lens is actually quite simple.

EDIT: This is not an isomorphism

I had incorrectly assumed that unwords . words is equivalent to the identity function, and it is not, because extra spaces between words are lost, as correctly pointed out by several people.

Instead, we could use a much more complicated lens, like the following, which does preserve the spacing between words. Although I think it's still not an isomorphism, this does at least mean that x == (x & worded %~ id), I hope. It is on the other hand, not in the least a very nice way of doing things, and not very efficient. It is possible that an indexed lens of the words themselves (rather than a list of the words) may be better, although it permits fewer operations (I think, it's really hard to tell when lenses are involved).

import Data.Char (isSpace)
import Control.Lens

worded :: Simple Lens String [String]
worded f s =
    let p = makeParts s
    in fmap (joinParts p) (f (takeParts p))

data Parts = End | Space Char Parts | Word String Parts

makeParts :: String -> Parts
makeParts = startPart
    where
      startPart [] = End
      startPart (c:cs) =
          if isSpace c then Space c (startPart cs) else joinPart (Word . (c:)) cs

      joinPart k [] = k [] End
      joinPart k (c:cs) =
          if isSpace c then k [] (Space c (startPart cs)) else joinPart (k . (c:)) cs

takeParts :: Parts -> [String]
takeParts End = []
takeParts (Space _ t) = takeParts t
takeParts (Word s t) = s : takeParts t

joinParts :: Parts -> [String] -> String
joinParts _ [] = []
joinParts (Word _ End) (ws@(_:_:_)) = unwords ws
joinParts End ws = unwords ws
joinParts (Space c t) ws = c : joinParts t ws
joinParts (Word _ t) (w:ws) = w ++ joinParts t ws