结构上强制执行的免费替代方案，没有左派分配权
Structurally enforced Free Alternative, without left distributivity
很棒的 free 软件包中有一个不错的 Free Alternative，它将 Functor 提升为左分配替代方案。
也就是说，声明是：
runAlt :: Alternative g => (forall x. f x -> g x) -> Alt f a -> g a
是另类同态，与liftAlt。而且，确实，它 是 一个，但仅适用于 left-distributive 个替代实例。
当然，现实中很少有Alternative实例是真正左分配的。大多数实际重要的替代实例（解析器，大多数 Monad f 的 MaybeT f 等）都不是左分配的。这个事实可以通过一个例子来证明，其中 runAlt 和 liftAlt 不形成替代同态：
(writeIORef x False <|> writeIORef True) *> (guard =<< readIORef x)
-- is an IO action that throws an exception
runAlt id $ (liftAlt (writeIORef x False) <|> liftAlt (writeIORef True))
*> liftAlt (guard =<< readIORef x)
-- is an IO action that throws no exception and returns successfully ()
所以runAlt只是一些Alternatives的Alternative同态，但不是全部。这是因为 Alt 的结构规范化 所有动作分布在左边。
Alt 很棒，因为在结构上，Alt f 是合法的 Applicative 和 Alternative。没有任何可能的方法可以使用不遵守法律的应用和替代函数来构造 Alt f a 类型的值...类型本身的结构使其成为免费的替代品。
就像列表一样，您不能使用不遵守 x <> mempty = x、mempty <> x = x 和关联性的 <> 和 mempty 来构造列表。
我写了一个免费的替代方案，不在结构上执行应用和替代法则，但确实产生一个有效的runAlt/liftAlt 的替代和应用同态：
data Alt :: (* -> *) -> * -> * where
Pure :: a -> Alt f a
Lift :: f a -> Alt f a
Empty :: Alt f a
Ap :: Alt f (a -> b) -> Alt f a -> Alt f b
Plus :: Alt f as -> Alt f as -> Alt f as
instance Functor f => Functor (Alt f) where
fmap f = \case
Pure x -> Pure (f x)
Lift x -> Lift (f <$> x)
Empty -> Empty
Ap fs xs -> Ap ((f .) <$> fs) xs
Plus xs ys -> Plus (f <$> xs) (f <$> ys)
instance Functor f => Applicative (Alt f) where
pure = Pure
(<*>) = Ap
instance Functor f => Alternative (Alt f) where
empty = Empty
(<|>) = Plus
在结构上，Alt f 不是实际的 Applicative，因为：
pure f <*> pure x = Ap (Pure f) (Pure x)
pure (f x) = Pure (f x)
所以 pure f <*> pure x 在结构上与 pure (f x) 不同。不是有效的应用程序，马上就可以了。
但是，给定runAlt和liftAlt：
liftAlt :: f a -> Alt f a
liftAlt = Lift
runAlt :: Alternative g => (forall x. f x -> g x) -> Alt f a -> g a
runAlt f = \case
Pure x -> pure x
Lift x -> f x
Empty -> empty
Ap fs xs -> runAlt f fs <*> runAlt f xs
Plus xs ys -> runAlt f xs <|> runAlt f ys
并且 runAlt 这里确实充当了具有给定自然变换的有效应用同态...
我想可以说我的新 Alt f 是一个有效的替代和应用，当与 runAlt 定义的等价关系相商时。
无论如何，这只是有点不满意。有没有什么方法可以编写一个结构上有效的替代和适用的替代方案，没有强制左分配？
（特别是，我实际上对遵循 left catch 法律并在结构上执行它的法律感兴趣。这将是一个独立且有趣的事情，但并非完全必要。）
而且，如果没有办法，为什么不呢？
Control.Alternative.Free 的 Alt f 免费生成左分配 Alternative，即使 f 不是 Alternative 或 f是一个非左分配的Alternative。我们可以说，除了商定好的替代法则
empty <|> x = x
x <|> empty = x
(x <|> y) <|> z = x <|> (y <|> z)
empty <*> f = empty
Alt f还免费赠送左派
(a <|> b) <*> c = (a <*> c) <|> (b <*> c)
因为 Alt f 总是左分配的（和 runAlt . liftAlt = id）liftAlt 永远不可能是非左分配的 Alternative 的同态。如果 Alternative f 不是左分配的，则存在 a、b 和 c 使得
(a <|> b) <*> c != (a <*> c) <|> (b <*> c)
如果liftAlt : f -> Alt f是一个同态那么
(a <|> b) <*> c != (a <*> c) <|> (b <*> c) -- f is not left-distributive
id ((a <|> b) <*> c) != id ((a <*> c) <|> (b <*> c))
runAlt . liftAlt ((a <|> b) <*> c) != runAlt . liftAlt ((a <*> c) <|> (b <*> c)) -- runAlt . liftAlt = id
runAlt ((liftAlt a <|> liftAlt b) <*> liftAlt c) != runAlt ((liftAlt a <*> liftAlt c) <|> (liftAlt b <*> liftAlt c)) -- homomorphism
runAlt ((liftAlt a <|> liftAlt b) <*> liftAlt c) != runAlt ((liftAlt a <|> liftAlt b) <*> liftAlt c) -- by left-distribution of `Alt`, this is a contradiction
为了证明这一点，我们需要一个非左分配的 Alternative。这是一个，FlipAp [].
newtype FlipAp f a = FlipAp {unFlipAp :: f a}
deriving Show
instance Functor f => Functor (FlipAp f) where
fmap f (FlipAp x) = FlipAp (fmap f x)
instance Applicative f => Applicative (FlipAp f) where
pure = FlipAp . pure
(FlipAp f) <*> (FlipAp xs) = FlipAp ((flip ($) <$> xs) <*> f)
instance Alternative f => Alternative (FlipAp f) where
empty = FlipAp empty
(FlipAp a) <|> (FlipAp b) = FlipAp (a <|> b)
以及左分配和右分配的一些规律，以及一些例子
leftDist :: Alternative f => f (x -> y) -> f (x -> y) -> f x -> Example (f y)
leftDist a b c = [(a <|> b) <*> c, (a <*> c) <|> (b <*> c)]
rightDist :: Alternative f => f (x -> y) -> f x -> f x -> Example (f y)
rightDist a b c = [a <*> (b <|> c), (a <*> b) <|> (a <*> c)]
type Example a = [a]
ldExample1 :: Alternative f => Example (f Int)
ldExample1 = leftDist (pure (+1)) (pure (*10)) (pure 2 <|> pure 3)
rdExample1 :: Alternative f => Example (f Int)
rdExample1 = rightDist (pure (+1) <|> pure (*10)) (pure 2) (pure 3)
我们可以演示列表、FlipAp 列表和 runAlt.
的一些属性
列表是左分配的，但 FlipAp 列表不是
ldExample1 :: Example [Int]
ldExample1 :: Example (FlipAp [] Int)
[[3,4,20,30],[3,4,20,30]]
[FlipAp {unFlipAp = [3,20,4,30]},FlipAp {unFlipAp = [3,4,20,30]}]
列表不是右分配的，但 FlipAp 列表是
rdExample1 :: Example [Int]
rdExample1 :: Example (FlipAp [] Int)
[[3,4,20,30],[3,20,4,30]]
[FlipAp {unFlipAp = [3,20,4,30]},FlipAp {unFlipAp = [3,20,4,30]}]
Alt 总是左分配的
map (runAlt id) ldExample1 :: Example [Int]
map (runAlt id) ldExample1 :: Example (FlipAp [] Int)
[[3,4,20,30],[3,4,20,30]]
[FlipAp {unFlipAp = [3,4,20,30]},FlipAp {unFlipAp = [3,4,20,30]}]
Alt 永远不是右分配的
map (runAlt id) rdExample1 :: Example [Int]
map (runAlt id) rdExample1 :: Example (FlipAp [] Int)
[[3,4,20,30],[3,20,4,30]]
[FlipAp {unFlipAp = [3,4,20,30]},FlipAp {unFlipAp = [3,20,4,30]}]
我们可以根据 FlipAp 和 Alt.
玷污右分配的自由选择
runFlipAlt :: forall f g a. Alternative g => (forall x. f x -> g x) -> FlipAp (Alt f) a -> g a
runFlipAlt nt = runAlt nt . unFlipAp
FlipAp Alt 永远不会左分配。
map (runFlipAlt id) ldExample1 :: Example [Int]
map (runFlipAlt id) ldExample1 :: Example (FlipAp [] Int)
[[3,20,4,30],[3,4,20,30]]
[FlipAp {unFlipAp = [3,20,4,30]},FlipAp {unFlipAp = [3,4,20,30]}]
FlipAp Alt 总是右分配的
map (runFlipAlt id) rdExample1 :: Example [Int]
map (runFlipAlt id) rdExample1 :: Example (FlipAp [] Int)
[[3,20,4,30],[3,20,4,30]]
[FlipAp {unFlipAp = [3,20,4,30]},FlipAp {unFlipAp = [3,20,4,30]}]
到目前为止，我还没有告诉你任何你没有通过说 liftAlt : f -> Alt f 是 Alternative 同态，但仅针对 左分配的暗示 替代实例。但是我已经向您展示了一个非左分配的自由替代方案（它通常是右分配的）。
结构上有效的免费 Alternative
这部分回答了您的大部分问题，是否存在 结构上 有效的免费 Alternative 不是左分配的？是的。
这不是一个有效的实施；它的目的是证明它的存在，并且可以直接获得它的某个版本。
为了使结构有效的免费 Alternative 我正在做两件事。第一个是创建一个不能代表任何 Alternative 定律的数据结构；如果它不能代表法律，那么就不能独立于类型 class 构造一个结构来违反它。这与使列表在结构上遵守 Alternative 结合律的技巧相同；没有可以表示左关联 (x <|> y) <|> z 的列表。二是依法经营。列表不能表示左关联律，但 <|> 的实现仍然可能违反它，例如 x <|> y = x ++ reverse y.
无法构造以下结构来表示任何 Alternative 定律。
{-# Language GADTs #-}
{-# Language DataKinds #-}
{-# Language KindSignatures #-}
data Alt :: (* -> *) -> * -> * where
Alt :: Alt' empty pure plus f a -> Alt f a
-- empty pure plus
data Alt' :: Bool -> Bool -> Bool -> (* -> *) -> * -> * where
Empty :: Alt' True False False f a
Pure :: a -> Alt' False True False f a
Lift :: f a -> Alt' False False False f a
Plus :: Alt' False pure1 False f a -> Alt' False pure2 plus2 f a -> Alt' False False True f a
-- Empty can't be to the left or right of Plus
-- empty <|> x = x
-- x <|> empty = x
-- Plus can't be to the left of Plus
-- (x <|> y) <|> z = x <|> (y <|> z)
Ap :: Alt' False False plus1 f (a -> b) -> Alt' empty False plus2 f a -> Alt' False False False f b
-- Empty can't be to the left of `Ap`
-- empty <*> f = empty
-- Pure can't be to the left or right of `Ap`
-- pure id <*> v = v
-- pure (.) <*> u <*> v <*> w = u <*> (v <*> w)
-- pure f <*> pure x = pure (f x)
-- u <*> pure y = pure ($ y) <*> u
这是一个Functor
instance Functor f => Functor (Alt' empty pure plus f) where
fmap _ Empty = Empty
fmap f (Pure a) = Pure (f a)
fmap f (Plus a as) = Plus (fmap f a) (fmap f as)
fmap f (Lift a) = Lift (fmap f a)
fmap f (Ap g a) = Ap (fmap (f .) g) a
instance Functor f => Functor (Alt f) where
fmap f (Alt a) = Alt (fmap f a)
它是 Applicative。因为结构不能代表规律，所以当我们遇到一个包含无法避免的表达式之一的术语时，我们不得不将其转换为其他内容。法律告诉我们该怎么做。
instance Functor f => Applicative (Alt f) where
pure a = Alt (Pure a)
Alt Empty <*> _ = Alt Empty -- empty <*> f = empty
Alt (Pure f) <*> (Alt x) = Alt (fmap f x) -- pure f <*> x = fmap f x (free theorem)
Alt u <*> (Alt (Pure y)) = Alt (fmap ($ y) u) -- u <*> pure y = pure ($ y) <*> u
Alt f@(Lift _) <*> Alt x@Empty = Alt (Ap f x)
Alt f@(Lift _) <*> Alt x@(Lift _) = Alt (Ap f x)
Alt f@(Lift _) <*> Alt x@(Plus _ _) = Alt (Ap f x)
Alt f@(Lift _) <*> Alt x@(Ap _ _) = Alt (Ap f x)
Alt f@(Plus _ _) <*> Alt x@Empty = Alt (Ap f x)
Alt f@(Plus _ _) <*> Alt x@(Lift _) = Alt (Ap f x)
Alt f@(Plus _ _) <*> Alt x@(Plus _ _) = Alt (Ap f x)
Alt f@(Plus _ _) <*> Alt x@(Ap _ _) = Alt (Ap f x)
Alt f@(Ap _ _) <*> Alt x@Empty = Alt (Ap f x)
Alt f@(Ap _ _) <*> Alt x@(Lift _) = Alt (Ap f x)
Alt f@(Ap _ _) <*> Alt x@(Plus _ _) = Alt (Ap f x)
Alt f@(Ap _ _) <*> Alt x@(Ap _ _) = Alt (Ap f x)
所有这些 Ap 都可以被一对视图模式覆盖，但这并没有使它变得更简单。
它也是一个Alternative。为此，我们将使用一个视图模式将案例分为空案例和非空案例，并使用一个额外的类型来存储它们非空的证明
{-# Language ViewPatterns #-}
import Control.Applicative
data AltEmpty :: (* -> *) -> * -> * where
Empty_ :: Alt' True False False f a -> AltEmpty f a
NonEmpty_ :: AltNE f a -> AltEmpty f a
data AltNE :: (* -> *) -> * -> * where
AltNE :: Alt' False pure plus f a -> AltNE f a
empty_ :: Alt' e1 p1 p2 f a -> AltEmpty f a
empty_ x@Empty = Empty_ x
empty_ x@(Pure _) = NonEmpty_ (AltNE x)
empty_ x@(Lift _) = NonEmpty_ (AltNE x)
empty_ x@(Plus _ _) = NonEmpty_ (AltNE x)
empty_ x@(Ap _ _) = NonEmpty_ (AltNE x)
instance Functor f => Alternative (Alt f) where
empty = Alt Empty
Alt Empty <|> x = x -- empty <|> x = x
x <|> Alt Empty = x -- x <|> empty = x
Alt (empty_ -> NonEmpty_ a) <|> Alt (empty_ -> NonEmpty_ b) = case a <> b of AltNE c -> Alt c
where
(<>) :: AltNE f a -> AltNE f a -> AltNE f a
AltNE (Plus x y) <> AltNE z = AltNE x <> (AltNE y <> AltNE z) -- (x <|> y) <|> x = x <|> (y <|> z)
AltNE a@(Pure _) <> AltNE b = AltNE (Plus a b)
AltNE a@(Lift _) <> AltNE b = AltNE (Plus a b)
AltNE a@(Ap _ _) <> AltNE b = AltNE (Plus a b)
liftAlt 和 runAlt
{-# Language RankNTypes #-}
{-# Language ScopedTypeVariables #-}
liftAlt :: f a -> Alt f a
liftAlt = Alt . Lift
runAlt' :: forall f g x empty pure plus a. Alternative g => (forall x. f x -> g x) -> Alt' empty pure plus f a -> g a
runAlt' u = go
where
go :: forall empty pure plus a. Alt' empty pure plus f a -> g a
go Empty = empty
go (Pure a) = pure a
go (Lift a) = u a
go (Plus x y) = go x <|> go y
go (Ap f x) = go f <*> go x
runAlt :: Alternative g => (forall x. f x -> g x) -> Alt f a -> g a
runAlt u (Alt x) = runAlt' u x
这个新的 Alt f 不免费提供左分发或右分发，因此 runAlt id :: Alt f a -> g a 保留了 g 的分发方式。
列表仍然是左分配的，但 FlipAp 列表不是。
map (runAlt id) ldExample1 :: Example [Int]
map (runAlt id) ldExample1 :: Example (FlipAp [] Int)
[[3,4,20,30],[3,4,20,30]]
[FlipAp {unFlipAp = [3,20,4,30]},FlipAp {unFlipAp = [3,4,20,30]}]
列表不是右分配的，但 FlipAp 列表仍然是
map (runAlt id) rdExample1 :: Example [Int]
map (runAlt id) rdExample1 :: Example (FlipAp [] Int)
[[3,4,20,30],[3,20,4,30]]
[FlipAp {unFlipAp = [3,20,4,30]},FlipAp {unFlipAp = [3,20,4,30]}]
Source code 本节
结构有效的 left-catch free Alternative
为了控制我们想要的定律，我们可以将它们添加到我们之前制作的结构自由的替代方案中。
要添加 left-catch，我们将修改结构，使其无法表示。左边是
（纯 a）<|> x = 纯 a
为了不让 Alt' 代表它，我们将从 Plus 左侧允许的内容中排除 pure。
-- empty pure plus
data Alt' :: Bool -> Bool -> Bool -> (* -> *) -> * -> * where
Empty :: Alt' True False False f a
Pure :: a -> Alt' False True False f a
Lift :: f a -> Alt' False False False f a
Plus :: Alt' False False False f a -> Alt' False pure2 plus2 f a -> Alt' False False True f a
-- Empty can't be to the left or right of Plus
-- empty <|> x = x
-- x <|> empty = x
-- Plus can't be to the left of Plus
-- (x <|> y) <|> z = x <|> (y <|> z)
-- Pure can't be to the left of Plus
-- (pure a) <|> x = pure a
...
这会导致在 Alternative Alt
的实现中出现编译器错误
Couldn't match type ‘'True’ with ‘'False’
Expected type: Alt' 'False 'False 'False f a1
Actual type: Alt' 'False pure2 plus2 f a1
In the first argument of ‘Plus’, namely ‘a’
In the first argument of ‘AltNE’, namely ‘(Plus a b)
我们可以通过诉诸我们的新法律来解决这个问题，(pure a) <|> x = pure a
instance Functor f => Alternative (Alt f) where
empty = Alt Empty
Alt Empty <|> x = x -- empty <|> x = x
x <|> Alt Empty = x -- x <|> empty = x
Alt (empty_ -> NonEmpty_ a) <|> Alt (empty_ -> NonEmpty_ b) = case a <> b of AltNE c -> Alt c
where
(<>) :: AltNE f a -> AltNE f a -> AltNE f a
AltNE a@(Pure _) <> _ = AltNE a -- (pure a) <|> x = pure a
AltNE (Plus x y) <> AltNE z = AltNE x <> (AltNE y <> AltNE z) -- (x <|> y) <|> x = x <|> (y <|> z)
AltNE a@(Lift _) <> AltNE b = AltNE (Plus a b)
AltNE a@(Ap _ _) <> AltNE b = AltNE (Plus a b)
很棒的 free 软件包中有一个不错的 Free Alternative，它将 Functor 提升为左分配替代方案。
也就是说，声明是：
runAlt :: Alternative g => (forall x. f x -> g x) -> Alt f a -> g a
是另类同态，与liftAlt。而且，确实，它 是 一个，但仅适用于 left-distributive 个替代实例。
当然，现实中很少有Alternative实例是真正左分配的。大多数实际重要的替代实例（解析器，大多数 Monad f 的 MaybeT f 等）都不是左分配的。这个事实可以通过一个例子来证明，其中 runAlt 和 liftAlt 不形成替代同态：
(writeIORef x False <|> writeIORef True) *> (guard =<< readIORef x)
-- is an IO action that throws an exception
runAlt id $ (liftAlt (writeIORef x False) <|> liftAlt (writeIORef True))
*> liftAlt (guard =<< readIORef x)
-- is an IO action that throws no exception and returns successfully ()
所以runAlt只是一些Alternatives的Alternative同态，但不是全部。这是因为 Alt 的结构规范化 所有动作分布在左边。
Alt 很棒，因为在结构上，Alt f 是合法的 Applicative 和 Alternative。没有任何可能的方法可以使用不遵守法律的应用和替代函数来构造 Alt f a 类型的值...类型本身的结构使其成为免费的替代品。
就像列表一样，您不能使用不遵守 x <> mempty = x、mempty <> x = x 和关联性的 <> 和 mempty 来构造列表。
我写了一个免费的替代方案，不在结构上执行应用和替代法则，但确实产生一个有效的runAlt/liftAlt 的替代和应用同态：
data Alt :: (* -> *) -> * -> * where
Pure :: a -> Alt f a
Lift :: f a -> Alt f a
Empty :: Alt f a
Ap :: Alt f (a -> b) -> Alt f a -> Alt f b
Plus :: Alt f as -> Alt f as -> Alt f as
instance Functor f => Functor (Alt f) where
fmap f = \case
Pure x -> Pure (f x)
Lift x -> Lift (f <$> x)
Empty -> Empty
Ap fs xs -> Ap ((f .) <$> fs) xs
Plus xs ys -> Plus (f <$> xs) (f <$> ys)
instance Functor f => Applicative (Alt f) where
pure = Pure
(<*>) = Ap
instance Functor f => Alternative (Alt f) where
empty = Empty
(<|>) = Plus
在结构上，Alt f 不是实际的 Applicative，因为：
pure f <*> pure x = Ap (Pure f) (Pure x)
pure (f x) = Pure (f x)
所以 pure f <*> pure x 在结构上与 pure (f x) 不同。不是有效的应用程序，马上就可以了。
但是，给定runAlt和liftAlt：
liftAlt :: f a -> Alt f a
liftAlt = Lift
runAlt :: Alternative g => (forall x. f x -> g x) -> Alt f a -> g a
runAlt f = \case
Pure x -> pure x
Lift x -> f x
Empty -> empty
Ap fs xs -> runAlt f fs <*> runAlt f xs
Plus xs ys -> runAlt f xs <|> runAlt f ys
并且 runAlt 这里确实充当了具有给定自然变换的有效应用同态...
我想可以说我的新 Alt f 是一个有效的替代和应用，当与 runAlt 定义的等价关系相商时。
无论如何，这只是有点不满意。有没有什么方法可以编写一个结构上有效的替代和适用的替代方案，没有强制左分配？
（特别是，我实际上对遵循 left catch 法律并在结构上执行它的法律感兴趣。这将是一个独立且有趣的事情，但并非完全必要。）
而且，如果没有办法，为什么不呢？
Control.Alternative.Free 的 Alt f 免费生成左分配 Alternative，即使 f 不是 Alternative 或 f是一个非左分配的Alternative。我们可以说，除了商定好的替代法则
empty <|> x = x
x <|> empty = x
(x <|> y) <|> z = x <|> (y <|> z)
empty <*> f = empty
Alt f还免费赠送左派
(a <|> b) <*> c = (a <*> c) <|> (b <*> c)
因为 Alt f 总是左分配的（和 runAlt . liftAlt = id）liftAlt 永远不可能是非左分配的 Alternative 的同态。如果 Alternative f 不是左分配的，则存在 a、b 和 c 使得
(a <|> b) <*> c != (a <*> c) <|> (b <*> c)
如果liftAlt : f -> Alt f是一个同态那么
(a <|> b) <*> c != (a <*> c) <|> (b <*> c) -- f is not left-distributive
id ((a <|> b) <*> c) != id ((a <*> c) <|> (b <*> c))
runAlt . liftAlt ((a <|> b) <*> c) != runAlt . liftAlt ((a <*> c) <|> (b <*> c)) -- runAlt . liftAlt = id
runAlt ((liftAlt a <|> liftAlt b) <*> liftAlt c) != runAlt ((liftAlt a <*> liftAlt c) <|> (liftAlt b <*> liftAlt c)) -- homomorphism
runAlt ((liftAlt a <|> liftAlt b) <*> liftAlt c) != runAlt ((liftAlt a <|> liftAlt b) <*> liftAlt c) -- by left-distribution of `Alt`, this is a contradiction
为了证明这一点，我们需要一个非左分配的 Alternative。这是一个，FlipAp [].
newtype FlipAp f a = FlipAp {unFlipAp :: f a}
deriving Show
instance Functor f => Functor (FlipAp f) where
fmap f (FlipAp x) = FlipAp (fmap f x)
instance Applicative f => Applicative (FlipAp f) where
pure = FlipAp . pure
(FlipAp f) <*> (FlipAp xs) = FlipAp ((flip ($) <$> xs) <*> f)
instance Alternative f => Alternative (FlipAp f) where
empty = FlipAp empty
(FlipAp a) <|> (FlipAp b) = FlipAp (a <|> b)
以及左分配和右分配的一些规律，以及一些例子
leftDist :: Alternative f => f (x -> y) -> f (x -> y) -> f x -> Example (f y)
leftDist a b c = [(a <|> b) <*> c, (a <*> c) <|> (b <*> c)]
rightDist :: Alternative f => f (x -> y) -> f x -> f x -> Example (f y)
rightDist a b c = [a <*> (b <|> c), (a <*> b) <|> (a <*> c)]
type Example a = [a]
ldExample1 :: Alternative f => Example (f Int)
ldExample1 = leftDist (pure (+1)) (pure (*10)) (pure 2 <|> pure 3)
rdExample1 :: Alternative f => Example (f Int)
rdExample1 = rightDist (pure (+1) <|> pure (*10)) (pure 2) (pure 3)
我们可以演示列表、FlipAp 列表和 runAlt.
列表是左分配的，但 FlipAp 列表不是
ldExample1 :: Example [Int]
ldExample1 :: Example (FlipAp [] Int)
[[3,4,20,30],[3,4,20,30]]
[FlipAp {unFlipAp = [3,20,4,30]},FlipAp {unFlipAp = [3,4,20,30]}]
列表不是右分配的，但 FlipAp 列表是
rdExample1 :: Example [Int]
rdExample1 :: Example (FlipAp [] Int)
[[3,4,20,30],[3,20,4,30]]
[FlipAp {unFlipAp = [3,20,4,30]},FlipAp {unFlipAp = [3,20,4,30]}]
Alt 总是左分配的
map (runAlt id) ldExample1 :: Example [Int]
map (runAlt id) ldExample1 :: Example (FlipAp [] Int)
[[3,4,20,30],[3,4,20,30]]
[FlipAp {unFlipAp = [3,4,20,30]},FlipAp {unFlipAp = [3,4,20,30]}]
Alt 永远不是右分配的
map (runAlt id) rdExample1 :: Example [Int]
map (runAlt id) rdExample1 :: Example (FlipAp [] Int)
[[3,4,20,30],[3,20,4,30]]
[FlipAp {unFlipAp = [3,4,20,30]},FlipAp {unFlipAp = [3,20,4,30]}]
我们可以根据 FlipAp 和 Alt.
runFlipAlt :: forall f g a. Alternative g => (forall x. f x -> g x) -> FlipAp (Alt f) a -> g a
runFlipAlt nt = runAlt nt . unFlipAp
FlipAp Alt 永远不会左分配。
map (runFlipAlt id) ldExample1 :: Example [Int]
map (runFlipAlt id) ldExample1 :: Example (FlipAp [] Int)
[[3,20,4,30],[3,4,20,30]]
[FlipAp {unFlipAp = [3,20,4,30]},FlipAp {unFlipAp = [3,4,20,30]}]
FlipAp Alt 总是右分配的
map (runFlipAlt id) rdExample1 :: Example [Int]
map (runFlipAlt id) rdExample1 :: Example (FlipAp [] Int)
[[3,20,4,30],[3,20,4,30]]
[FlipAp {unFlipAp = [3,20,4,30]},FlipAp {unFlipAp = [3,20,4,30]}]
到目前为止，我还没有告诉你任何你没有通过说 liftAlt : f -> Alt f 是 Alternative 同态，但仅针对 左分配的暗示 替代实例。但是我已经向您展示了一个非左分配的自由替代方案（它通常是右分配的）。
结构上有效的免费 Alternative
这部分回答了您的大部分问题，是否存在 结构上 有效的免费 Alternative 不是左分配的？是的。
这不是一个有效的实施；它的目的是证明它的存在，并且可以直接获得它的某个版本。
为了使结构有效的免费 Alternative 我正在做两件事。第一个是创建一个不能代表任何 Alternative 定律的数据结构；如果它不能代表法律，那么就不能独立于类型 class 构造一个结构来违反它。这与使列表在结构上遵守 Alternative 结合律的技巧相同；没有可以表示左关联 (x <|> y) <|> z 的列表。二是依法经营。列表不能表示左关联律，但 <|> 的实现仍然可能违反它，例如 x <|> y = x ++ reverse y.
无法构造以下结构来表示任何 Alternative 定律。
{-# Language GADTs #-}
{-# Language DataKinds #-}
{-# Language KindSignatures #-}
data Alt :: (* -> *) -> * -> * where
Alt :: Alt' empty pure plus f a -> Alt f a
-- empty pure plus
data Alt' :: Bool -> Bool -> Bool -> (* -> *) -> * -> * where
Empty :: Alt' True False False f a
Pure :: a -> Alt' False True False f a
Lift :: f a -> Alt' False False False f a
Plus :: Alt' False pure1 False f a -> Alt' False pure2 plus2 f a -> Alt' False False True f a
-- Empty can't be to the left or right of Plus
-- empty <|> x = x
-- x <|> empty = x
-- Plus can't be to the left of Plus
-- (x <|> y) <|> z = x <|> (y <|> z)
Ap :: Alt' False False plus1 f (a -> b) -> Alt' empty False plus2 f a -> Alt' False False False f b
-- Empty can't be to the left of `Ap`
-- empty <*> f = empty
-- Pure can't be to the left or right of `Ap`
-- pure id <*> v = v
-- pure (.) <*> u <*> v <*> w = u <*> (v <*> w)
-- pure f <*> pure x = pure (f x)
-- u <*> pure y = pure ($ y) <*> u
这是一个Functor
instance Functor f => Functor (Alt' empty pure plus f) where
fmap _ Empty = Empty
fmap f (Pure a) = Pure (f a)
fmap f (Plus a as) = Plus (fmap f a) (fmap f as)
fmap f (Lift a) = Lift (fmap f a)
fmap f (Ap g a) = Ap (fmap (f .) g) a
instance Functor f => Functor (Alt f) where
fmap f (Alt a) = Alt (fmap f a)
它是 Applicative。因为结构不能代表规律，所以当我们遇到一个包含无法避免的表达式之一的术语时，我们不得不将其转换为其他内容。法律告诉我们该怎么做。
instance Functor f => Applicative (Alt f) where
pure a = Alt (Pure a)
Alt Empty <*> _ = Alt Empty -- empty <*> f = empty
Alt (Pure f) <*> (Alt x) = Alt (fmap f x) -- pure f <*> x = fmap f x (free theorem)
Alt u <*> (Alt (Pure y)) = Alt (fmap ($ y) u) -- u <*> pure y = pure ($ y) <*> u
Alt f@(Lift _) <*> Alt x@Empty = Alt (Ap f x)
Alt f@(Lift _) <*> Alt x@(Lift _) = Alt (Ap f x)
Alt f@(Lift _) <*> Alt x@(Plus _ _) = Alt (Ap f x)
Alt f@(Lift _) <*> Alt x@(Ap _ _) = Alt (Ap f x)
Alt f@(Plus _ _) <*> Alt x@Empty = Alt (Ap f x)
Alt f@(Plus _ _) <*> Alt x@(Lift _) = Alt (Ap f x)
Alt f@(Plus _ _) <*> Alt x@(Plus _ _) = Alt (Ap f x)
Alt f@(Plus _ _) <*> Alt x@(Ap _ _) = Alt (Ap f x)
Alt f@(Ap _ _) <*> Alt x@Empty = Alt (Ap f x)
Alt f@(Ap _ _) <*> Alt x@(Lift _) = Alt (Ap f x)
Alt f@(Ap _ _) <*> Alt x@(Plus _ _) = Alt (Ap f x)
Alt f@(Ap _ _) <*> Alt x@(Ap _ _) = Alt (Ap f x)
所有这些 Ap 都可以被一对视图模式覆盖，但这并没有使它变得更简单。
它也是一个Alternative。为此，我们将使用一个视图模式将案例分为空案例和非空案例，并使用一个额外的类型来存储它们非空的证明
{-# Language ViewPatterns #-}
import Control.Applicative
data AltEmpty :: (* -> *) -> * -> * where
Empty_ :: Alt' True False False f a -> AltEmpty f a
NonEmpty_ :: AltNE f a -> AltEmpty f a
data AltNE :: (* -> *) -> * -> * where
AltNE :: Alt' False pure plus f a -> AltNE f a
empty_ :: Alt' e1 p1 p2 f a -> AltEmpty f a
empty_ x@Empty = Empty_ x
empty_ x@(Pure _) = NonEmpty_ (AltNE x)
empty_ x@(Lift _) = NonEmpty_ (AltNE x)
empty_ x@(Plus _ _) = NonEmpty_ (AltNE x)
empty_ x@(Ap _ _) = NonEmpty_ (AltNE x)
instance Functor f => Alternative (Alt f) where
empty = Alt Empty
Alt Empty <|> x = x -- empty <|> x = x
x <|> Alt Empty = x -- x <|> empty = x
Alt (empty_ -> NonEmpty_ a) <|> Alt (empty_ -> NonEmpty_ b) = case a <> b of AltNE c -> Alt c
where
(<>) :: AltNE f a -> AltNE f a -> AltNE f a
AltNE (Plus x y) <> AltNE z = AltNE x <> (AltNE y <> AltNE z) -- (x <|> y) <|> x = x <|> (y <|> z)
AltNE a@(Pure _) <> AltNE b = AltNE (Plus a b)
AltNE a@(Lift _) <> AltNE b = AltNE (Plus a b)
AltNE a@(Ap _ _) <> AltNE b = AltNE (Plus a b)
liftAlt 和 runAlt
{-# Language RankNTypes #-}
{-# Language ScopedTypeVariables #-}
liftAlt :: f a -> Alt f a
liftAlt = Alt . Lift
runAlt' :: forall f g x empty pure plus a. Alternative g => (forall x. f x -> g x) -> Alt' empty pure plus f a -> g a
runAlt' u = go
where
go :: forall empty pure plus a. Alt' empty pure plus f a -> g a
go Empty = empty
go (Pure a) = pure a
go (Lift a) = u a
go (Plus x y) = go x <|> go y
go (Ap f x) = go f <*> go x
runAlt :: Alternative g => (forall x. f x -> g x) -> Alt f a -> g a
runAlt u (Alt x) = runAlt' u x
这个新的 Alt f 不免费提供左分发或右分发，因此 runAlt id :: Alt f a -> g a 保留了 g 的分发方式。
列表仍然是左分配的，但 FlipAp 列表不是。
map (runAlt id) ldExample1 :: Example [Int]
map (runAlt id) ldExample1 :: Example (FlipAp [] Int)
[[3,4,20,30],[3,4,20,30]]
[FlipAp {unFlipAp = [3,20,4,30]},FlipAp {unFlipAp = [3,4,20,30]}]
列表不是右分配的，但 FlipAp 列表仍然是
map (runAlt id) rdExample1 :: Example [Int]
map (runAlt id) rdExample1 :: Example (FlipAp [] Int)
[[3,4,20,30],[3,20,4,30]]
[FlipAp {unFlipAp = [3,20,4,30]},FlipAp {unFlipAp = [3,20,4,30]}]
Source code 本节
结构有效的 left-catch free Alternative
为了控制我们想要的定律，我们可以将它们添加到我们之前制作的结构自由的替代方案中。
要添加 left-catch，我们将修改结构，使其无法表示。左边是
（纯 a）<|> x = 纯 a
为了不让 Alt' 代表它，我们将从 Plus 左侧允许的内容中排除 pure。
-- empty pure plus
data Alt' :: Bool -> Bool -> Bool -> (* -> *) -> * -> * where
Empty :: Alt' True False False f a
Pure :: a -> Alt' False True False f a
Lift :: f a -> Alt' False False False f a
Plus :: Alt' False False False f a -> Alt' False pure2 plus2 f a -> Alt' False False True f a
-- Empty can't be to the left or right of Plus
-- empty <|> x = x
-- x <|> empty = x
-- Plus can't be to the left of Plus
-- (x <|> y) <|> z = x <|> (y <|> z)
-- Pure can't be to the left of Plus
-- (pure a) <|> x = pure a
...
这会导致在 Alternative Alt
Couldn't match type ‘'True’ with ‘'False’
Expected type: Alt' 'False 'False 'False f a1
Actual type: Alt' 'False pure2 plus2 f a1
In the first argument of ‘Plus’, namely ‘a’
In the first argument of ‘AltNE’, namely ‘(Plus a b)
我们可以通过诉诸我们的新法律来解决这个问题，(pure a) <|> x = pure a
instance Functor f => Alternative (Alt f) where
empty = Alt Empty
Alt Empty <|> x = x -- empty <|> x = x
x <|> Alt Empty = x -- x <|> empty = x
Alt (empty_ -> NonEmpty_ a) <|> Alt (empty_ -> NonEmpty_ b) = case a <> b of AltNE c -> Alt c
where
(<>) :: AltNE f a -> AltNE f a -> AltNE f a
AltNE a@(Pure _) <> _ = AltNE a -- (pure a) <|> x = pure a
AltNE (Plus x y) <> AltNE z = AltNE x <> (AltNE y <> AltNE z) -- (x <|> y) <|> x = x <|> (y <|> z)
AltNE a@(Lift _) <> AltNE b = AltNE (Plus a b)
AltNE a@(Ap _ _) <> AltNE b = AltNE (Plus a b)