Поливариадные функции с полиморфным значением результата

Question

Я пытаюсь реализовать Паскаль-стиль write процедура в Haskell как поливариадная функция. Вот упрощенная версия с мономорфным типом результата (IO в этом случае), который работает нормально:

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Main where

import Control.Monad.IO.Class
import Control.Monad.Trans.Reader
import System.IO


class WriteParams a where
    writeParams :: IO () -> a

instance (a ~ ()) => WriteParams (IO a) where
    writeParams = id

instance (Show a, WriteParams r) => WriteParams (a -> r) where
    writeParams m a = writeParams (m >> putStr (show a ++ " "))

write :: WriteParams params => params
write = writeParams (return ())

test :: IO ()
test = do
    write 123
    write ('a', 'z') True

Однако при изменении типа результата на полиморфный тип использовать эту функцию в разных монадах, которые имеют MonadIO Например, я сталкиваюсь с перекрывающимися или неразрешимыми случаями. В частности, это a ~ () трюк из предыдущей версии больше не работает. Лучший подход заключается в следующем, который требует много аннотаций типов, хотя:

class WriteParams' m a where
    writeParams' :: m () -> a

instance (MonadIO m, m ~ m') => WriteParams' m (m' ()) where
    writeParams' m = m

instance (MonadIO m, Show a, WriteParams' m r) => WriteParams' m (a -> r) where
    writeParams' m a = writeParams' (m >> liftIO (putStr $ show a ++ " "))

write' :: forall m params . (MonadIO m, WriteParams' m params) => params
write' = writeParams' (return () :: m ())

test' :: IO ()
test' = do
    write' 123 () :: IO ()
    flip runReaderT () $ do
        write' 45 ('a', 'z') :: ReaderT () IO ()
        write' True

Есть ли способ заставить этот пример работать без необходимости добавлять аннотации типов здесь и там и при этом сохранять тип результата полиморфным?

Answer 1

Два экземпляра перекрываются, потому что их индексы объединяются: m' () ~ (a -> r) с m' ~ (->) a а также () ~ r,

Чтобы выбрать первый экземпляр всякий раз, когда m' это не тип функции, вы можете добавить OVERLAPPING Прагма. ( Подробнее об этом читайте в руководстве пользователя GHC)

-- We must put the equality (a ~ ()) to the left to make this
-- strictly less specific than (a -> r)
instance (MonadIO m, a ~ ()) => WriteParams (m a) where
    writeParams = liftIO 

instance {-# OVERLAPPING #-} (Show a, WriteParams r) => WriteParams (a -> r) where
    writeParams m a = writeParams (m >> putStr (show a ++ " "))

---

Однако перекрывающийся экземпляр делает его неудобным для использования write в контексте, где монада является параметром m (попробуйте обобщить подпись test).

Существует способ избежать перекрывающихся экземпляров с помощью семейств закрытых типов, чтобы определить логическое значение уровня типа, которое истинно тогда и только тогда, когда данный тип является типом функции, так что экземпляры могут совпадать с ним. Увидеть ниже.

Возможно, это выглядит просто как больше кода и больше сложности, но, в дополнение к дополнительной выразительности (мы можем иметь обобщенный test с MonadIO ограничение), я думаю, что этот стиль делает логику экземпляров более ясной в конце, изолируя сопоставление с образцом на типах.

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}

module Main where

import Control.Monad.IO.Class
import Control.Monad.Trans.Reader
import System.IO


class WriteParams a where
    writeParams :: IO () -> a

instance WriteParamsIf a (IsFun a) => WriteParams a where
    writeParams = writeParamsIf

type family IsFun a :: Bool where
  IsFun (m c) = IsFun1 m
  IsFun a = 'False

type family IsFun1 (f :: * -> *) :: Bool where
  IsFun1 ((->) b) = 'True
  IsFun1 f = 'False

class (isFun ~ IsFun a) => WriteParamsIf a isFun where
  writeParamsIf :: IO () -> a

instance (Show a, WriteParams r) => WriteParamsIf (a -> r) 'True where
  writeParamsIf m a = writeParams (m >> putStr (show a ++ " "))

instance ('False ~ IsFun (m a), MonadIO m, a ~ ()) => WriteParamsIf (m a) 'False where
  writeParamsIf = liftIO

write :: WriteParams params => params
write = writeParams (return ())

test :: (MonadIO m, IsFun1 m ~ 'False) => m ()
test = do
    write 123
    write ('a', 'z') True

main = test  -- for ghc to compile it

---

Несколько слов о UndecidableInstances

Неразрешимые экземпляры - это ортогональная особенность перекрывающихся экземпляров, и на самом деле я думаю, что они гораздо менее противоречивы. В то время как плохо используя OVERLAPPING может привести к несогласованности (ограничения решаются по-разному в разных контекстах), плохо используя UndecidableInstances в худшем случае может посылать компилятор в цикле (на практике GHC завершается с сообщением об ошибке, как только достигается некоторый порог), что по-прежнему плохо, но когда ему удается разрешить экземпляры, все равно гарантируется, что решение является уникальным.

UndecidableInstances снимает ограничения, которые имели смысл давным-давно, но теперь слишком ограничены, чтобы работать с современными расширениями классов типов.

На практике наиболее распространенные классы типов и экземпляры, определенные с UndecidableInstances, в том числе выше, все еще гарантируют, что их решение будет прекращено. На самом деле, существует активное предложение для новой проверки завершения экземпляра. (Я пока не знаю, обрабатывает ли он этот случай здесь.)

Answer 2

Здесь я уточняю свой комментарий в ответ. Мы сохраним идею вашего исходного класса и даже существующих экземпляров, добавляя только экземпляры. Просто добавьте один экземпляр для каждого существующего MonadIO пример; Я сделаю только один, чтобы проиллюстрировать шаблон.

instance (MonadIO m, a ~ ()) => WriteParams (ReaderT r m a) where
    writeParams = liftIO

Все отлично работает

main = do
    write 45
    flip runReaderT () $ do
        write 45 ('a', 'z')
        write "hi"

Это печатает 45 45 ('a','z') "hi" когда выполнено.

Если вы хотите уменьшить writeParams = liftIO немного, вы можете включить DefaultSignatures и добавить:

class WriteParams a where
    writeParams :: IO () -> a
    default writeParams :: (MonadIO m, a ~ m ()) => IO () -> a
    writeParams = liftIO

Тогда IO а также ReaderT случаи просто:

instance a ~ () => WriteParams (IO a)
instance (MonadIO m, a ~ ()) => WriteParams (ReaderT r m a)