Haskell是否支持闭合多态类型？

Question

鉴于:

newtype PlayerHandle = PlayerHandle Int deriving (Show)
newtype MinionHandle = MinionHandle Int deriving (Show)
newtype WeaponHandle = WeaponHandle Int deriving (Show)

在下面的代码,我想handle是正好三种类型之一:PlayerHandle,MinionHandle,和WeaponHandle.这可以在Haskell中做到吗？

data Effect where
    WithEach :: (??? handle) => [handle] -> (handle -> Effect) -> Effect -- Want `handle' to be under closed set of types.

以下是太乏味了:

data Effect' where
    WithEachPlayer :: [PlayerHandle] -> (PlayerHandle -> Effect) -> Effect
    WithEachMinion :: [MinionHandle] -> (MinionHandle -> Effect) -> Effect
    WithEachWeapon :: [WeaponHandle] -> (WeaponHandle -> Effect) -> Effect

编辑:

ØrjanJohansen建议使用封闭式家庭,这确实让我更接近我想要的东西.我使用它们的问题是我似乎无法编写以下内容:

type family IsHandle h :: Constraint where
    IsHandle (PlayerHandle) = ()
    IsHandle (MinionHandle) = ()
    IsHandle (WeaponHandle) = ()

data Effect where
    WithEach :: (IsHandle handle) => [handle] -> (handle -> Effect) -> Effect

enactEffect :: Effect -> IO ()
enactEffect (WithEach handles cont) = forM_ handles $ \handle -> do
    print handle  -- Eeek! Can't deduce Show, despite all cases being instances of Show.
    enactEffect $ cont handle

在这里GHC抱怨它不能推断出句柄是一个实例Show.由于各种原因Show在WithEach构造函数中移动约束,我对于解决这个问题犹豫不决.这些包括模块化和可扩展性.像封闭数据家族这样的东西会解决这个问题吗(因为我知道类型族映射不是单射的...即使是封闭的问题也是问题吗？)

Answer 1

我认为您可以使用封闭 约束类型系列精确地获得语法:

{-# LANGUAGE TypeFamilies, ConstraintKinds, GADTs #-}

import GHC.Exts (Constraint)

newtype PlayerHandle = PlayerHandle Int
newtype MinionHandle = MinionHandle Int
newtype WeaponHandle = WeaponHandle Int

type family IsHandle h :: Constraint where
    IsHandle (PlayerHandle) = ()
    IsHandle (MinionHandle) = ()
    IsHandle (WeaponHandle) = ()

data Effect where
    WithEach :: (IsHandle handle) => [handle] -> (handle -> Effect) -> Effect

编辑:另一种尝试包括Show:

{-# LANGUAGE TypeFamilies, ConstraintKinds, GADTs,
             UndecidableInstances #-}

import GHC.Exts (Constraint)
import Control.Monad (forM_)

newtype PlayerHandle = PlayerHandle Int
newtype MinionHandle = MinionHandle Int
newtype WeaponHandle = WeaponHandle Int

type family IsHandle' h :: Constraint where
    IsHandle' (PlayerHandle) = ()
    IsHandle' (MinionHandle) = ()
    IsHandle' (WeaponHandle) = ()

type IsHandle h = (IsHandle' h, Show h)

data Effect where
    WithEach :: (IsHandle handle) => [handle] -> (handle -> Effect) -> Effect

-- Assume my each (IsHandle a) already is an instance of a class I want to use, such as (Show).
enactEffect :: Effect -> IO ()
enactEffect (WithEach handles cont) = forM_ handles $ \handle -> do
    print handle  -- (*)
    enactEffect $ cont handle

I don't quite see how to avoid having two different classes, types or families and get the API you seem to want without making it possible to add other types in another module. I also don't know of any way for the resulting IsHandle constraint to automatically inherit all the classes the three types have in common, without you listing them somewhere.

But I think depending on your needs/style, there are some more options similar to my last one:

• You could make IsHandle a class with IsHandle' and Show etc. as superclasses.
• You could make IsHandle' a class, in which case the only prevention against adding more types would be not exporting IsHandle'.

One advantage of the last one is that it can seriously cut down the number of extensions needed for this:

{-# LANGUAGE GADTs, ConstraintKinds #-}

class IsHandle' h
instance IsHandle' (PlayerHandle)
instance IsHandle' (MinionHandle)
instance IsHandle' (WeaponHandle)

type IsHandle h = (IsHandle' h, Show h)

Answer 2

这是基于GADT的解决方案:

{-# LANGUAGE GADTs, RankNTypes #-}
{-# OPTIONS -Wall #-}
module GADThandle where

import Control.Monad

newtype PlayerHandle = PlayerHandle Int deriving (Show)
newtype MinionHandle = MinionHandle Int deriving (Show)
newtype WeaponHandle = WeaponHandle Int deriving (Show)

data HandleW a where
   WPlayer :: HandleW PlayerHandle
   WMinion :: HandleW MinionHandle
   WWeapon :: HandleW WeaponHandle

handlewShow :: HandleW a -> (Show a => b) -> b
handlewShow WPlayer x = x
handlewShow WMinion x = x
handlewShow WWeapon x = x

data Effect where
   WithEach :: HandleW handle -> [handle] -> (handle -> Effect) -> Effect 

enactEffect :: Effect -> IO ()
enactEffect (WithEach handlew handles cont) = handlewShow handlew $ 
   forM_ handles $ \handle -> do
      print handle
      enactEffect $ cont handle

这里的想法是使用类型证人HandleW a,证明这a是你的三种类型之一.然后,"引理" handlewShow证明如果HandleW a持有,那么a必须是一个Show类型.

也可以将上面的代码概括为任意类型的类.下面的引理证明,如果你有c T三种类型中的每一种T,并且你知道这种情况HandleW a,那么也c a必须保持.你可以通过选择获得前一个引理c = Show.

handlewC :: (c PlayerHandle, c MinionHandle, c WeaponHandle) => 
   HandleW a -> Proxy c -> (c a => b) -> b
handlewC WPlayer Proxy x = x
handlewC WMinion Proxy x = x
handlewC WWeapon Proxy x = x

enactEffect' :: Effect -> IO ()
enactEffect' (WithEach handlew handles cont) = handlewC handlew (Proxy :: Proxy Show) $ 
   forM_ handles $ \handle -> do
      print handle
      enactEffect' $ cont handle

Answer 3

感谢所有解决方案的人。它们都对各种用例都有帮助。对于我的用例，事实证明，将句柄类型放入单个 GADT 解决了我的问题。

这是我为感兴趣的人得出的解决方案：

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}

data Player
data Minion
data Weapon

data Handle a where
    PlayerHandle :: Int -> Handle Player
    MinionHandle :: Int -> Handle Minion
    WeaponHandle :: Int -> Handle Weapon

data Effect where
    WithEach :: [Handle h] -> (Handle h -> Effect) -> Effect
    PrintSecret :: Handle h -> Effect

-------------------------------------------------------------------------------
-- Pretend the below code is a separate file that imports the above data types
-------------------------------------------------------------------------------

class ObtainSecret a where
    obtainSecret :: a -> String

instance ObtainSecret (Handle a) where
    obtainSecret = \case
        PlayerHandle n -> "Player" ++ show n
        MinionHandle n -> "Minion" ++ show n
        WeaponHandle n -> "Weapon" ++ show n

enactEffect :: Effect -> IO ()
enactEffect = \case
    WithEach handles continuation -> mapM_ (enactEffect . continuation) handles
    PrintSecret handle -> putStrLn (obtainSecret handle)

createEffect :: [Handle h] -> Effect
createEffect handles = WithEach handles PrintSecret

main :: IO ()
main = do
    enactEffect $ createEffect $ map PlayerHandle [0..2]
    enactEffect $ createEffect $ map MinionHandle [3..5]
    enactEffect $ createEffect $ map WeaponHandle [6..9]