适用于用户定义的类型

Applicative for a user defined type

我正在尝试为这种类型编写 Applicative

data Choice a = ColumnA a | ColumnB a

我写了一个 Functor 实例:

instance Functor Choice where 
  fmap f (ColumnA a ) = (ColumnA (f a) )
  fmap f (ColumnB a ) = (ColumnB (f a) ) 

现在我想编写 Applicative,其中 ColumnB 被认为是 "a correct value" 并且 ColumnA 被认为是某种错误。

我试过了

instance Applicative Choice where
    pure             =  ColumnB  
    ColumnB f  <*>  r  =  fmap f r
    ColumnA f  <*>  _  =  ColumnA  f   --- this does not work 

我怎样才能让它发挥作用?

如果 ColumnA 被认为是某种错误,您不能让它包装 a 值。的确。 (<*>)的想法是它需要一个Choice (x -> y)Choice x,而return是一个Choice y。但是如果你有一个 ColumnA 包装了一个 x -> y 类型的函数,并且你在右边有一个 Choice x,那么它应该 return 一个 Choice y, 而不是 Choice x.

你可以做的是用两个类型参数定义一个类型,例如:

data Choice <b>a b</b> = ColumnA <b>a</b> | ColumnB <b>b</b>

那么你只对 ColumnB b 数据构造函数执行映射:

instance Functor (Choice <b>a</b>) where
    fmap _ (ColumnA e) = ColumnA e
    fmap f (ColumnB x) = ColumnB (f x)

然后我们可以将 Applicative 实例定义为:

instance Applicative (Choice <b>a</b>) where
    pure = ColumnB
    ColumnB f <*> ColumnB x = ColumnB <b>(f x)</b>
    ColumnA e <*> _ = ColumnA e
    _ <*> ColumnA e = ColumnA e

但是 FunctorApplicative 的此类实例已经存在:这就是它在 Either data type.

上的定义方式

让我们重命名您的数据构造函数以正确表达您的意图,如

data Choice a = Bad a | Good a

您的 Functor 实例保留了值的污点,

instance Functor Choice where 
  fmap f (Bad  x)  =  Bad  (f x) 
  fmap f (Good x)  =  Good (f x) 

所以让我们对 Applicative 做同样的事情,不要吝啬我们的子句:

instance Applicative Choice where
    pure              x  =  Good    x     -- fmap f == (pure f <*>) is the Law
    Good f  <*>  Good x  =  Good (f x)
    Good f  <*>  Bad  x  =  Bad  (f x)
    Bad  f  <*>  Good x  =  Bad  (f x)
    Bad  f  <*>  Bad  x  =  Bad  (f x)

正如评论中指出的那样,这将 Choice a 解释为与 Writer All a 同构,意思是,Choice a 值实际上就像 (Bool, a)(False, x)对应Bad x(True, x)对应Good x。自然地,我们只认为值是 Good,如果它们的出处也是 Good

我制作了一个用于导出 Applicative 和类型的包:idiomatic

Choice可以偏左也可以偏右,如果偏左那么ChoiceA就是纯构造函数,把A和B的缺陷结合到ChoiceB

{-# Language DerivingVia #-}
{-# Language DerivingStrategies #-}
{-# Language DeriveGeneric #-}
{-# Language DataKinds  #-}

import Generic.Applicative
import GHC.Generics

data Choice a = ColumnA a | ColumnB a
  deriving 
  stock (Show, Generic1)

  -- pure :: a -> Choice a
  -- pure = ColumnA
  -- 
  -- liftA2 :: (a -> b -> c) -> (Choice a -> Choice b -> Choice c)
  -- liftA2 (·) (ColumnA a) (ColumnA a') = ColumnA (a · a')
  -- liftA2 (·) (ColumnA a) (ColumnB b)  = ColumnB (a · b)
  -- liftA2 (·) (ColumnB b) (ColumnA a)  = ColumnB (b · a)
  -- liftA2 (·) (ColumnB b) (ColumnB b') = ColumnB (b · b')
  deriving (Functor, Applicative)
  via Idiomatically Choice '[LeftBias Id]

和 right-bias 表示 ChoiceB 是纯构造函数并将 A 和 B 缺陷组合到 ChoiceA:

  -- pure :: a -> Choice a
  -- pure = ColumnB
  -- 
  -- liftA2 :: (a -> b -> c) -> (Choice a -> Choice b -> Choice c)
  -- liftA2 (·) (ColumnA a) (ColumnA a') = ColumnA (a · a')
  -- liftA2 (·) (ColumnA a) (ColumnB b)  = ColumnA (a · b)
  -- liftA2 (·) (ColumnB b) (ColumnA a)  = ColumnA (b · a)
  -- liftA2 (·) (ColumnB b) (ColumnB b') = ColumnB (b · b')
  deriving (Functor, Applicative)
  via Idiomatically Choice '[RightBias Id]