Lenses.elm

import Html exposing (text)
import Dict exposing (Dict)

out =
  toString >> text

main =
  [1, 2, 3]
  |> update headL (((+) 3 >> (*) 7) |> Maybe.map)
  |> set tailL ([1..20] |> Just)
  |> out

pairFirst : Lens (a, b) a
pairFirst =
  newL fst (snd >> flip (,))
  
pairSecond : Lens (a, b) b
pairSecond =
  newL snd (fst >> (,))

byKeyL : comparable -> Lens (Dict comparable v) (Maybe v)
byKeyL key =
  newL (Dict.get key) (\dict opt ->
    case opt of
      Just v -> dict |> Dict.insert key v
      Nothing -> dict |> Dict.remove key)

headL : Lens (List a) (Maybe a)
headL =
  Lens <| \list ->
    let
      headOpt = list |> List.head
      tailOpt = list |> List.tail
    in
      ( headOpt
      , Maybe.map2 ((::) |> flip) tailOpt >> Maybe.withDefault []
      )

tailL : Lens (List a) (Maybe (List a))
tailL =
  Lens <| \list ->
    let
      headOpt = list |> List.head
      tailOpt = list |> List.tail
    in
      ( tailOpt
      , Maybe.map2 (::) headOpt >> Maybe.withDefault []
      )

unconsL : Lens (List a) (Maybe (a, List a))
unconsL =
  Lens <| \list ->
    let
      headOpt = (list |> List.head)
      tailOpt = (list |> List.tail)
    in
      ( Maybe.map2 (,) headOpt tailOpt
      , Maybe.map ((::) |> uncurry) >> Maybe.withDefault []
      )

type alias Endo p = p -> p

type Lens w p = Lens (w -> (p, p -> w))

newL : (w -> p) -> (w -> p -> w) -> Lens w p
newL getter setter =
  Lens <| \whole -> (whole |> getter, whole |> setter)

split : Lens w p -> w -> (p, p -> w)
split (Lens splitter) whole =
  whole |> splitter


(@) : Lens a b -> Lens b c -> Lens a c
(@) = composeLenses

infixl 9 @

composeLenses : Lens a b -> Lens b c -> Lens a c
composeLenses lensAB lensBC =
  Lens <| \a ->
    let
      (b, withB) = a |> split lensAB
      (c, withC) = b |> split lensBC
    in
      (c, withC >> withB)

update : Lens w p -> Endo p -> Endo w
update lens endo whole =
  whole |> split lens |> \(part, withPart) -> part |> endo |> withPart

set : Lens w p -> p -> w -> w
set lens part whole =
  part |> (whole |> split lens |> snd)
    
get : Lens w p -> w -> p
get lens whole =
  whole |> split lens |> fst