Question

我一直在尝试编写自定义的Optics数据结构，以概括镜头，棱镜和遍历。我的数据结构如下：

data Optic m a b = Optic { view :: a -> m b
                         , over :: a -> (b -> b) -> a
                         }

我想编写一个包含两个光学元件optic1 :: Optic m a b和optic2 :: Optic n b c的函数，以生成包含view :: a -> m (n c)和over :: a -> (c -> c) -> a的光学元件。

在我的脑海中，这种组成的光学元件的类型为Optic (m n) a c，但这是行不通的-GHC会抱怨m的类型参数太多，而n的类型参数太少。

这是我对compose函数的非编译实现：

compose :: Optic m a b -> Optic n b c -> (m b -> (b -> n c) -> m (n c)) -> Optic (m n) a c
compose optic1 optic2 glue = Optic { view = viewCompose (view optic1) (view optic2) glue
                                   , over = overCompose (over optic1) (over optic2)
                                   }

viewCompose :: (a -> m b) -> (b -> n c) -> (m b -> (b -> n c) -> m (n c)) -> a -> m (n c)
viewCompose view1 view2 glue x = glue (view1 x) view2

overCompose :: (a -> (b -> b) -> a) -> (b -> (c -> c) -> b) -> a -> (c -> c) -> a
overCompose over1 over2 x f = over1 x (\y -> over2 y f)

GHC错误消息是：

optic.hs:7:83: error:
    • Expecting one fewer argument to ‘m n’
      Expected kind ‘* -> *’, but ‘m n’ has kind ‘*’
    • In the first argument of ‘Optic’, namely ‘m n’
      In the type signature:
        compose :: Optic m a b
                   -> Optic n b c -> (m b -> (b -> n c) -> m (n c)) -> Optic (m n) a c

optic.hs:7:85: error:
    • Expecting one more argument to ‘n’
      Expected a type, but ‘n’ has kind ‘* -> *’
    • In the first argument of ‘m’, namely ‘n’
      In the first argument of ‘Optic’, namely ‘m n’
      In the type signature:
        compose :: Optic m a b
                   -> Optic n b c -> (m b -> (b -> n c) -> m (n c)) -> Optic (m n) a c

如果我创建类型为Optic Maybe Int Int的光学元件，GHC会理解第一个类型参数的类型为* -> *，并且不会抱怨参数不足。但是我不知道如何将类型组合在一起以创建另一种类型的* -> *。

是否有任何方式（带有或不带有语言扩展名）来表达以下内容：

Optic (forall t. m (n t)) a c

Answer 1

根据@chi的评论，Haskell不直接支持类型级lambda。因此，尽管存在类型为Maybe的类型为* -> *的类型，它直接表示类型级别的lambda \a ~> Maybe a，但是没有直接表示类型级别的lambda \a ~> Maybe (Maybe a)的对应类型

这意味着给定您为字段view定义的类型：

view :: a -> m b

不可能找到满足以下条件的任何类型的Optic m a b光学元件m：

view :: a -> Maybe (Maybe b)  -- impossible

您必须为这些类型使用 some 类型的编码。从Compose导入的Data.Functor.Compose新类型是一种选择。它的定义是：

newtype Compose m n a = Compose (m (n a))

它基本上将没有直接Haskell表示形式的lambda \a ~> m (n a)类型包装为直接具有Haskell表示形式\a ~> (Compose m n) a的lambda类型Compose m n : * -> *。

缺点是它将在您的类型中引入不均匀性-将有Optic Maybe Int Int之类的“普通”光学元件，然后是Optic (Compose Maybe Maybe) Int Int之类的“组合”光学元件。在大多数情况下，您可以使用coerce来解决这种不便。

使用compose新类型对Compose进行适当的定义应类似于：

type Glue m n b c = m b -> (b -> n c) -> m (n c)

compose :: Optic m a b -> Optic n b c -> Glue m n b c -> Optic (Compose m n) a c
compose optic1 optic2 glue
  = Optic { view = viewCompose (view optic1) (view optic2) glue
          , over = overCompose (over optic1) (over optic2)
          }
  where
    viewCompose view1 view2 glue x = Compose $ glue (view1 x) view2
    overCompose over1 over2 x f = over1 x (\y -> over2 y f)

和典型的基于Maybe的光学元件：

_Left :: Optic Maybe (Either a b) a
_Left = Optic v o
  where v (Left x) = Just x
        v (Right _) = Nothing
        o (Left x) f = Left (f x)
        o (Right y) _ = Right y

一个合成的光学元件可能看起来像：

_Left2 = compose _Left _Left (flip fmap)

直接使用它会引入一个Compose包装器：

> view _Left2 (Left (Left "xxx"))
Compose (Just (Just "xxx"))

但是您可以coerce的结果来避免显式展开，如果有多个嵌套的Compose层，则特别有用：

λ> import Data.Coerce
λ> _Left4 = compose _Left2 _Left2 (flip fmap)
λ> :t _Left4
_Left4
  :: Optic
       (Compose (Compose Maybe Maybe) (Compose Maybe Maybe))
       (Either (Either (Either (Either c b4) b5) b6) b7)
       c
λ> view _Left4 (Left (Left (Left (Left True))))
Compose (Compose (Just (Just (Compose (Just (Just True))))))
λ> coerce $ view _Left4 (Left (Left (Left (Left True)))) :: Maybe (Maybe (Maybe (Maybe Bool)))
Just (Just (Just (Just True)))

完整代码：

import Data.Coerce
import Data.Functor.Compose

data Optic m a b = Optic { view :: a -> m b
                         , over :: a -> (b -> b) -> a
                         }

type Glue m n b c = m b -> (b -> n c) -> m (n c)

compose :: Optic m a b -> Optic n b c -> Glue m n b c -> Optic (Compose m n) a c
compose optic1 optic2 glue
  = Optic { view = viewCompose (view optic1) (view optic2) glue
          , over = overCompose (over optic1) (over optic2)
          }
  where
    viewCompose view1 view2 glue x = Compose $ glue (view1 x) view2
    overCompose over1 over2 x f = over1 x (\y -> over2 y f)

_Left :: Optic Maybe (Either a b) a
_Left = Optic v o
  where v (Left x) = Just x
        v (Right _) = Nothing
        o (Left x) f = Left (f x)
        o (Right y) _ = Right y

_Left2 :: Optic (Compose Maybe Maybe) (Either (Either c b1) b2) c
_Left2 = compose _Left _Left (flip fmap)

_Left4 :: Optic (Compose (Compose Maybe Maybe) (Compose Maybe Maybe)) (Either (Either (Either (Either c b1) b2) b3) b4) c
_Left4 = compose _Left2 _Left2 (flip fmap)

main = do
  print $ view _Left4 (Left (Left (Left (Left True))))
  print $ (coerce $ view _Left4 (Left (Left (Left (Left True)))) :: Maybe (Maybe (Maybe (Maybe Bool))))

您可以在Haskell类型签名中组成参数化类型吗？

1 个答案: