Question

这是对Type variables in context not fixed?的迭代，包含相关类型。

我得到以下错误消息，但我无法弄清楚为什么没有选择HasRecipeCase False实例 - 所有其他字段（False除外）应该足够通用所以它可以选择那个实例。

script.hs:126:6: error:
    • No instance for (HasRecipeCase
                         'False
                         M4
                         '[Recipe IO M1 '[M2, M3], Recipe IO M2 '[], Recipe IO M3 '[M4],
                           Recipe IO M4 '[]])
        arising from a use of ‘cook’
    • In the expression: cook cookbook1 :: IO M4
      In an equation for ‘c1’: c1 = cook cookbook1 :: IO M4
    |
126 | c1 = cook cookbook1 :: IO M4
    |      ^^^^^^^^^^^^^^

脚本：

#!/usr/bin/env stack
-- stack --resolver lts-11.4 --install-ghc runghc
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE PolyKinds #-}

import Data.Proxy

class HEq (x :: k) (y :: k) (b :: Bool) | x y -> b
instance {-# OVERLAPPING #-} HEq x x True
instance {-# OVERLAPPABLE  #-} False ~ b => HEq x y b

data family HList (l::[*])

data instance HList '[] = HNil
data instance HList (x ': xs) = x `HCons` HList xs

deriving instance Eq (HList '[])
deriving instance (Eq x, Eq (HList xs)) => Eq (HList (x ': xs))

deriving instance Ord (HList '[])
deriving instance (Ord x, Ord (HList xs)) => Ord (HList (x ': xs))

deriving instance Bounded (HList '[])
deriving instance (Bounded x, Bounded (HList xs)) => Bounded (HList (x ': xs))

class HExtend e l where
  type HExtendR e l
  (.*.) :: e -> l -> HExtendR e l

infixr 2 .*.

instance HExtend e (HList l) where
  type HExtendR e (HList l) = HList (e ': l)
  (.*.) = HCons

main = pure ()


newtype Recipe effect target (deps :: [*]) = Recipe { runRecipe :: HList deps -> effect target }

class DefaultRecipe target where
  def :: Recipe target deps effect

type family Foo

class CanCook target (pot :: [*]) where
  type CDeps pot target :: [*]
  cook :: HList pot -> (PotEffect pot) target

instance (HasRecipe target pot, SubSelect pot (CDeps pot target)) => CanCook target pot where
  type CDeps pot target = RDeps pot target
  cook pot =
    let
      deps :: HList deps
      deps = subselect pot
      r :: Recipe (PotEffect pot) target (CDeps pot target)
      r = recipe pot
    in
      runRecipe r $ deps

type family PotEffect (pot :: [*]) :: * -> *
type instance PotEffect (Recipe effect _ _ ': '[]) = effect
type instance PotEffect (Recipe effect _ _ ': Recipe effect _ _ ': '[]) = effect
type instance PotEffect (Recipe effect _ _ ': Recipe effect _ _ ': Recipe effect _ _ ': '[]) = effect
type instance PotEffect (Recipe effect _ _ ': Recipe effect _ _ ': Recipe effect _ _ ': Recipe effect _ _ ': '[]) = effect
type instance PotEffect (Recipe effect _ _ ': Recipe effect _ _ ': Recipe effect _ _ ': Recipe effect _ _ ': Recipe effect _ _ ': '[]) = effect

class HasRecipe target (pot :: [*]) where
  type RDeps pot target :: [*]
  recipe :: HList pot -> Recipe (PotEffect pot) target (RDeps pot target)

class SubSelect (pot :: [*]) (deps :: [*]) where
  subselect :: HList pot -> HList deps

instance SubSelect p d where
  subselect = undefined

class HasRecipeCase (b :: Bool) (target :: *) (pot :: [*]) where
  type RCDeps b target pot :: [*]
  recipeCase :: Proxy b -> Proxy target -> HList pot -> Recipe (PotEffect pot) target (RCDeps b target pot)

instance (PotEffect ((Recipe effect target deps) ': leftoverPot) ~ effect) => HasRecipeCase True target ((Recipe effect target deps) ': leftoverPot) where
  type RCDeps True target ((Recipe effect target deps) ': leftoverPot) = deps
  recipeCase _ _ (HCons head _) = head

instance (HasRecipe target leftoverPot, PotEffect ((Recipe effect target deps) ': leftoverPot) ~ effect, PotEffect leftoverPot ~ effect) =>
  HasRecipeCase False target ((Recipe effect target deps) ': leftoverPot) where
  type RCDeps False target ((Recipe effect target deps) ': leftoverPot) = RDeps leftoverPot target
  recipeCase _ _ (HCons _ tail) = recipe tail

instance (HEq target t bool, HasRecipeCase bool target pot , pot ~ ((Recipe effect t deps) ': leftoverPot)) =>
  HasRecipe target ((Recipe effect t deps) ': leftoverPot) where
  recipe = undefined

newtype M1 = M1 ()
newtype M2 = M2 ()
newtype M3 = M3 ()
newtype M4 = M4 ()

r1 :: Recipe IO M1 '[M2, M3]
r1 = undefined

r2 :: Recipe IO M2 '[]
r2 = undefined

r3 :: Recipe IO M3 '[M4]
r3 = undefined

r4 :: Recipe IO M4 '[]
r4 = undefined

cookbook1 = r1 .*. r2 .*. r3 .*. r4 .*. HNil

cookbook2 = r3 .*. r4 .*. r2 .*. r1 .*. HNil

c1 = cook cookbook1 :: IO M4
-- c2 = cook cookbook2 :: IO M4

Answer 1

嗯，它说没有这样的实例，因为没有这样的实例。您期望匹配的实例主管不匹配。

HasRecipeCase False target ((Recipe effect target deps)      ': leftoverPot)`
HasRecipeCase False M4     ((Recipe IO     M1     '[M2, M3]) ': '[Recipe IO M2 '[], Recipe IO M3 '[M4], Recipe IO M4 '[]]`

那些不匹配，因为实例头要求target在任何地方都匹配相同的类型。但是，您尝试将target的{{1}}用作M1在一个位置，M4用于另一个位置。

为什么没有选择实例？

1 个答案: