Composable Lensing

Question

I have the following Haskell types

import Control.Lens
import Data.Map.Lens
import qualified Data.Map as M

type RepoStats = M.Map String (M.Map String RepoStat)
data RepoStat = RepoStat {
  _full_name :: String,
  _bug_count :: Maybe Int,
  _commit_count :: Maybe Int
  }
  deriving (Generic, Show, Eq, Read)
makeLenses ''RepoStat

I would like to be able to abstract out the nested checking for the values and giving defaults:

makeStat name bug commit =
    RepoStat
    { _full_name = name
    , _bug_count = Just bug
    , _commit_count = Just commit
    }

getRepoStat :: String -> String -> (RepoStat -> Identity RepoStat) -> RepoStats -> Identity RepoStats
getRepoStat k1 k2 = at k1 . non (M.empty) . at k2 . non (makeStat k2 0 0)

fakeMap = M.empty :: RepoStats
setBug = fakeMap & (getRepoStat "a" "b") . bug_count ?~ 4
getBug = fakeMap ^. (getRepoStat "a" "b") . bug_count

setBug compiles and works, but getBug does not.

test/Spec.hs:65:21: Couldn't match type ‘Identity RepoStats’ …
                   with ‘Const RepoStat RepoStats’
    Expected type: Getting RepoStat RepoStats RepoStat
      Actual type: (RepoStat -> Identity RepoStat)
                   -> RepoStats -> Identity RepoStats
    In the second argument of ‘(^.)’, namely ‘(getRepoStat "a" "b")’
    In the expression: fakeDb ^. (getRepoStat "a" "b")
Compilation failed.

Is it possible to abstract out a lens in this way?

Answer 1

It's useful to just remove the type signature:

getRepoStat k1 k2 = at k1 . non M.empty . at k2 . non (makeStat k2 0 0)

Now we can look at the inferred type with :t getRepoStat in ghci.

It's a bit messy, chiefly because at is overloaded:

getRepoStat
  :: (Functor f, At m, IxValue m ~ M.Map String RepoStat) =>
     Index m -> String -> (RepoStat -> f RepoStat) -> m -> f m

We can recognize though that we return a Lens' and we can also restrict the context of the lens to RepoStats:

getRepoStat :: String -> String -> Lens' RepoStats RepoStat
getRepoStat k1 k2 = at k1 . non M.empty . at k2 . non (makeStat k2 0 0)