add recmapZipOnto fn family
recmapZipOnto functions respect Terminal types
This commit is contained in:
parent
d7224d5074
commit
f2c7c04e2c
1 changed files with 28 additions and 10 deletions
|
|
@ -19,6 +19,12 @@
|
|||
Some
|
||||
None
|
||||
;
|
||||
|
||||
inherit
|
||||
(this.terminal)
|
||||
isTerminal
|
||||
unwrapTerminal
|
||||
;
|
||||
in rec {
|
||||
# getAttrAt :: [String] -> Attrs -> Maybe a
|
||||
# Given an attribute set path as a list of strings,
|
||||
|
|
@ -45,21 +51,33 @@ in rec {
|
|||
# recmapFrom :: [String] -> ([String] -> Attrs -> a) -> Attrs -> a | Attrs a
|
||||
# Alternative to mapAttrsRecursiveCond
|
||||
# Allows mapping directly from a child path
|
||||
recmapFrom = path: f: T:
|
||||
if isAttrs T
|
||||
then mapAttrs (attr: leaf: recmapFrom (path ++ [attr]) f leaf) T
|
||||
recmapCondFrom = path: cond: f: T: let
|
||||
delegate = path': recmapCondFrom path' cond f;
|
||||
in
|
||||
if isAttrs T && cond path T
|
||||
then T |> mapAttrs (attr: leaf: delegate (path ++ [attr]) leaf)
|
||||
else f path T;
|
||||
|
||||
# recmap :: ([String] -> Attrs -> a) -> Attrs -> a | Attrs a
|
||||
recmap = recmapFrom [];
|
||||
recmapCond = recmapCondFrom [];
|
||||
|
||||
recmapZipOntoCondFrom = path: cond: f: dst: src: let
|
||||
zip = f': path': dstLeaf: f' path' dstLeaf (getAttrAt path' src);
|
||||
in
|
||||
dst
|
||||
|> recmapCondFrom path (zip cond) (zip f);
|
||||
|
||||
recmapZipOntoCond = recmapZipOntoCondFrom [];
|
||||
|
||||
projectOnto = dst: src:
|
||||
dst
|
||||
|> recmap
|
||||
(path: dstLeaf: let
|
||||
srcLeaf = getAttrAt path src;
|
||||
in
|
||||
src
|
||||
|> recmapZipOntoCond
|
||||
(path: dstLeaf: srcLeaf: ! isTerminal dstLeaf)
|
||||
(path: dstLeaf: srcLeaf:
|
||||
if isSome srcLeaf
|
||||
then unwrapMaybe srcLeaf
|
||||
else dstLeaf);
|
||||
else if isTerminal dstLeaf
|
||||
then unwrapTerminal dstLeaf
|
||||
else dstLeaf)
|
||||
dst;
|
||||
}
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue