Question

我定义了一个简单的代数（具体）数据类型，MyType：

data MyTpe = MyBool Bool | MyInt Int

...而我正试图找到一种方法来转换＆＃34;任意函数（a-> b），其中a和b是Bool或Int，进入相关的（MyType-＆gt; MyType）函数。

这样做，它将（a-> b）转换为 Maybe （MyType-＆gt; MyType）（参见下面的[1]）：

import Data.Typeable

data MyTpe = MyBool Bool | MyInt Int deriving Show

liftMyType :: (Typeable a, Typeable b) => (a -> b) -> Maybe (MyTpe -> MyTpe)
liftMyType f =  case castIntInt f of
                  Just g    -> Just $ liftIntInt g
                  Nothing   -> 
                    case castIntBool f of
                     Just g    -> Just $ liftIntBool g
                     Nothing   -> 
                       case castBoolInt f of
                       Just g    -> Just $ liftBoolInt g
                       Nothing   -> 
                         case castBoolBool f of
                         Just g    -> Just $ liftBoolBool g
                         Nothing   -> Nothing

castIntInt :: (Typeable a, Typeable b) => (a -> b) -> Maybe (Int -> Int)
castIntInt f =  cast f :: Maybe (Int -> Int)

castIntBool :: (Typeable a, Typeable b) => (a -> b) -> Maybe (Int -> Bool)
castIntBool f =  cast f :: Maybe (Int -> Bool)

castBoolInt :: (Typeable a, Typeable b) => (a -> b) -> Maybe (Bool -> Int)
castBoolInt f =  cast f :: Maybe (Bool -> Int)

castBoolBool :: (Typeable a, Typeable b) => (a -> b) -> Maybe (Bool -> Bool)
castBoolBool f =  cast f :: Maybe (Bool -> Bool)

liftIntInt :: (Int -> Int) -> (MyTpe -> MyTpe)
liftIntInt f (MyInt x) = MyInt (f x)

liftIntBool :: (Int -> Bool) -> (MyTpe -> MyTpe)
liftIntBool f (MyInt x) = MyBool (f x)

liftBoolInt :: (Bool -> Int) -> (MyTpe -> MyTpe)
liftBoolInt f (MyBool x) = MyInt (f x)

liftBoolBool :: (Bool -> Bool) -> (MyTpe -> MyTpe)
liftBoolBool f (MyBool x) = MyBool (f x)

然而，这非常难看并且不能很好地扩展：如果我想以这种方式扩展MyType怎么办？

data MyTpe = MyBool Bool | MyInt Int | MyString String

...或者如果我还想将a1，a2和b（其中a1，a2和b）转换为相关的（MyType-＆gt; MyType-＆gt; MyType），其中a1，a2和b是Bool或Int ）功能？...

我的问题：是否有一种简单，更优雅，更像Haskell的方式来处理这个问题？

[1]：liftIntInt函数等未在所有 MyType元素上定义（例如，没有为（MyBool x）元素定义liftIntInt）。代码只是一个简化的案例，在现实生活中我处理得恰到好处。

Answer 1

您正在寻找类型

goal :: (a -> b) -> (MyType -> MyType)

某些＆＃34;合适的＆＃34; a和b的选择。这些＆＃34;合适的＆＃34;选择是静态已知的，因为MyType的定义是静态已知的。

您正在寻找的是类型类。特别是，我们需要MultiParamTypeClasses pragma

