伟大的免费包中有一个不错的Free Alternative，它将Functor提升为左派分配替代。
即，声称是：
runAlt :: Alternative g => (forall x. f x -> g x) -> Alt f a -> g a
是 Alternative homomorphism ，liftAlt。事实上，它是一个，但只适用于left-distributive备用实例。
当然，实际上，很少有替代实例实际上是左分配的。大多数实际上重要的替代实例（解析器，对于大多数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只是某些替代品的替代同态，但不是全部。这是因为Alt 的结构规范化要在左侧分发的所有操作。
Alt非常棒，因为从结构上来说，Alt f是合法的Applicative和Alternative。没有任何可能的方法来构建Alt f a类型的值使用不遵守法律的Applicative和Alternative函数......类型本身的结构使它成为一个免费的替代品。
就像对于列表一样，您无法使用<>和mempty构建一个不尊重x <> mempty = x，mempty <> x = x和结合性。
我已经编写了一个免费的替代方案，在结构上没有强制执行Applicative和Alternative法律，但 会产生有效的替代和适用同态使用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法律的人感兴趣，并在结构上强制执行。这将是一个单独且有趣的事情，但并非完全必要。）
而且，如果没有办法，为什么不呢？
答案 0 :(得分：5)
Control.Alternative.Free＆＃39; Alt f免费生成左分配Alternative，即使f不是Alternative或{ {1}}是非左派的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。{/ p>
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关联性法则相同;没有可以代表左关联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]}]
列表仍然是
FlipApmap (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]}]
为了控制我们想要的法律，我们可以将它们添加到我们之前制作的结构上免费的替代方案中。
要添加左侧捕获，我们将修改结构，使其无法表示。左抓是
（纯a）＆lt; |＆gt; x =纯粹
要保持Alternative代表它，我们会将Alt'排除在pure左侧允许的范围之外。
Plus这导致-- 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