Haskell 递归类型类

Question

我想创建一个基于元组的递归实例类型。 我正在寻找的是与此类似的东西：

class Provider a b where
  getInstance :: a -> b

instance Provider a b => Provider (x, a) b where
  getInstance (x, a) = getInstance a

instance Provider (b, x) b where
  getInstance (b, _) = b

tryFunc1 :: Int
tryFunc1 =
  let provider = ("test", (10, ())) :: (String, (Int, ()))
  in getInstance provider

tryFunc2 :: String
tryFunc2 =
  let provider = ("test", (10, ())) :: (String, (Int, ()))
  in getInstance provider

不幸的是，haskell 无法解决该实例。 任何原因？

Answer 1

解决方案是停止使用已弃用的OverlappingInstances编译指示，并开始使用每个实例的OVERLAPPING和OVERLAPPABLE编译指示。 仅此更改：

instance {-# OVERLAPPABLE #-} Provider a b => Provider (x, a) b where
  getInstance (x, a) = getInstance a

instance {-# OVERLAPPING #-} Provider (b, x) b where
  getInstance (b, _) = b

我得到tryFunc1是10和tryFunc2是"test" 。

---

从技术上讲，您只需要OVERLAPPABLE或OVERLAPPING编译指示，但我相信在这种情况下同时拥有两者是一种很好的做法……另外，我想这是您想要的行为，但请注意，这只是获得第一个您正在寻找的类型（所以getInstance (10, (20, ())) :: Int给我10而不是20 ）

信息的良好来源是门票跟踪功能的创作。

Answer 2

我知道有些人不喜欢UndecidableInstances但这就是我在这种情况下喜欢做的：使用封闭的type family来明确选择是完全确定的。

这个想法是让类型族计算一个布尔标志，明确类型类解析机制应该采用哪个分支。 由于Provider ab (AtHead ab) =>约束，即使它是无害的，也需要UndecidableInstance扩展。

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE UndecidableInstances  #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE ScopedTypeVariables   #-}

module Provider where

import Data.Proxy
import Data.Type.Equality

class Provider a b (f :: Bool) where
  getInstance' :: Proxy f -> a -> b

type family AtHead x y :: Bool where
  AtHead (x, a) y = x == y

instance Provider a b (AtHead a b) => Provider (x, a) b 'False where
  getInstance' _ (x, a) = getInstance' (Proxy :: Proxy (AtHead a b)) a

instance Provider (b, x) b 'True where
  getInstance' _ (b, _) = b

getInstance :: forall a b. Provider a b (AtHead a b) => a -> b
getInstance = getInstance' (Proxy :: Proxy (AtHead a b))

tryFunc1 :: Int
tryFunc1 =
  let provider = ("test", (10, ())) :: (String, (Int, ()))
  in getInstance provider

tryFunc2 :: String
tryFunc2 =
  let provider = ("test", (10, ())) :: (String, (Int, ()))
  in getInstance provider