Использование Deriving Via с фантомными типами - PullRequest
Новая
       39

Использование Deriving Via с фантомными типами

0 голосов
/ 28 ноября 2018

Извиняюсь за долгое повторение, но я не смог сделать его короче.Следующий код прекрасно компилируется до последней строки: 

{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, UndecidableInstances #-}
{-# LANGUAGE DerivingVia, DerivingStrategies, StandaloneDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Repro where

import Prelude hiding ((+))

class (Additive a) where
    (+) :: a -> a -> a

data Vector2D u = Vector2D { 
    x :: u, 
    y :: u 
}

addVector2 :: (Additive a) => Vector2D a -> Vector2D a -> Vector2D a 
addVector2 Vector2D { x = x1, y = y1 } (Vector2D { x = x2, y = y2 }) = 
    Vector2D { x = x1 + x2, y = y1 + y2 }

instance (Additive a) => Additive (Vector2D a) where
    (+) = addVector2

newtype Phantom1 d a = Phantom1 (Vector2D a) --Axial 

deriving via (Vector2D a) instance forall d . (Additive a) => (Additive (Phantom1 d a))

data Via a b = Via a

class IsoEvidence a b where
    convertTo :: a -> b
    convertFrom :: b -> a

instance forall a b . (IsoEvidence a b, Additive b) => (Additive (Via a b)) where
    (Via x) + (Via y) = Via $ convertFrom $ (convertTo x :: b) + (convertTo y :: b)  

newtype Phantom2 d a = Phantom2 (Vector2D a) --Offset 

instance (IsoEvidence (Phantom1 d a) (Phantom2 d a)) where
    convertTo (Phantom1 x) = Phantom2 x
    convertFrom (Phantom2 x) = Phantom1 x

deriving via (Via (Phantom2 d a) (Phantom1 d a)) 
    instance (Additive a, IsoEvidence (Phantom1 d a) (Phantom2 d a)) => 
        (Additive (Phantom2 d a))

После этого я получаю следующую ошибку:

  • Не удалось сопоставить представление типа Vector2D a с представлением Via (Phantom2 d a) (Phantom1 d a)

Что говорит о том, что оно не может привести "Via & c" к "Vector2D a", что странно, потому что это буквально новый тип глубиной в два уровня, и это прекрасно работает.

Что я здесь не так делаю?

1 Ответ

0 голосов
/ 28 ноября 2018

DerivingVia работает через новые типы, но вы написали 

data Via a b = Via a   -- should be newtype
...