LINUX.ORG.RU

Не выводится констреинт при использовании closed type families.

 , ,


0

1

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

{-# LANGUAGE Rank2Types, GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DataKinds, KindSignatures, MultiParamTypeClasses, TypeFamilies, FlexibleInstances, UndecidableInstances #-}
{-# LANGUAGE ScopedTypeVariables, FlexibleContexts #-}

import System.IO
import Control.Applicative
import Control.Monad.Reader
import Control.Monad.Trans
import Control.Exception
import Data.IORef

newtype IORT s m v = IORT{ unIORT:: ReaderT (IORef [HandleR]) m v } 
    deriving (Functor, Applicative, Monad)

newtype SHandle (m :: * -> *) = SHandle Handle	-- data ctor not exported

newtype HandleR = HandleR Handle

class (Monad m1, Monad m2) => MonadRaise m1 m2 where
  lifts :: m1 a -> m2 a

type family TEQ (a :: * -> *) (b :: * -> *) :: Bool where
  TEQ m  m  = True
  TEQ m1 (IORT s m2) = False

data Proxy (b::Bool) = Proxy

class (Monad m1, Monad m2) => MonadRaise' (b::Bool) m1 m2 where
  lifts' :: Proxy b -> m1 a -> m2 a

instance (MonadRaise' (TEQ m1 m2) m1 m2) => MonadRaise m1 m2 where
  lifts = lifts' (Proxy::Proxy (TEQ m1 m2))

instance (Monad m1, Monad m2, m1 ~ m2) => MonadRaise' True m1 m2 where
  lifts' _ = id

instance (Monad m2, m2 ~ (IORT s m2'), MonadRaise m1 m2')
    => MonadRaise' False m1 m2 where
    lifts' _ = IORT . lift . lifts

test_copy fname_in fname_out = do
  hout <- newSHandle fname_out WriteMode
  (do newRgn (do
        till (return True)
             (return "foo" >>= shPutStrLn hout)))

newSHandle :: (m ~ (IORT s' m'), SMonad1IO m) => 
	      FilePath -> IOMode -> m (SHandle m)
newSHandle = undefined

newRgn :: RMonadIO m => (forall s. IORT s m v) -> m v
newRgn = undefined 

till :: forall (m :: * -> *) a. Monad m => m Bool -> m a -> m ()
till condition iteration = loop where
  loop = do b <- condition
            if b then return () else iteration >> loop

shPutStrLn :: (MonadRaise m1 m2, SMonadIO m2) => SHandle m1 -> String -> m2 ()
shPutStrLn = undefined

-- RMonad:
class Monad m => RMonadIO m where lIO   :: IO a -> m a

instance RMonadIO IO where lIO   = id
instance RMonadIO m => RMonadIO (ReaderT r m) where lIO = lift . lIO
instance RMonadIO m => RMonadIO (IORT s m) where lIO = IORT . lIO

-- SMonadIO
class RMonadIO m => SMonadIO m
instance RMonadIO m => SMonadIO (IORT s m)

-- SMonad1IO
class RMonadIO (UnIORT m) => SMonad1IO m
instance RMonadIO m => SMonad1IO (IORT s m)

type family UnIORT (m :: * -> *) :: * -> *
type instance UnIORT (IORT s m) = m

Ошибка:

Minimal.hs:45:32:
    Could not deduce (MonadRaise'
                        (TEQ (IORT s' m') (IORT s (IORT s' m')))
                        (IORT s' m')
                        (IORT s (IORT s' m')))
      arising from a use of ‘shPutStrLn’
    from the context (RMonadIO m')
      bound by the inferred type of
               test_copy :: RMonadIO m' => t -> FilePath -> IORT s' m' ()
      at Minimal.hs:(41,1)-(45,49)
    In the second argument of ‘(>>=)’, namely ‘shPutStrLn hout’
    In the second argument of ‘till’, namely
      ‘(return "foo" >>= shPutStrLn hout)’
    In a stmt of a 'do' block:
      till (return True) (return "foo" >>= shPutStrLn hout)
★★★★★

соотвественно на overlapping instances:

instance Monad m => MonadRaise m m where
    lifts = id

instance (Monad m2, m2 ~ (IORT s m2'), MonadRaise m1 m2') 
    => MonadRaise m1 m2 where
    lifts = IORT . lift . lifts

все будет работать

qnikst ★★★★★ ()

Мне кажется, ты форумом ошибся.

Deleted ()
Ответ на: комментарий от Deleted

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

qnikst ★★★★★ ()
Вы не можете добавлять комментарии в эту тему. Тема перемещена в архив.