Paths, lenses combined with a name.

gistfile1.hs

{-# LANGUAGE
    Arrows
  , FlexibleInstances
  , MultiParamTypeClasses
  , TypeOperators
  #-}
module Path where

import Control.Arrow
import Control.Category
import Control.Monad.Writer
import Data.Text (Text, splitOn)
import Prelude hiding ((.), id)

import qualified Data.Text           as Text
import qualified Data.Label.Abstract as Label

{-# INLINE get    #-}
{-# INLINE set    #-}
{-# INLINE modify #-}

parse :: Text -> [Text]
parse t =
  case splitOn "/" t of
    []   -> []
    x:xs -> map Text.strip (x : filter (not . Text.null) xs)

-- | Paths are lenses that store an observable textual path from the outer
-- structure to the inner value that they reference.

data Path arr f a = Path
  { segments :: [Text]
  , run      :: Label.Lens arr f a
  }

instance ArrowApply arr => Category (Path arr) where
  id                  = Path [] id
  Path n a . Path m b = Path (n <> m) (a . b)
  {-# INLINE id  #-}
  {-# INLINE (.) #-}

lens :: Text -> (f `arr` a) -> ((a, f) `arr` f) -> Path arr f a
lens n g s = Path [n] (Label.lens g s)

get :: Arrow arr => Path arr f a -> f `arr` a
get = Label.get . run

set :: Arrow arr => Path arr f a -> (a, f) `arr` f
set = Label.set . run

modify :: ArrowApply arr => Path arr f o -> (o `arr` o, f) `arr` f
modify = Label.modify . run

instance Arrow arr => Label.Iso arr (Path arr f) where
  iso bi = proc (Path n l) ->
           do m <- Label.iso bi -< l;
              id -< Path n m
  {-# INLINE iso #-}