不同类型的通用功能

Common functionality for different types

我已经在我的两种数据类型中确定了一些共同的功能,所以就像任何称职的程序员一样,我试图将其分解出来:

module Binary where

import Control.Applicative
import Data.Function
import Control.Monad


class Binary f where
  yes :: f a a
  no  :: f a b
  (..>) :: f a b -> f b c -> f a c

  yes' :: f a ()
  (~.>) :: f a b -> f a c -> f a c


try :: (Binary f, Alternative (f a)) => f a a -> f a a
try = (<|> yes)

try' :: (Binary f, Alternative (f a)) => f a () -> f a ()
try' = (<|> yes')

(.>) :: (Binary f, Alternative (f c)) => f a c -> f c c -> f a c
a .> b = a ..> try b

(~>) :: (Binary f, Alternative (f a)) => f a b -> f a () -> f a ()
a ~> b = a ~.> try' b

greedy :: (Binary f, Alternative (f a)) => f a a -> f a a
greedy = fix $ ap (.>)

greedy' :: (Binary f, Alternative (f a)) => f a () -> f a ()
greedy' = fix $ ap (~>)

如你所见,yesyes'..>~.>的类型略有不同-他们需要我写实例- 所以我最终得到了重复的函数。

有什么方法可以去掉 yes'~.>,并且仍然使用这些类型创建一个 Binary 实例?

这是我的两个实例:

module Example where

import Binary

import Prelude hiding ((.), id)
import Control.Category
import Data.List.Zipper as Z
import Control.Monad.Trans.Maybe
import Control.Monad.State


newtype Opt a b = Opt { runOpt :: a -> Maybe b }

instance Category Opt where
  id = yes
  (Opt f) . (Opt g) = Opt $ g >=> f

instance Binary Opt where
  yes = Opt Just
  no = Opt $ const Nothing
  (..>) = (>>>)

---------

type Tape = Zipper
newtype Machine a b = Machine { unMachine :: MaybeT (State (Tape a)) b }

instance Functor (Machine a) where
  fmap f (Machine x) = Machine $ f <$> x

instance Applicative (Machine a) where
  pure = Machine . pure
  (Machine f) <*> (Machine x) = Machine $ f <*> x

instance Monad (Machine a) where
  (Machine a) >>= f = Machine $ a >>= unMachine <$> f

instance Binary Machine where
  no = Machine mzero
  yes' = pure ()
  a ~.> b = a >> b

我认为您的两个实例存在细微的不一致——也就是说,OptMachine 没有足够的共同点来共享这么多结构。例如,方法

yes :: f a a
(..>) :: f a b -> f b c -> f a c
正如您所注意到的,

本质上是一个 Category(尽管我只是将 Category 设为 Binary 的超类,而不是复制这些方法)。但是 Machine 不是类别,因为它不支持组合。此外,Opt 是一个profunctor(第一个参数是逆变的,第二个参数是协变的),而 Machine 在第一个参数上是不变的。这些是我的提示,在您尝试对这些类型进行抽象之前需要更改某些内容。

我怀疑 Machine 缺少参数,状态参数实际上在 Binary 抽象之外。尝试使用 monad 的 Kleisli category

newtype Machine s a b = Machine { unMachine :: a -> MaybeT (State (Tape s)) b }

现在 Machine s 是一个 Category 并且 BinaryOpt 是同一种类型,你不需要任何引数组合器,而且你如果需要,可以将任何旧的 Machine a b 表示为 Machine a () b,但您也可以概括它们。

事实上,您正在寻找的抽象可能只是 ArrowZeroArrow 的结构比 Category 多一点,因此您应该考虑 Arrow 的其余部分是否适用于您的问题。如果是这样,您刚刚打开了一个新的组合器工具箱,您不需要手动编写任何实例,因为它们都包含在:

 type Opt = Kleisli Maybe
 type Machine s = Kleisli (MaybeT (State s))

(或者 newtype 风格 GeneralizedNewtypeDeriving 如果你喜欢的话)