├── .github ├── CODEOWNERS ├── dependabot.yml └── workflows │ └── ci.yml ├── .gitignore ├── LICENSE ├── README.md ├── build.sbt ├── project ├── build.properties └── plugins.sbt ├── src ├── main │ └── scala │ │ └── logic │ │ ├── Logic.scala │ │ ├── LogicT.scala │ │ ├── MonadLogic.scala │ │ ├── package.scala │ │ └── syntax │ │ ├── MonadLogicSyntax.scala │ │ ├── Syntaxes.scala │ │ └── package.scala └── test │ └── scala │ └── logic │ ├── FunctionEqual.scala │ ├── LogicSpec.scala │ └── MonadLogicLaw.scala └── version.sbt /.github/CODEOWNERS: -------------------------------------------------------------------------------- 1 | * @xuwei-k 2 | -------------------------------------------------------------------------------- /.github/dependabot.yml: -------------------------------------------------------------------------------- 1 | version: 2 2 | updates: 3 | - package-ecosystem: "github-actions" 4 | directory: "/" 5 | schedule: 6 | interval: "weekly" 7 | -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | on: 3 | pull_request: 4 | push: 5 | jobs: 6 | test: 7 | runs-on: ubuntu-latest 8 | timeout-minutes: 20 9 | steps: 10 | - uses: actions/checkout@v4 11 | - uses: actions/setup-java@c5195efecf7bdfc987ee8bae7a71cb8b11521c00 # v4.7.1 12 | with: 13 | java-version: 8 14 | distribution: adopt 15 | - uses: sbt/setup-sbt@v1 16 | - uses: coursier/cache-action@v6 17 | - run: sbt -v "+ test" 18 | - run: rm -rf ~/.ivy2/local 19 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Created by http://www.gitignore.io 2 | 3 | ### Scala ### 4 | *.class 5 | *.log 6 | 7 | # sbt specific 8 | .cache/ 9 | .history/ 10 | .lib/ 11 | dist/* 12 | target/ 13 | lib_managed/ 14 | src_managed/ 15 | project/boot/ 16 | project/plugins/project/ 17 | 18 | # Scala-IDE specific 19 | .scala_dependencies 20 | .worksheet 21 | 22 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2015- pocketberserker 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a copy 4 | of this software and associated documentation files (the "Software"), to deal 5 | in the Software without restriction, including without limitation the rights 6 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | copies of the Software, and to permit persons to whom the Software is 8 | furnished to do so, subject to the following conditions: 9 | 10 | The above copyright notice and this permission notice shall be included in 11 | all copies or substantial portions of the Software. 12 | 13 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 14 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 15 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 16 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 17 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 18 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 19 | THE SOFTWARE. 20 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | scala-logic 2 | =========== 3 | 4 | scala-logic is a port of [logict](https://hackage.haskell.org/package/logict). 5 | 6 | [![Latest Version](https://maven-badges.herokuapp.com/maven-central/com.github.pocketberserker/scala-logic_2.11/badge.svg)](https://maven-badges.herokuapp.com/maven-central/com.github.pocketberserker/scala-logic_2.11) 7 | -------------------------------------------------------------------------------- /build.sbt: -------------------------------------------------------------------------------- 1 | import sbtrelease.ReleaseStateTransformations._ 2 | 3 | val scalazVersion = "7.3.7" 4 | val scalaz = "org.scalaz" %% "scalaz-core" % scalazVersion 5 | 6 | def gitHash: String = scala.util.Try( 7 | sys.process.Process("git rev-parse HEAD").lineStream.head 8 | ).getOrElse("master") 9 | 10 | val unusedWarnings = Def.setting( 11 | CrossVersion.partialVersion(scalaVersion.value) match { 12 | case Some((2, 11)) => 13 | Seq("-Ywarn-unused-import") 14 | case _ => 15 | Seq("-Ywarn-unused:imports") 16 | } 17 | ) 18 | 19 | val Scala211 = "2.11.12" 20 | 21 | lazy val buildSettings = Def.settings( 22 | BuildInfoPlugin.projectSettings, 23 | scalapropsWithScalaz, 24 | scalaVersion := Scala211, 25 | crossScalaVersions := Seq(Scala211, "2.12.20", "2.13.16", "3.7.1"), 26 | scalacOptions ++= ( 27 | "-deprecation" :: 28 | "-unchecked" :: 29 | "-feature" :: 30 | "-language:existentials" :: 31 | "-language:higherKinds" :: 32 | "-language:implicitConversions" :: 33 | "-language:reflectiveCalls" :: 34 | Nil 35 | ), 36 | scalacOptions ++= unusedWarnings.value, 37 | scalapropsVersion := "0.9.1", 38 | publishTo := sonatypePublishTo.value, 39 | libraryDependencies ++= Seq( 40 | scalaz 41 | ), 42 | scalacOptions ++= { 43 | CrossVersion.partialVersion(scalaVersion.value) match { 44 | case Some((2, _)) => 45 | Seq() 46 | case _ => 47 | Seq( 48 | "-Ykind-projector" 49 | ) 50 | } 51 | }, 52 | libraryDependencies ++= { 53 | CrossVersion.partialVersion(scalaVersion.value) match { 54 | case Some((2, _)) => 55 | Seq( 56 | compilerPlugin("org.typelevel" % "kind-projector" % "0.13.3" cross CrossVersion.full) 57 | ) 58 | case _ => 59 | Nil 60 | } 61 | }, 62 | buildInfoKeys ++= Seq[BuildInfoKey]( 63 | organization, 64 | name, 65 | version, 66 | scalaVersion, 67 | sbtVersion, 68 | scalacOptions, 69 | licenses, 70 | "scalazVersion" -> scalazVersion 71 | ), 72 | buildInfoPackage := "logic", 73 | buildInfoObject := "BuildInfoScalaLogic", 74 | releaseProcess := Seq[ReleaseStep]( 75 | checkSnapshotDependencies, 76 | inquireVersions, 77 | runClean, 78 | runTest, 79 | setReleaseVersion, 80 | commitReleaseVersion, 81 | tagRelease, 82 | ReleaseStep( 83 | action = state => Project.extract(state).runTask(PgpKeys.publishSigned, state)._1, 84 | enableCrossBuild = true 85 | ), 86 | setNextVersion, 87 | commitNextVersion, 88 | pushChanges 89 | ), 90 | credentials ++= PartialFunction.condOpt(sys.env.get("SONATYPE_USER") -> sys.env.get("SONATYPE_PASS")){ 91 | case (Some(user), Some(pass)) => 92 | Credentials("Sonatype Nexus Repository Manager", "oss.sonatype.org", user, pass) 93 | }.toList, 94 | organization := "com.github.pocketberserker", 95 | homepage := Some(url("https://github.com/pocketberserker/scala-logic")), 96 | licenses := Seq("MIT License" -> url("http://www.opensource.org/licenses/mit-license.php")), 97 | pomExtra := 98 | 99 | 100 | pocketberserker 101 | Yuki Nakayama 102 | https://github.com/pocketberserker 103 | 104 | 105 | 106 | git@github.com:pocketberserker/scala-logic.git 107 | scm:git:git@github.com:pocketberserker/scala-logic.git 108 | {if(isSnapshot.value) gitHash else { "v" + version.value }} 109 | 110 | , 111 | description := "logic programming monad for Scala", 112 | pomPostProcess := { node => 113 | import scala.xml._ 114 | import scala.xml.transform._ 115 | def stripIf(f: Node => Boolean) = new RewriteRule { 116 | override def transform(n: Node) = 117 | if (f(n)) NodeSeq.Empty else n 118 | } 119 | val stripTestScope = stripIf { n => n.label == "dependency" && (n \ "scope").text == "test" } 120 | new RuleTransformer(stripTestScope).transform(node)(0) 121 | }, 122 | Seq(Compile, Test).flatMap(c => 123 | (c / console / scalacOptions) --= unusedWarnings.value 124 | ) 125 | ) 126 | 127 | lazy val logic = Project( 128 | id = "scala-logic", 129 | base = file(".") 130 | ).settings( 131 | buildSettings 132 | ) 133 | -------------------------------------------------------------------------------- /project/build.properties: -------------------------------------------------------------------------------- 1 | sbt.version=1.11.2 2 | -------------------------------------------------------------------------------- /project/plugins.sbt: -------------------------------------------------------------------------------- 1 | addSbtPlugin("com.github.sbt" % "sbt-pgp" % "2.3.1") 2 | addSbtPlugin("com.github.sbt" % "sbt-release" % "1.4.0") 3 | addSbtPlugin("org.xerial.sbt" % "sbt-sonatype" % "3.12.0") 4 | addSbtPlugin("com.eed3si9n" % "sbt-buildinfo" % "0.13.1") 5 | addSbtPlugin("com.github.scalaprops" % "sbt-scalaprops" % "0.5.1") 6 | -------------------------------------------------------------------------------- /src/main/scala/logic/Logic.scala: -------------------------------------------------------------------------------- 1 | package logic 2 | 3 | import scalaz._ 4 | 5 | object Logic { 6 | 7 | def observe[A](l: Logic[A]): Option[A] = l.observe 8 | 9 | def observeAll[A](l: Logic[A]): List[A] = l.observeAll 10 | 11 | def observeMany[A](l: Logic[A], n: Int): List[A] = 12 | l.observeMany(n) 13 | } 14 | -------------------------------------------------------------------------------- /src/main/scala/logic/LogicT.scala: -------------------------------------------------------------------------------- 1 | package logic 2 | 3 | import scalaz._ 4 | import Id._ 5 | import scalaz.syntax.bind._ 6 | 7 | trait LogicT[F[_], A] { 8 | 9 | def apply[R](l: F[R])(f: A => F[R] => F[R]): F[R] 10 | 11 | def observe(implicit M: Applicative[F]): F[Option[A]] = 12 | this(M.pure(None: Option[A]))(a => Function.const(M.pure(Some(a)))) 13 | 14 | def observeAll(implicit M: Applicative[F]): F[List[A]] = 15 | this(M.pure(Nil: List[A]))(a => b => M.map(b)(a :: _)) 16 | 17 | def observeMany(n: Int)(implicit M: Monad[F]): F[List[A]] = { 18 | def sk[X](o: Option[(A, LogicT[F, A])])(x: X): F[List[A]] = o match { 19 | case None => M.pure(Nil) 20 | case Some((a, m)) => M.map(m.observeMany(n - 1))(a :: _) 21 | } 22 | if(n <= 0) M.pure(Nil) 23 | else if(n == 1) this(M.pure(Nil: List[A]))(a => Function.const(M.pure(List(a)))) 24 | else MonadLogic[LogicT[F, *]].split(this)(M.pure(Nil: List[A]))(sk) 25 | } 26 | } 27 | 28 | object LogicT extends LogicTInstances { 29 | 30 | implicit val logicTraverse: Traverse[Logic] = new Traverse[Logic] { 31 | def traverseImpl[F[_], A, B](l: Logic[A])(f: A => F[B])(implicit F: Applicative[F]) = { 32 | def cons(b: B)(ll: Logic[B]): Logic[B] = logicTMonadPlus.plus(logicTMonadPlus.pure(b), ll) 33 | l(F.pure(logicTMonadPlus[Id].empty[B]))(a => ft => F.ap(ft)(F.map(f(a))(cons _))) 34 | } 35 | } 36 | } 37 | 38 | sealed abstract class LogicTInstances3 { 39 | 40 | implicit def logicTMonadPlus[F[_]]: MonadPlus[LogicT[F, *]] = 41 | new LogicTMonadPlus[F]{} 42 | 43 | implicit val logicTMonadTrans: MonadTrans[LogicT] = new MonadTrans[LogicT] { 44 | def liftM[G[_] : Monad, A](m: G[A]) = new LogicT[G, A] { 45 | def apply[R](l: G[R])(f: A => G[R] => G[R]): G[R] = m.flatMap(a => f(a)(l)) 46 | } 47 | def apply[G[_]: Monad] = logicTMonadPlus[G] 48 | } 49 | 50 | implicit def logicTFoldable[F[_]](implicit T: Foldable[F], S: Applicative[F]): Foldable[LogicT[F, *]] = new Foldable[LogicT[F, *]] { 51 | 52 | def foldMap[A, B](fa: LogicT[F, A])(f: A => B)(implicit M: Monoid[B]) = 53 | T.fold(fa(S.pure(M.zero))(a => b => S.map(b)(M.append(f(a), _)))) 54 | 55 | def foldRight[A, B](fa: LogicT[F, A], z: => B)(f: (A, => B) => B) = 56 | foldMap(fa)((a: A) => (Endo.endo(f(a, _: B)))) apply z 57 | } 58 | } 59 | 60 | sealed abstract class LogicTInstances2 extends LogicTInstances3 { 61 | 62 | implicit def logicTMonadLogic[F[_]](implicit F: Monad[F]): MonadLogic[LogicT[F, *]] = 63 | new LogicTMonadPlus[F] with MonadLogic[LogicT[F, *]] { 64 | override def split[A](m: LogicT[F, A]): LogicT[F, Option[(A, LogicT[F, A])]] = 65 | MonadTrans[LogicT].liftM( 66 | m.apply(F.point(Option.empty[(A, LogicT[F, A])]))( 67 | a => fk => F.point( 68 | Some(( 69 | a, 70 | Bind[LogicT[F, *]].bind(MonadTrans[LogicT].liftM(fk))(x => 71 | MonadLogic.reflect[LogicT[F, *], A](x) 72 | ) 73 | )) 74 | ) 75 | ) 76 | ) 77 | } 78 | } 79 | 80 | sealed abstract class LogicTInstances1 extends LogicTInstances2 { 81 | 82 | def logicTMonadReader[F[_], R](implicit F0: MonadReader[F, R]): MonadReader[LogicT[F, *], R] = 83 | new LogicTMonadReader[F, R] { 84 | implicit def F: MonadReader[F, R] = F0 85 | } 86 | } 87 | 88 | sealed abstract class LogicTInstances0 extends LogicTInstances1 { 89 | def logicTMonadState[F[_], S](implicit F0: MonadState[F, S]): MonadState[LogicT[F, *], S] = 90 | new LogicTMonadState[F, S] { 91 | implicit def F: MonadState[F, S] = F0 92 | } 93 | } 94 | 95 | sealed abstract class LogicTInstances extends LogicTInstances0 { 96 | def logicTMonadError[F[_], E](implicit F0: MonadError[F, E]): MonadError[LogicT[F, *], E] = 97 | new LogicTMonadError[F, E] { 98 | implicit def F: MonadError[F, E] = F0 99 | } 100 | } 101 | 102 | private abstract class LogicTMonadPlus[F[_]] extends MonadPlus[LogicT[F, *]] { 103 | override final def map[A, B](lt: LogicT[F, A])(f: A => B) = new LogicT[F, B] { 104 | def apply[R](l: F[R])(sk: B => F[R] => F[R]) = lt(l)(sk compose f) 105 | } 106 | 107 | override final def point[A](a: => A) = new LogicT[F, A] { 108 | def apply[R](fk: F[R])(sk: A => F[R] => F[R]) = sk(a)(fk) 109 | } 110 | 111 | override final def bind[A, B](fa: LogicT[F, A])(f: A => LogicT[F, B]) = new LogicT[F, B] { 112 | def apply[R](fk: F[R])(sk: B => F[R] => F[R]) = fa(fk)(a => fkk => f(a)(fkk)(sk)) 113 | } 114 | 115 | override final def empty[A] = new LogicT[F, A] { 116 | def apply[R](fk: F[R])(sk: A => F[R] => F[R]) = fk 117 | } 118 | 119 | override final def plus[A](a: LogicT[F, A], b: => LogicT[F, A]) = new LogicT[F, A] { 120 | def apply[R](fk: F[R])(sk: A => F[R] => F[R]) = a(b(fk)(sk))(sk) 121 | } 122 | } 123 | 124 | private trait LogicTMonadReader[F[_], R] extends LogicTMonadPlus[F] with MonadReader[LogicT[F, *], R] { 125 | 126 | implicit def F: MonadReader[F, R] 127 | 128 | def ask = LogicT.logicTMonadTrans.liftM[F, R](F.ask) 129 | def local[A](f: R => R)(m: LogicT[F, A]): LogicT[F, A] = new LogicT[F, A] { 130 | def apply[X](l: F[X])(sk: A => F[X] => F[X]) = 131 | m(F.local(f)(l))(sk) 132 | } 133 | } 134 | 135 | private trait LogicTMonadState[F[_], S] extends LogicTMonadPlus[F] with MonadState[LogicT[F, *], S] { 136 | 137 | implicit def F: MonadState[F, S] 138 | 139 | def get = LogicT.logicTMonadTrans.liftM[F, S](F.get) 140 | def put(s: S) = LogicT.logicTMonadTrans.liftM[F, Unit](F.put(s)) 141 | } 142 | 143 | private trait LogicTMonadError[F[_], E] extends LogicTMonadPlus[F] with MonadError[LogicT[F, *], E] { 144 | 145 | implicit def F: MonadError[F, E] 146 | 147 | def raiseError[A](e: E) = LogicT.logicTMonadTrans.liftM[F, A](F.raiseError(e)) 148 | def handleError[A](l: LogicT[F, A])(f: E => LogicT[F, A]): LogicT[F, A] = new LogicT[F, A] { 149 | def apply[X](fk: F[X])(sk: A => F[X] => F[X]) = { 150 | def handle(r: F[X]): F[X] = F.handleError(r)(e => f(e)(fk)(sk)) 151 | handle(l(fk)(a => x => sk(a)(handle(x)))) 152 | } 153 | } 154 | } 155 | -------------------------------------------------------------------------------- /src/main/scala/logic/MonadLogic.scala: -------------------------------------------------------------------------------- 1 | package logic 2 | 3 | import scalaz._ 4 | 5 | trait MonadLogic[F[_]] extends MonadPlus[F] { 6 | 7 | private def maybe[A, B](m: Option[A], default: => B)(f: A => B): B = 8 | m match { 9 | case None => default 10 | case Some(a) => f(a) 11 | } 12 | 13 | def split[A](m: F[A]): F[Option[(A, F[A])]] 14 | 15 | def interleave[A](m1: F[A], m2: F[A]): F[A] = 16 | bind(split(m1))(maybe(_, m2){ case (a, m1a) => plus(pure(a), interleave(m2, m1a)) }) 17 | 18 | def >>-[A, B](m: F[A])(f: A => F[B]): F[B] = 19 | bind(bind(split(m))(maybe(_, empty[(A, F[A])])(pure(_)))) { case (a, m1) => 20 | interleave(f(a), >>-(m1)(f)) 21 | } 22 | 23 | def ifte[A, B](t: F[A], el: F[B])(th: A => F[B]): F[B] = 24 | bind(split(t))(maybe(_, el){ case (a, m) => plus(th(a), bind(m)(th)) }) 25 | 26 | def once[A](m: F[A]): F[A] = 27 | bind(bind(split(m))(maybe(_, empty[(A, F[A])])(pure(_)))) { case (a, _) => pure(a) } 28 | } 29 | 30 | object MonadLogic extends MonadLogicInstances with MonadLogicFunctions { 31 | @inline def apply[F[_]](implicit F: MonadLogic[F]): MonadLogic[F] = F 32 | } 33 | 34 | trait MonadLogicFunctions { 35 | 36 | def reflect[F[_], A](x: Option[(A, F[A])])(implicit L: MonadLogic[F]): F[A] = 37 | x match { 38 | case None => L.empty 39 | case Some((a, m)) => L.plus(L.pure(a), m) 40 | } 41 | 42 | def lnot[F[_], A](m: F[A])(implicit L: MonadLogic[F]): F[Unit] = 43 | L.ifte(L.once(m), L.pure(()))(_ => L.empty) 44 | } 45 | 46 | trait MonadLogicInstances2 { 47 | 48 | implicit def writerTMonadLogic[F[_], W](implicit L0: MonadLogic[F], M0: Monoid[W]): MonadLogic[WriterT[W, F, *]] = new WriterTMonadLogic[F, W] { 49 | implicit def L: MonadLogic[F] = L0 50 | implicit def M: Monoid[W] = M0 51 | } 52 | } 53 | 54 | trait MonadLogicInstances1 extends MonadLogicInstances2 { 55 | 56 | import scalaz.StateT._ 57 | 58 | implicit def stateTMonadLogic[F[_], S](implicit L: MonadLogic[F]): MonadLogic[StateT[S, F, *]] = new MonadLogic[StateT[S, F, *]] { 59 | def point[A](a: => A) = stateTMonadPlus[S, F].point[A](a) 60 | def bind[A, B](fa: StateT[S, F, A])(f: A => StateT[S, F, B]) = stateTMonadPlus[S, F].bind[A, B](fa)(f) 61 | def empty[A] = stateTMonadPlus[S, F].empty[A] 62 | def plus[A](a: StateT[S, F, A], b: => StateT[S, F, A]) = stateTMonadPlus[S, F].plus[A](a, b) 63 | 64 | def split[A](sm: StateT[S, F, A]) = StateT(s => 65 | L.bind(L.split(sm.run(s))) { 66 | case None => L.pure((s, None)) 67 | case Some(((s2, a), m)) => L.pure((s2, Some((a, StateT(Function.const(m)))))) 68 | }) 69 | 70 | override def interleave[A](m1: StateT[S, F, A], m2: StateT[S, F, A]): StateT[S, F, A] = StateT(s => 71 | L.interleave(m1.run(s), m2.run(s)) 72 | ) 73 | 74 | override def >>-[A, B](m: StateT[S, F, A])(f: A => StateT[S, F, B]): StateT[S, F, B] = StateT(s => 75 | L.>>-(m.run(s)){ case (s2, a) => f(a).run(s2) } 76 | ) 77 | 78 | override def ifte[A, B](t: StateT[S, F, A], el: StateT[S, F, B])(th: A => StateT[S, F, B]): StateT[S, F, B] = 79 | StateT(s => L.ifte(t.run(s), el.run(s)){ case (s2, a) => th(a).run(s2) }) 80 | 81 | override def once[A](m: StateT[S, F, A]): StateT[S, F, A] = StateT(s => L.once(m.run(s))) 82 | } 83 | } 84 | 85 | trait MonadLogicInstances0 extends MonadLogicInstances1 { 86 | 87 | import scalaz.Kleisli._ 88 | 89 | // MonadLogic[ReaderT[F, E, *]] 90 | implicit def kleisliMonadLogic[F[_], E](implicit L: MonadLogic[F]): MonadLogic[Kleisli[F, E, *]] = new MonadLogic[Kleisli[F, E, *]] { 91 | def point[A](a: => A) = kleisliMonadPlus[F, E].point[A](a) 92 | def bind[A, B](fa: Kleisli[F, E, A])(f: A => Kleisli[F, E, B]) = kleisliMonadPlus[F, E].bind[A, B](fa)(f) 93 | def empty[A] = kleisliMonadPlus[F, E].empty[A] 94 | def plus[A](a: Kleisli[F, E, A], b: => Kleisli[F, E, A]) = kleisliMonadPlus[F, E].plus[A](a, b) 95 | 96 | def split[A](rm: Kleisli[F, E, A]) = 97 | Kleisli[F, E, Option[(A, Kleisli[F, E, A])]](e => 98 | L.bind(L.split(rm.run(e))) { 99 | case None => L.pure(None) 100 | case Some((a, m)) => L.pure(Some((a, kleisliMonadTrans.liftM(m)))) 101 | }) 102 | } 103 | } 104 | 105 | trait MonadLogicInstances extends MonadLogicInstances0 { 106 | 107 | import scalaz.std.list.listInstance 108 | 109 | implicit val listMonadLogic: MonadLogic[List] = new MonadLogic[List] { 110 | def split[A](l: List[A]) = l match { 111 | case Nil => pure(None) 112 | case x::xs => pure(Some((x, xs))) 113 | } 114 | def point[A](a: => A) = listInstance.point(a) 115 | def bind[A, B](fa: List[A])(f: A => List[B]) = listInstance.bind(fa)(f) 116 | def empty[A] = listInstance.empty[A] 117 | def plus[A](a: List[A], b: => List[A]) = listInstance.plus(a, b) 118 | } 119 | } 120 | 121 | private trait WriterTMonadLogic[F[_], W] extends MonadLogic[WriterT[W, F, *]] { 122 | 123 | implicit def L: MonadLogic[F] 124 | implicit def M: Monoid[W] 125 | 126 | def tell(w: W): WriterT[W, F, Unit] = WriterT(L.pure((w, ()))) 127 | 128 | def point[A](a: => A) = WriterT.writerTMonad[W, F].point[A](a) 129 | def bind[A, B](fa: WriterT[W, F, A])(f: A => WriterT[W, F, B]) = WriterT.writerTMonad[W, F].bind[A, B](fa)(f) 130 | def empty[A] = WriterT(L.empty[(W, A)]) 131 | def plus[A](a: WriterT[W, F, A], b: => WriterT[W, F, A]) = WriterT(L.plus(a.run, b.run)) 132 | 133 | def split[A](wm: WriterT[W, F, A]) = WriterT( 134 | L.bind(L.split(wm.run)) { 135 | case None => L.pure((M.zero, None)) 136 | case Some(((w, a), m)) => L.pure((w, Some((a, WriterT(m))))) 137 | }) 138 | 139 | override def interleave[A](m1: WriterT[W, F, A], m2: WriterT[W, F, A]): WriterT[W, F, A] = 140 | WriterT(L.interleave(m1.run, m2.run)) 141 | 142 | override def >>-[A, B](m: WriterT[W, F, A])(f: A => WriterT[W, F, B]): WriterT[W, F, B] = 143 | WriterT(L.>>-(m.run){ case (w, a) => tell(w).flatMap(_ => f(a)).run }) 144 | 145 | override def ifte[A, B](t: WriterT[W, F, A], el: WriterT[W, F, B])(th: A => WriterT[W, F, B]): WriterT[W, F, B] = 146 | WriterT(L.ifte(t.run, el.run){ case (w, a) => tell(w).flatMap(_ => th(a)).run }) 147 | 148 | override def once[A](m: WriterT[W, F, A]): WriterT[W, F, A] = WriterT(L.once(m.run)) 149 | } 150 | -------------------------------------------------------------------------------- /src/main/scala/logic/package.scala: -------------------------------------------------------------------------------- 1 | package object logic { 2 | 3 | import scalaz.Id._ 4 | 5 | type Logic[A] = LogicT[Id, A] 6 | } 7 | -------------------------------------------------------------------------------- /src/main/scala/logic/syntax/MonadLogicSyntax.scala: -------------------------------------------------------------------------------- 1 | package logic 2 | package syntax 3 | 4 | import scalaz.syntax._ 5 | 6 | final class MonadLogicOps[F[_],A] private[syntax](val self: F[A])(implicit val F: MonadLogic[F]) extends Ops[F[A]] { 7 | 8 | final def split = F.split(self) 9 | 10 | final def interleave(other: F[A]) = F.interleave(self, other) 11 | 12 | final def >>-[B](f: A => F[B]) = F.>>-(self)(f) 13 | 14 | final def ifte[B](el: F[B])(th: A => F[B]) = F.ifte(self, el)(th) 15 | 16 | final def once = F.once(self) 17 | 18 | final def lnot = MonadLogic.lnot(self) 19 | } 20 | 21 | trait ToMonadLogicOps extends ToMonadPlusOps[scalaz.MonadPlus] { 22 | 23 | implicit def ToMonadLogicOps[F[_], A](v: F[A])(implicit F0: MonadLogic[F]): MonadLogicOps[F, A] = 24 | new MonadLogicOps[F,A](v) 25 | } 26 | 27 | trait MonadLogicSyntax[F[_]] extends MonadPlusSyntax[F] { 28 | 29 | implicit def ToMonadLogicOps[A](v: F[A]): MonadLogicOps[F, A] = 30 | new MonadLogicOps[F, A](v)(MonadLogicSyntax.this.F) 31 | 32 | def F: MonadLogic[F] 33 | } 34 | -------------------------------------------------------------------------------- /src/main/scala/logic/syntax/Syntaxes.scala: -------------------------------------------------------------------------------- 1 | package logic 2 | package syntax 3 | 4 | trait Syntaxes { 5 | 6 | object monadLogic extends ToMonadLogicOps 7 | } 8 | -------------------------------------------------------------------------------- /src/main/scala/logic/syntax/package.scala: -------------------------------------------------------------------------------- 1 | package logic 2 | 3 | package object syntax extends Syntaxes 4 | -------------------------------------------------------------------------------- /src/test/scala/logic/FunctionEqual.scala: -------------------------------------------------------------------------------- 1 | package logic 2 | 3 | import scalaz._ 4 | import scalaprops._ 5 | 6 | object FunctionEqual extends FunctionEqual(30) 7 | 8 | sealed class FunctionEqual(size: Int) { 9 | implicit def f1[A1: Gen, B](implicit B: Equal[B]): Equal[A1 => B] = { 10 | val values = Gen[A1].samples(listSize = size, seed = System.nanoTime) 11 | Equal.equal( (x, y) => 12 | values.forall{ a => B.equal(x(a), y(a)) } 13 | ) 14 | } 15 | 16 | implicit def f2[A1: Gen, A2: Gen, B](implicit B: Equal[B]): Equal[(A1, A2) => B] = 17 | f1[(A1, A2), B].contramap(_.tupled) 18 | 19 | implicit def f3[A1: Gen, A2: Gen, A3: Gen, B](implicit B: Equal[B]): Equal[(A1, A2, A3) => B] = 20 | f1[(A1, A2, A3), B].contramap(_.tupled) 21 | } 22 | -------------------------------------------------------------------------------- /src/test/scala/logic/LogicSpec.scala: -------------------------------------------------------------------------------- 1 | package logic 2 | 3 | import scalaz._ 4 | import scalaz.std.AllInstances._ 5 | import FunctionEqual._ 6 | import scalaprops._ 7 | import scalaprops.ScalapropsScalaz._ 8 | 9 | sealed abstract class LogicSpec extends Scalaprops { 10 | 11 | protected[this] implicit def stateTEqual[F[_]: Monad, A, B](implicit F: Equal[A => F[(A, B)]]): Equal[StateT[A, F, B]] = 12 | F.contramap(_.apply _) 13 | 14 | protected[this] implicit def kleisliEqual[F[_], A: Gen, B](implicit E: Equal[F[B]]): Equal[Kleisli[F, A, B]] = 15 | Equal[A => F[B]].contramap(_.run) 16 | 17 | protected[this] implicit def logicGen[A: Gen]: Gen[Logic[A]] = 18 | Gen[List[A]].map(xs => 19 | new Logic[A] { 20 | def apply[R](l: R)(f: A => R => R) = 21 | xs.foldRight(l)((a, b) => f(a)(b)) 22 | } 23 | ) 24 | 25 | protected[this] implicit def logicEqual[A: Equal]: Equal[Logic[A]] = 26 | Equal.equal[Logic[A]] { (a, b) => 27 | import scalaz.syntax.equal._ 28 | val f1 = (l: Logic[A]) => l.observe 29 | val f2 = (l: Logic[A]) => l.observeAll 30 | (f1(a) === f1(b)) && (f2(a) === f2(b)) 31 | } 32 | } 33 | 34 | object LogicTest extends LogicSpec{ 35 | val laws = 36 | Properties.either( 37 | "Logic", 38 | scalazlaws.monadPlus.all[Logic], 39 | scalazlaws.traverse.all[Logic] 40 | ) 41 | } 42 | 43 | object ListLogicTest extends LogicSpec { 44 | val listMonadLogicLaws = 45 | MonadLogicLaw.laws[List] 46 | } 47 | 48 | object StateTLogicTest extends LogicSpec { 49 | val stateT = 50 | MonadLogicLaw.laws[StateT[List[Int], List, *]] 51 | .ignore("original haskell implementation don't satisfy split value law...") 52 | } 53 | 54 | object KleisliLogicTest extends LogicSpec { 55 | val kleisli = 56 | MonadLogicLaw.laws[Kleisli[List, List[Int], *]] 57 | .ignore("original haskell implementation don't satisfy split value law...") 58 | } 59 | 60 | object WriterTLogicTest extends LogicSpec { 61 | val writer = 62 | MonadLogicLaw.laws[WriterT[List[Int], List, *]] 63 | .ignore("original haskell implementation don't satisfy reflect law...") 64 | } 65 | 66 | object InstancesTest { 67 | def functor[F[_] : Functor] = Functor[LogicT[F, *]] 68 | def apply[F[_] : Apply] = Apply[LogicT[F, *]] 69 | def plus[F[_] : Plus] = Plus[LogicT[F, *]] 70 | def empty[F[_] : PlusEmpty] = PlusEmpty[LogicT[F, *]] 71 | 72 | // checking absence of ambiguity 73 | def functor[F[_] : Monad] = Functor[LogicT[F, *]] 74 | def apply[F[_] : Monad] = Apply[LogicT[F, *]] 75 | def plus[F[_] : PlusEmpty] = Plus[LogicT[F, *]] 76 | def empty[F[_] : MonadPlus] = PlusEmpty[LogicT[F, *]] 77 | } 78 | -------------------------------------------------------------------------------- /src/test/scala/logic/MonadLogicLaw.scala: -------------------------------------------------------------------------------- 1 | package logic 2 | 3 | import scalaz._ 4 | import scalaprops._ 5 | 6 | object MonadLogicLaw { 7 | 8 | def splitEmpty[F[_], A](implicit M: MonadLogic[F], E: Equal[F[Option[(A, F[A])]]]) = 9 | Property.prop(E.equal(M.split(M.empty), M.pure(None))) 10 | 11 | def splitValues[F[_], A](implicit M: MonadLogic[F], F: Gen[F[A]], A: Gen[A], 12 | E: Equal[F[Option[(A, F[A])]]]) = 13 | Property.forAll { (a: A, m: F[A]) => 14 | E.equal(M.split(M.plus(M.pure(a), m)), M.pure(Some((a, m)))) 15 | } 16 | 17 | def reflect[F[_], A](implicit M: MonadLogic[F], F: Gen[F[A]], 18 | A: Gen[A], E: Equal[F[A]]) = 19 | Property.forAll { (m: F[A]) => 20 | E.equal(M.bind(M.split(m))(MonadLogic.reflect(_)), m) 21 | } 22 | 23 | def laws[F[_]](implicit 24 | M: MonadLogic[F], 25 | F: Gen[F[Int]], 26 | E1: Equal[F[Option[(Int, F[Int])]]], 27 | E2: Equal[F[Int]] 28 | ) = Properties.properties("monadLogic")( 29 | "split empty" -> splitEmpty[F, Int], 30 | "split values" -> splitValues[F, Int], 31 | "reflect" -> reflect[F, Int] 32 | ) 33 | } 34 | -------------------------------------------------------------------------------- /version.sbt: -------------------------------------------------------------------------------- 1 | ThisBuild / version := "0.1.3-SNAPSHOT" 2 | --------------------------------------------------------------------------------