您可以在 Haskell 類型簽名中編寫參數化類型嗎？

Question

我一直在嘗試編寫一個自定義光學數據結構來概括鏡頭、棱鏡和遍歷。 我的數據結構如下所示：

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

我想寫一個 function 組成兩個光學元件， optic1:: Optic mab和optic2:: Optic nb c以生成包含view:: a -> m (nc)和over:: a -> (c -> c) -> a 。

在我的腦海中，這種組合光學的類型將是Optic (mn) a c ，但這不起作用 - GHC 會抱怨 m 有太多類型 arguments 和 n 太少。

這是我對 compose function 的非編譯實現：

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 會理解第一個類型參數有 kind * -> *並且不會抱怨 arguments 不足。 但我不知道如何將類型組合在一起以創建另一種類型* -> * 。

有什么方法（有或沒有語言擴展）來表達類似的東西：

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

不可能為任何類型的m找到滿足以下條件的 optic Optic mab ：

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

您必須改為對這些類型使用某種編碼。 從Data.Functor.Compose導入的Compose新類型是一種替代方法。 它的定義是：

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

It basically wraps up the type lambda \a ~> m (na) which has no direct Haskell representation into a type lambda \a ~> (Compose mn) a whose direct Haskell representation is simply Compose mn: * -> * .

缺點是它會在您的類型中引入不均勻性——將有“普通”光學元件，如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))))