为什么这个函数隐含了一个单线约束，即使只列出了SemiGroup作为约束？

Question

在下面的堆栈脚本中，我不能将我的strangeHeadMay函数应用于NonEmpty列表，但它在常规列表上工作得很好。

#!/usr/bin/env stack
{- stack script --nix --resolver lts-13.6 -}

{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# OPTIONS_GHC -Wno-partial-type-signatures #-} -- hide some scary types

import           Control.Arrow                    ((&&&))
import           Control.Monad                    (join)
import           Data.Foldable                    (toList)
import           Data.Function                    ((&))
import           Data.Functor                     ((<&>))
import           Data.List.NonEmpty               (NonEmpty(..))
import qualified Data.List.NonEmpty               as LNE
import           Data.Maybe                       (catMaybes)
import           Data.Tuple.Sequence              (sequenceT)


strangeHeadMay :: forall a t. (Semigroup (t a), _) => t a -> Maybe a
strangeHeadMay xs =
  let xsWrapped :: t (t a) = pure <$> xs -- <- Contrived example
      -- This is the functionality I actually need:
      xsMay :: Maybe (t a) = xsWrapped & (headMay &&& tailMay) & sequenceT
         <&> (\(h, t) -> foldr mappend h t)
   in do
    xs' <- xsMay
    xs' & toList & headMay

main :: IO ()
main = do
  let nexs :: NonEmpty (Maybe Double) = Nothing :| [Just (2.0)]
  let xs = LNE.toList nexs
  let xsHead = strangeHeadMay xs
  let nexsHead = strangeHeadMay nexs
  pure ()


headMay :: Foldable f => f a -> Maybe a
headMay = foldr (const . Just) Nothing

tailMay :: Foldable f => f a -> Maybe (f a)
tailMay = foldr (seq . Just) Nothing

错误是

/home/brandon/workspace/foldNEmaybes.hs:34:18: error:
    • No instance for (Monoid (NonEmpty (Maybe Double)))
        arising from a use of ‘strangeHeadMay’
    • In the expression: strangeHeadMay nexs
      In an equation for ‘nexsHead’: nexsHead = strangeHeadMay nexs
      In the expression:
        do let nexs :: NonEmpty (Maybe Double) = Nothing :| ...
           let xs = LNE.toList nexs
           let xsHead = strangeHeadMay xs
           let nexsHead = strangeHeadMay nexs
           ....
   |
34 |   let nexsHead = strangeHeadMay nexs
   |                  ^^^^^^^^^^^^^^^^^^^

此外，我必须承认我不完全清楚为什么我需要部分类型的签名，但是将(Semigroup (t a), _)更改为(Semigroup (t a))会导致不好的事情发生。

Answer 1

尽管<>和mappend做同样的事情，但只有在你有一个Monoid约束的情况下，你才能使用后者，所以在类型签名中添加了一个到你的_。要修复此问题，请使用foldr (<>)而不是foldr mappend。

并且您不需要类型签名中的漏洞。您可以写出其中包含的内容，但它仍然可以工作：Applicative t和Foldable t。