feat(nix/stateMonad): simple Nix state monad implementation
In the absence of do syntactic sugar relatively tedious to write, but useful to express certain types of algorithms. I found it useful to memoize intermediate results as they are calculated in order to avoid recomputing them later in a drv dependency analyzer I've written. Change-Id: I47cf3c644a96952c70276c9fa4cb3190b1c1e027 Reviewed-on: https://cl.tvl.fyi/c/depot/+/6828 Autosubmit: sterni <sternenseemann@systemli.org> Tested-by: BuildkiteCI Reviewed-by: grfn <grfn@gws.fyi>
This commit is contained in:
parent
1e25ba1b09
commit
5e097aa8e9
2 changed files with 186 additions and 0 deletions
76
nix/stateMonad/default.nix
Normal file
76
nix/stateMonad/default.nix
Normal file
|
@ -0,0 +1,76 @@
|
||||||
|
# Simple state monad represented as
|
||||||
|
#
|
||||||
|
# stateMonad s a = s -> { state : s; value : a }
|
||||||
|
#
|
||||||
|
{ ... }:
|
||||||
|
|
||||||
|
rec {
|
||||||
|
#
|
||||||
|
# Monad
|
||||||
|
#
|
||||||
|
|
||||||
|
# Type: stateMonad s a -> (a -> stateMonad s b) -> stateMonad s b
|
||||||
|
bind = action: f: state:
|
||||||
|
let
|
||||||
|
afterAction = action state;
|
||||||
|
in
|
||||||
|
(f afterAction.value) afterAction.state;
|
||||||
|
|
||||||
|
# Type: stateMonad s a -> stateMonad s b -> stateMonad s b
|
||||||
|
after = action1: action2: bind action1 (_: action2);
|
||||||
|
|
||||||
|
# Type: stateMonad s (stateMonad s a) -> stateMonad s a
|
||||||
|
join = action: bind action (action': action');
|
||||||
|
|
||||||
|
# Type: [a] -> (a -> stateMonad s b) -> stateMonad s null
|
||||||
|
for_ = xs: f:
|
||||||
|
builtins.foldl'
|
||||||
|
(laterAction: x:
|
||||||
|
after (f x) laterAction
|
||||||
|
)
|
||||||
|
(pure null)
|
||||||
|
xs;
|
||||||
|
|
||||||
|
#
|
||||||
|
# Applicative
|
||||||
|
#
|
||||||
|
|
||||||
|
# Type: a -> stateMonad s a
|
||||||
|
pure = value: state: { inherit state value; };
|
||||||
|
|
||||||
|
# TODO(sterni): <*>, lift2, …
|
||||||
|
|
||||||
|
#
|
||||||
|
# Functor
|
||||||
|
#
|
||||||
|
|
||||||
|
# Type: (a -> b) -> stateMonad s a -> stateMonad s b
|
||||||
|
fmap = f: action: bind action (result: pure (f result));
|
||||||
|
|
||||||
|
#
|
||||||
|
# State Monad
|
||||||
|
#
|
||||||
|
|
||||||
|
# Type: (s -> s) -> stateMonad s null
|
||||||
|
modify = f: state: { value = null; state = f state; };
|
||||||
|
|
||||||
|
# Type: stateMonad s s
|
||||||
|
get = state: { value = state; inherit state; };
|
||||||
|
|
||||||
|
# Type: s -> stateMonad s null
|
||||||
|
set = new: modify (_: new);
|
||||||
|
|
||||||
|
# Type: str -> stateMonad set set.${str}
|
||||||
|
getAttr = attr: fmap (state: state.${attr}) get;
|
||||||
|
|
||||||
|
# Type: str -> (any -> any) -> stateMonad s null
|
||||||
|
modifyAttr = attr: f: modify (state: state // {
|
||||||
|
${attr} = f state.${attr};
|
||||||
|
});
|
||||||
|
|
||||||
|
# Type: str -> any -> stateMonad s null
|
||||||
|
setAttr = attr: value: modifyAttr attr (_: value);
|
||||||
|
|
||||||
|
# Type: s -> stateMonad s a -> a
|
||||||
|
run = state: action: (action state).value;
|
||||||
|
}
|
110
nix/stateMonad/tests/default.nix
Normal file
110
nix/stateMonad/tests/default.nix
Normal file
|
@ -0,0 +1,110 @@
|
||||||
|
{ depot, ... }:
|
||||||
|
|
||||||
|
let
|
||||||
|
inherit (depot.nix.runTestsuite)
|
||||||
|
runTestsuite
|
||||||
|
it
|
||||||
|
assertEq
|
||||||
|
;
|
||||||
|
|
||||||
|
inherit (depot.nix.stateMonad)
|
||||||
|
pure
|
||||||
|
run
|
||||||
|
join
|
||||||
|
fmap
|
||||||
|
bind
|
||||||
|
get
|
||||||
|
set
|
||||||
|
modify
|
||||||
|
after
|
||||||
|
for_
|
||||||
|
getAttr
|
||||||
|
setAttr
|
||||||
|
modifyAttr
|
||||||
|
;
|
||||||
|
|
||||||
|
runStateIndependent = run (throw "This should never be evaluated!");
|
||||||
|
in
|
||||||
|
|
||||||
|
runTestsuite "stateMonad" [
|
||||||
|
(it "behaves correctly independent of state" [
|
||||||
|
(assertEq "pure" (runStateIndependent (pure 21)) 21)
|
||||||
|
(assertEq "join pure" (runStateIndependent (join (pure (pure 42)))) 42)
|
||||||
|
(assertEq "fmap pure" (runStateIndependent (fmap (builtins.mul 2) (pure 21))) 42)
|
||||||
|
(assertEq "bind pure" (runStateIndependent (bind (pure 12) (x: pure x))) 12)
|
||||||
|
])
|
||||||
|
(it "behaves correctly with an integer state" [
|
||||||
|
(assertEq "get" (run 42 get) 42)
|
||||||
|
(assertEq "after set get" (run 21 (after (set 42) get)) 42)
|
||||||
|
(assertEq "after modify get" (run 21 (after (modify (builtins.mul 2)) get)) 42)
|
||||||
|
(assertEq "fmap get" (run 40 (fmap (builtins.add 2) get)) 42)
|
||||||
|
(assertEq "stateful sum list"
|
||||||
|
(run 0 (after
|
||||||
|
(for_
|
||||||
|
[
|
||||||
|
15
|
||||||
|
12
|
||||||
|
10
|
||||||
|
5
|
||||||
|
]
|
||||||
|
(x: modify (builtins.add x)))
|
||||||
|
get))
|
||||||
|
42)
|
||||||
|
])
|
||||||
|
(it "behaves correctly with an attr set state" [
|
||||||
|
(assertEq "getAttr" (run { foo = 42; } (getAttr "foo")) 42)
|
||||||
|
(assertEq "after setAttr getAttr"
|
||||||
|
(run { foo = 21; } (after (setAttr "foo" 42) (getAttr "foo")))
|
||||||
|
42)
|
||||||
|
(assertEq "after modifyAttr getAttr"
|
||||||
|
(run { foo = 10.5; }
|
||||||
|
(after
|
||||||
|
(modifyAttr "foo" (builtins.mul 4))
|
||||||
|
(getAttr "foo")))
|
||||||
|
42)
|
||||||
|
(assertEq "fmap getAttr"
|
||||||
|
(run { foo = 21; } (fmap (builtins.mul 2) (getAttr "foo")))
|
||||||
|
42)
|
||||||
|
(assertEq "after setAttr to insert getAttr"
|
||||||
|
(run { } (after (setAttr "foo" 42) (getAttr "foo")))
|
||||||
|
42)
|
||||||
|
(assertEq "insert permutations"
|
||||||
|
(run
|
||||||
|
{
|
||||||
|
a = 2;
|
||||||
|
b = 3;
|
||||||
|
c = 5;
|
||||||
|
}
|
||||||
|
(after
|
||||||
|
(bind get
|
||||||
|
(state:
|
||||||
|
let
|
||||||
|
names = builtins.attrNames state;
|
||||||
|
in
|
||||||
|
for_ names (name1:
|
||||||
|
for_ names (name2:
|
||||||
|
# this is of course a bit silly, but making it more cumbersome
|
||||||
|
# makes sure the test exercises more of the code.
|
||||||
|
(bind (getAttr name1)
|
||||||
|
(value1:
|
||||||
|
(bind (getAttr name2)
|
||||||
|
(value2:
|
||||||
|
setAttr "${name1}_${name2}" (value1 * value2)))))))))
|
||||||
|
get))
|
||||||
|
{
|
||||||
|
a = 2;
|
||||||
|
b = 3;
|
||||||
|
c = 5;
|
||||||
|
a_a = 4;
|
||||||
|
a_b = 6;
|
||||||
|
a_c = 10;
|
||||||
|
b_a = 6;
|
||||||
|
b_b = 9;
|
||||||
|
b_c = 15;
|
||||||
|
c_c = 25;
|
||||||
|
c_a = 10;
|
||||||
|
c_b = 15;
|
||||||
|
}
|
||||||
|
)
|
||||||
|
])
|
||||||
|
]
|
Loading…
Reference in a new issue