From 01d490b710f6d7293f0f7b5937d4fd8c38c59d97 Mon Sep 17 00:00:00 2001 From: "Dr. Carsten Leue" Date: Tue, 13 Feb 2024 14:23:33 +0100 Subject: [PATCH] fix: add State monad Signed-off-by: Dr. Carsten Leue --- scan.bat | 3 + state/eq.go | 31 +++++++++ state/generic/eq.go | 36 ++++++++++ state/generic/monad.go | 88 +++++++++++++++++++++++++ state/generic/state.go | 131 +++++++++++++++++++++++++++++++++++++ state/monad.go | 44 +++++++++++++ state/state.go | 96 +++++++++++++++++++++++++++ state/testing/laws.go | 78 ++++++++++++++++++++++ state/testing/laws_test.go | 49 ++++++++++++++ writer/generic/writer.go | 6 +- 10 files changed, 561 insertions(+), 1 deletion(-) create mode 100644 scan.bat create mode 100644 state/eq.go create mode 100644 state/generic/eq.go create mode 100644 state/generic/monad.go create mode 100644 state/generic/state.go create mode 100644 state/monad.go create mode 100644 state/state.go create mode 100644 state/testing/laws.go create mode 100644 state/testing/laws_test.go diff --git a/scan.bat b/scan.bat new file mode 100644 index 0000000..ed7b544 --- /dev/null +++ b/scan.bat @@ -0,0 +1,3 @@ +@echo off + +busybox find . -type f -name "*\.go" | busybox xargs gopls check \ No newline at end of file diff --git a/state/eq.go b/state/eq.go new file mode 100644 index 0000000..5860a4c --- /dev/null +++ b/state/eq.go @@ -0,0 +1,31 @@ +// Copyright (c) 2023 IBM Corp. +// All rights reserved. +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. + +package state + +import ( + EQ "github.com/IBM/fp-go/eq" + G "github.com/IBM/fp-go/state/generic" +) + +// Constructs an equal predicate for a [State] +func Eq[S, A any](w EQ.Eq[S], a EQ.Eq[A]) func(S) EQ.Eq[State[S, A]] { + return G.Eq[State[S, A]](w, a) +} + +// FromStrictEquals constructs an [EQ.Eq] from the canonical comparison function +func FromStrictEquals[S, A comparable]() func(S) EQ.Eq[State[S, A]] { + return G.FromStrictEquals[State[S, A]]() +} diff --git a/state/generic/eq.go b/state/generic/eq.go new file mode 100644 index 0000000..f724358 --- /dev/null +++ b/state/generic/eq.go @@ -0,0 +1,36 @@ +// Copyright (c) 2023 IBM Corp. +// All rights reserved. +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. + +package generic + +import ( + EQ "github.com/IBM/fp-go/eq" + P "github.com/IBM/fp-go/pair" +) + +// Constructs an equal predicate for a [State] +func Eq[GA ~func(S) P.Pair[A, S], S, A any](w EQ.Eq[S], a EQ.Eq[A]) func(S) EQ.Eq[GA] { + eqp := P.Eq(a, w) + return func(s S) EQ.Eq[GA] { + return EQ.FromEquals(func(l, r GA) bool { + return eqp.Equals(l(s), r(s)) + }) + } +} + +// FromStrictEquals constructs an [EQ.Eq] from the canonical comparison function +func FromStrictEquals[GA ~func(S) P.Pair[A, S], S, A comparable]() func(S) EQ.Eq[GA] { + return Eq[GA](EQ.FromStrictEquals[S](), EQ.FromStrictEquals[A]()) +} diff --git a/state/generic/monad.go b/state/generic/monad.go new file mode 100644 index 0000000..8a637f2 --- /dev/null +++ b/state/generic/monad.go @@ -0,0 +1,88 @@ +// Copyright (c) 2024 IBM Corp. +// All rights reserved. +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. + +package generic + +import ( + "github.com/IBM/fp-go/internal/applicative" + "github.com/IBM/fp-go/internal/functor" + "github.com/IBM/fp-go/internal/monad" + "github.com/IBM/fp-go/internal/pointed" + P "github.com/IBM/fp-go/pair" +) + +type statePointed[GA ~func(S) P.Pair[A, S], S, A any] struct{} + +type stateFunctor[GB ~func(S) P.Pair[B, S], GA ~func(S) P.Pair[A, S], S, A, B any] struct{} + +type stateApplicative[GB ~func(S) P.Pair[B, S], GAB ~func(S) P.Pair[func(A) B, S], GA ~func(S) P.Pair[A, S], S, A, B any] struct{} + +type stateMonad[GB ~func(S) P.Pair[B, S], GAB ~func(S) P.Pair[func(A) B, S], GA ~func(S) P.Pair[A, S], S, A, B any] struct{} + +func (o *statePointed[GA, S, A]) Of(a A) GA { + return Of[GA](a) +} + +func (o *stateApplicative[GB, GAB, GA, S, A, B]) Of(a A) GA { + return Of[GA](a) +} + +func (o *stateMonad[GB, GAB, GA, S, A, B]) Of(a A) GA { + return Of[GA](a) +} + +func (o *stateFunctor[GB, GA, S, A, B]) Map(f func(A) B) func(GA) GB { + return Map[GB, GA](f) +} + +func (o *stateApplicative[GB, GAB, GA, S, A, B]) Map(f func(A) B) func(GA) GB { + return Map[GB, GA](f) +} + +func (o *stateMonad[GB, GAB, GA, S, A, B]) Map(f func(A) B) func(GA) GB { + return Map[GB, GA](f) +} + +func (o *stateMonad[GB, GAB, GA, S, A, B]) Chain(f func(A) GB) func(GA) GB { + return Chain[GB, GA](f) +} + +func (o *stateApplicative[GB, GAB, GA, S, A, B]) Ap(fa GA) func(GAB) GB { + return Ap[GB, GAB, GA](fa) +} + +func (o *stateMonad[GB, GAB, GA, S, A, B]) Ap(fa GA) func(GAB) GB { + return Ap[GB, GAB, GA](fa) +} + +// Pointed implements the pointed operations for [Writer] +func Pointed[GA ~func(S) P.Pair[A, S], S, A any]() pointed.Pointed[A, GA] { + return &statePointed[GA, S, A]{} +} + +// Functor implements the functor operations for [Writer] +func Functor[GB ~func(S) P.Pair[B, S], GA ~func(S) P.Pair[A, S], S, A, B any]() functor.Functor[A, B, GA, GB] { + return &stateFunctor[GB, GA, S, A, B]{} +} + +// Applicative implements the applicative operations for [Writer] +func Applicative[GB ~func(S) P.Pair[B, S], GAB ~func(S) P.Pair[func(A) B, S], GA ~func(S) P.Pair[A, S], S, A, B any]() applicative.Applicative[A, B, GA, GB, GAB] { + return &stateApplicative[GB, GAB, GA, S, A, B]{} +} + +// Monad implements the monadic operations for [Writer] +func Monad[GB ~func(S) P.Pair[B, S], GAB ~func(S) P.Pair[func(A) B, S], GA ~func(S) P.Pair[A, S], S, A, B any]() monad.Monad[A, B, GA, GB, GAB] { + return &stateMonad[GB, GAB, GA, S, A, B]{} +} diff --git a/state/generic/state.go b/state/generic/state.go new file mode 100644 index 0000000..59a480d --- /dev/null +++ b/state/generic/state.go @@ -0,0 +1,131 @@ +// Copyright (c) 2024 IBM Corp. +// All rights reserved. +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. + +package generic + +import ( + F "github.com/IBM/fp-go/function" + C "github.com/IBM/fp-go/internal/chain" + FC "github.com/IBM/fp-go/internal/functor" + P "github.com/IBM/fp-go/pair" +) + +var ( + undefined any = struct{}{} +) + +func Get[GA ~func(S) P.Pair[S, S], S any]() GA { + return P.Of[S] +} + +func Gets[GA ~func(S) P.Pair[A, S], FCT ~func(S) A, A, S any](f FCT) GA { + return func(s S) P.Pair[A, S] { + return P.MakePair(f(s), s) + } +} + +func Put[GA ~func(S) P.Pair[any, S], S any]() GA { + return F.Bind1st(P.MakePair[any, S], undefined) +} + +func Modify[GA ~func(S) P.Pair[any, S], FCT ~func(S) S, S any](f FCT) GA { + return F.Flow2( + f, + F.Bind1st(P.MakePair[any, S], undefined), + ) +} + +func Of[GA ~func(S) P.Pair[A, S], S, A any](a A) GA { + return F.Bind1st(P.MakePair[A, S], a) +} + +func MonadMap[GB ~func(S) P.Pair[B, S], GA ~func(S) P.Pair[A, S], FCT ~func(A) B, S, A, B any](fa GA, f FCT) GB { + return func(s S) P.Pair[B, S] { + p2 := fa(s) + return P.MakePair(f(P.Head(p2)), P.Tail(p2)) + } +} + +func Map[GB ~func(S) P.Pair[B, S], GA ~func(S) P.Pair[A, S], FCT ~func(A) B, S, A, B any](f FCT) func(GA) GB { + return F.Bind2nd(MonadMap[GB, GA, FCT, S, A, B], f) +} + +func MonadChain[GB ~func(S) P.Pair[B, S], GA ~func(S) P.Pair[A, S], FCT ~func(A) GB, S, A, B any](fa GA, f FCT) GB { + return func(s S) P.Pair[B, S] { + a := fa(s) + return f(P.Head(a))(P.Tail(a)) + } +} + +func Chain[GB ~func(S) P.Pair[B, S], GA ~func(S) P.Pair[A, S], FCT ~func(A) GB, S, A, B any](f FCT) func(GA) GB { + return F.Bind2nd(MonadChain[GB, GA, FCT, S, A, B], f) +} + +func MonadAp[GB ~func(S) P.Pair[B, S], GAB ~func(S) P.Pair[func(A) B, S], GA ~func(S) P.Pair[A, S], S, A, B any](fab GAB, fa GA) GB { + return func(s S) P.Pair[B, S] { + f := fab(s) + a := fa(P.Tail(f)) + + return P.MakePair(P.Head(f)(P.Head(a)), P.Tail(a)) + } +} + +func Ap[GB ~func(S) P.Pair[B, S], GAB ~func(S) P.Pair[func(A) B, S], GA ~func(S) P.Pair[A, S], S, A, B any](ga GA) func(GAB) GB { + return F.Bind2nd(MonadAp[GB, GAB, GA, S, A, B], ga) +} + +func MonadChainFirst[GB ~func(S) P.Pair[B, S], GA ~func(S) P.Pair[A, S], FCT ~func(A) GB, S, A, B any](ma GA, f FCT) GA { + return C.MonadChainFirst( + MonadChain[GA, GA, func(A) GA], + MonadMap[GA, GB, func(B) A], + ma, + f, + ) +} + +func ChainFirst[GB ~func(S) P.Pair[B, S], GA ~func(S) P.Pair[A, S], FCT ~func(A) GB, S, A, B any](f FCT) func(GA) GA { + return C.ChainFirst( + Chain[GA, GA, func(A) GA], + Map[GA, GB, func(B) A], + f, + ) +} + +func Flatten[GAA ~func(S) P.Pair[GA, S], GA ~func(S) P.Pair[A, S], S, A any](mma GAA) GA { + return MonadChain[GA, GAA, func(GA) GA](mma, F.Identity[GA]) +} + +func Execute[GA ~func(S) P.Pair[A, S], S, A any](s S) func(GA) S { + return func(fa GA) S { + return P.Tail(fa(s)) + } +} + +func Evaluate[GA ~func(S) P.Pair[A, S], S, A any](s S) func(GA) A { + return func(fa GA) A { + return P.Head(fa(s)) + } +} + +func MonadFlap[FAB ~func(A) B, GFAB ~func(S) P.Pair[FAB, S], GB ~func(S) P.Pair[B, S], S, A, B any](fab GFAB, a A) GB { + return FC.MonadFlap( + MonadMap[GB, GFAB, func(FAB) B], + fab, + a) +} + +func Flap[FAB ~func(A) B, GFAB ~func(S) P.Pair[FAB, S], GB ~func(S) P.Pair[B, S], S, A, B any](a A) func(GFAB) GB { + return FC.Flap(Map[GB, GFAB, func(FAB) B], a) +} diff --git a/state/monad.go b/state/monad.go new file mode 100644 index 0000000..9278926 --- /dev/null +++ b/state/monad.go @@ -0,0 +1,44 @@ +// Copyright (c) 2024 IBM Corp. +// All rights reserved. +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. + +package state + +import ( + "github.com/IBM/fp-go/internal/applicative" + "github.com/IBM/fp-go/internal/functor" + "github.com/IBM/fp-go/internal/monad" + "github.com/IBM/fp-go/internal/pointed" + G "github.com/IBM/fp-go/state/generic" +) + +// Pointed implements the pointed operations for [State] +func Pointed[S, A any]() pointed.Pointed[A, State[S, A]] { + return G.Pointed[State[S, A], S, A]() +} + +// Functor implements the pointed operations for [State] +func Functor[S, A, B any]() functor.Functor[A, B, State[S, A], State[S, B]] { + return G.Functor[State[S, B], State[S, A], S, A, B]() +} + +// Applicative implements the applicative operations for [State] +func Applicative[S, A, B any]() applicative.Applicative[A, B, State[S, A], State[S, B], State[S, func(A) B]] { + return G.Applicative[State[S, B], State[S, func(A) B], State[S, A]]() +} + +// Monad implements the monadic operations for [State] +func Monad[S, A, B any]() monad.Monad[A, B, State[S, A], State[S, B], State[S, func(A) B]] { + return G.Monad[State[S, B], State[S, func(A) B], State[S, A]]() +} diff --git a/state/state.go b/state/state.go new file mode 100644 index 0000000..8d7ea77 --- /dev/null +++ b/state/state.go @@ -0,0 +1,96 @@ +// Copyright (c) 2024 IBM Corp. +// All rights reserved. +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. + +package state + +import ( + P "github.com/IBM/fp-go/pair" + R "github.com/IBM/fp-go/reader" + G "github.com/IBM/fp-go/state/generic" +) + +type State[S, A any] R.Reader[S, P.Pair[A, S]] + +func Get[S any]() State[S, S] { + return G.Get[State[S, S]]() +} + +func Gets[FCT ~func(S) A, A, S any](f FCT) State[S, A] { + return G.Gets[State[S, A]](f) +} + +func Put[S any]() State[S, any] { + return G.Put[State[S, any]]() +} + +func Modify[FCT ~func(S) S, S any](f FCT) State[S, any] { + return G.Modify[State[S, any]](f) +} + +func Of[S, A any](a A) State[S, A] { + return G.Of[State[S, A]](a) +} + +func MonadMap[S any, FCT ~func(A) B, A, B any](fa State[S, A], f FCT) State[S, B] { + return G.MonadMap[State[S, B], State[S, A]](fa, f) +} + +func Map[S any, FCT ~func(A) B, A, B any](f FCT) func(State[S, A]) State[S, B] { + return G.Map[State[S, B], State[S, A]](f) +} + +func MonadChain[S any, FCT ~func(A) State[S, B], A, B any](fa State[S, A], f FCT) State[S, B] { + return G.MonadChain[State[S, B], State[S, A]](fa, f) +} + +func Chain[S any, FCT ~func(A) State[S, B], A, B any](f FCT) func(State[S, A]) State[S, B] { + return G.Chain[State[S, B], State[S, A]](f) +} + +func MonadAp[S, A, B any](fab State[S, func(A) B], fa State[S, A]) State[S, B] { + return G.MonadAp[State[S, B], State[S, func(A) B], State[S, A]](fab, fa) +} + +func Ap[S, A, B any](ga State[S, A]) func(State[S, func(A) B]) State[S, B] { + return G.Ap[State[S, B], State[S, func(A) B], State[S, A]](ga) +} + +func MonadChainFirst[S any, FCT ~func(A) State[S, B], A, B any](ma State[S, A], f FCT) State[S, A] { + return G.MonadChainFirst[State[S, B], State[S, A]](ma, f) +} + +func ChainFirst[S any, FCT ~func(A) State[S, B], A, B any](f FCT) func(State[S, A]) State[S, A] { + return G.ChainFirst[State[S, B], State[S, A]](f) +} + +func Flatten[S, A any](mma State[S, State[S, A]]) State[S, A] { + return G.Flatten[State[S, State[S, A]], State[S, A]](mma) +} + +func Execute[A, S any](s S) func(State[S, A]) S { + return G.Execute[State[S, A]](s) +} + +func Evaluate[A, S any](s S) func(State[S, A]) A { + return G.Evaluate[State[S, A]](s) +} + +func MonadFlap[FAB ~func(A) B, S, A, B any](fab State[S, FAB], a A) State[S, B] { + return G.MonadFlap[FAB, State[S, FAB], State[S, B], S, A, B](fab, a) +} + +func Flap[S, A, B any](a A) func(State[S, func(A) B]) State[S, B] { + return G.Flap[func(A) B, State[S, func(A) B], State[S, B]](a) +} diff --git a/state/testing/laws.go b/state/testing/laws.go new file mode 100644 index 0000000..7127eaf --- /dev/null +++ b/state/testing/laws.go @@ -0,0 +1,78 @@ +// Copyright (c) 2023 IBM Corp. +// All rights reserved. +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. + +package testing + +import ( + "testing" + + EQ "github.com/IBM/fp-go/eq" + L "github.com/IBM/fp-go/internal/monad/testing" + ST "github.com/IBM/fp-go/state" +) + +// AssertLaws asserts the apply monad laws for the `Either` monad +func AssertLaws[S, A, B, C any](t *testing.T, + eqw EQ.Eq[S], + eqa EQ.Eq[A], + eqb EQ.Eq[B], + eqc EQ.Eq[C], + + ab func(A) B, + bc func(B) C, + + s S, +) func(a A) bool { + + fofc := ST.Pointed[S, C]() + fofaa := ST.Pointed[S, func(A) A]() + fofbc := ST.Pointed[S, func(B) C]() + fofabb := ST.Pointed[S, func(func(A) B) B]() + + fmap := ST.Functor[S, func(B) C, func(func(A) B) func(A) C]() + + fapabb := ST.Applicative[S, func(A) B, B]() + fapabac := ST.Applicative[S, func(A) B, func(A) C]() + + maa := ST.Monad[S, A, A]() + mab := ST.Monad[S, A, B]() + mac := ST.Monad[S, A, C]() + mbc := ST.Monad[S, B, C]() + + return L.MonadAssertLaws(t, + ST.Eq(eqw, eqa)(s), + ST.Eq(eqw, eqb)(s), + ST.Eq(eqw, eqc)(s), + + fofc, + fofaa, + fofbc, + fofabb, + + fmap, + + fapabb, + fapabac, + + maa, + mab, + mac, + mbc, + + ab, + bc, + ) + +} diff --git a/state/testing/laws_test.go b/state/testing/laws_test.go new file mode 100644 index 0000000..783b0c4 --- /dev/null +++ b/state/testing/laws_test.go @@ -0,0 +1,49 @@ +// Copyright (c) 2023 IBM Corp. +// All rights reserved. +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. + +package testing + +import ( + "fmt" + "testing" + + A "github.com/IBM/fp-go/array" + EQ "github.com/IBM/fp-go/eq" + "github.com/stretchr/testify/assert" +) + +func TestMonadLaws(t *testing.T) { + // some comparison + eqs := A.Eq[string](EQ.FromStrictEquals[string]()) + eqa := EQ.FromStrictEquals[bool]() + eqb := EQ.FromStrictEquals[int]() + eqc := EQ.FromStrictEquals[string]() + + ab := func(a bool) int { + if a { + return 1 + } + return 0 + } + + bc := func(b int) string { + return fmt.Sprintf("value %d", b) + } + + laws := AssertLaws(t, eqs, eqa, eqb, eqc, ab, bc, A.Empty[string]()) + + assert.True(t, laws(true)) + assert.True(t, laws(false)) +} diff --git a/writer/generic/writer.go b/writer/generic/writer.go index 90434f0..fb4a0e7 100644 --- a/writer/generic/writer.go +++ b/writer/generic/writer.go @@ -25,8 +25,12 @@ import ( SG "github.com/IBM/fp-go/semigroup" ) +var ( + undefined any = struct{}{} +) + func Tell[GA ~func() P.Pair[any, W], W any](w W) GA { - return IO.Of[GA](P.MakePair[any](w, w)) + return IO.Of[GA](P.MakePair[any](undefined, w)) } func Of[GA ~func() P.Pair[A, W], W, A any](m M.Monoid[W], a A) GA {