{-# LANGUAGE MultiParamTypeClasses #-}

class MapMyType a b where
  liftMyType :: (a -> b) -> (MyType -> MyType)

所以现在liftMyType的完整类型是

liftMyType :: MapMyType a b => (a -> b) -> (MyType -> MyType)

我们可以使用类型类机制来存储liftMyType的各种实例化，只有a和b可以解析为liftMyType的类型有人居住。

instance MapMyType Int  Int  where liftMyType f (MyInt x)  = MyInt  (f x)
instance MapMyType Int  Bool where liftMyType f (MyInt x)  = MyBool (f x)
instance MapMyType Bool Int  where liftMyType f (MyBool x) = MyInt  (f x)
instance MapMyType Bool Bool where liftMyType f (MyBool x) = MyBool (f x)

-- (as a side note, this is a dangerous function to instantiate since it
--  has incomplete pattern matching on its `MyType` typed argument)

现在，值得一提的是，MultiParamTypeClasses经常在这样使用时会损害推理。特别是，如果我们要查看代码片段liftMyType a b，我们必须能够自己推断出a和b的类型（例如，在没有帮助的情况下）从liftMyType的调用传递提示＆＃34; down＆＃34;否则我们将得到一个模糊的实例编译失败。实际上，如果 <{em> a或b无法直接推断，我们会在编译失败的情况下导致编译失败。

在许多情况下，您可能希望使用FunctionalDependencies来控制此问题，从而允许对＆＃34; flow＆＃34;进行更多推断。在两个参数之间，使歧义错误不太常见。

但在这种情况下，我认为它是代码味道。虽然上面的代码有效（注释注释）但它有一种脆弱的解决方案。

Answer 2

回答你的问题：＆＃34;是否有一种简单，更优雅，更像Haskell的方式来处理这个问题？＆＃34;没有优雅或类似Haskell的方法来解决这个问题。 Haskell不是一种动态类型语言，虽然设计师设法伪造动态类型，但你真的应该避免使用它。这个问题让你觉得你试图通过动态输入来修复糟糕的设计。

但是，您可以使用generics编写代码的简化版本，该版本也是可扩展的：

{-# LANGUAGE DeriveGeneric #-}

import GHC.Generics
import Data.Typeable 

liftFun :: forall a b c . (Generic c, GLiftFun (Rep c), Typeable a, Typeable b) 
        => (a -> b) -> c -> Maybe c
liftFun f x = do 
  a <- gGet (from x)
  b <- gPut (f a)
  return (to b) 

class GLiftFun f where 
  gPut :: Typeable a => a -> Maybe (f q)
  gGet :: Typeable a => f q -> Maybe a 

instance Typeable a => GLiftFun (K1 i a) where 
  gPut = fmap K1 . cast 
  gGet = cast . unK1

instance GLiftFun f => GLiftFun (M1 i c f) where 
  gPut = fmap M1 . gPut
  gGet = gGet . unM1 

instance (GLiftFun f, GLiftFun g) => GLiftFun (f :+: g) where 
  gPut a | Just r <- gPut a = Just (L1 r)
         | Just r <- gPut a = Just (R1 r)
         | otherwise        = Nothing 

  gGet (L1 a) = gGet a 
  gGet (R1 a) = gGet a

liftFun适用于任何类型的简单求和类型，例如Either或您定义的与一系列嵌套Eithers同构的任何类型。它也可能对产品类型有明显的延伸。例如，以下任何一个都可以使用：

data MyType = MyBool Bool | MyInt Int deriving (Show, Generic)

data MyType2 = B2 Bool | I2 Int | S2 String deriving (Show, Generic)

type MyType3 = Either String Int

Answer 3

以下是如何以可扩展的方式实现这一目标：

{-# LANGUAGE DeriveDataTypeable #-}
import Data.Typeable

data MyTpe = MyBool Bool | MyInt Int deriving (Show,Typeable)

d :: (Typeable a, Typeable b) => (a->b) -> Maybe (a -> MyTpe)
d f = case (cast f :: (Typeable a) => Maybe (a->Int)) of
        Just f -> Just $ MyInt . f
        _      -> case (cast f :: (Typeable a) => Maybe (a->Bool)) of
                    Just f -> Just $ MyBool . f
                    _      -> Nothing -- add more constructor matching here

e :: (Typeable a, Typeable b) => a -> Maybe (b->MyTpe) -> Maybe MyTpe
e x = (>>= \f -> fmap ($ x) (cast f :: (Typeable a => Maybe (a->MyTpe))))

liftMyType :: (Typeable a, Typeable b) => (a->b) -> MyTpe -> Maybe MyTpe
liftMyType f (MyInt x) = e x $ d f
liftMyType f (MyBool x) = e x $ d f
-- add more constructor matching here
...
> liftMyType ((+1) :: Int->Int) (MyInt 100)
> Just (MyInt 101)

你甚至可以获得你想要的类型 - 即Maybe (MyTpe->MyTpe) - 你不需要在参数上进行模式匹配，就这样你就不会得到一个总函数MyTpe -> MyTpe，即使它是Just。

liftMyType = fmap h . d where
  h g = case (cast g :: Maybe (Int->MyTpe)) of
          Just g -> (\(MyInt x)) -> g x
          _      -> case (cast g :: Maybe (Bool->MyTpe)) of
            Just g -> (\(MyBool x)) -> g x
            _      -> Nothing -- add more type matching here
...
> fmap ($ MyInt 100) $ liftMyType ((+1) :: Int->Int)
> Just (MyInt 101)

从（a-> b）到（MyType-＆gt; MyType）

3 个答案: