テンソル積とZ/6Zの実装(Eqのインスタンスを定めるところがincomplete)

Tensor.hs

{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts, UndecidableInstances #-}
import Data.Bifunctor
import Data.Biapplicative
import Data.List

data Tensor a b = a :*: b deriving (Show)

class ShowAll c where
  toList :: [c]

instance Functor (Tensor a) where
  fmap f (a :*: b) = a :*: (f b)

instance Bifunctor Tensor where
  bimap f g (a :*: b) = (f a) :*: (g b)

instance Biapplicative Tensor where
  bipure a b = a :*: b
  (f :*: g) <<*>> (a :*: b) = (f a) :*: (g b)

-- この実装では一回分の推論しかされないので上手く行かない場合がある
instance (Integral a, Integral b) => Eq (Tensor a b) where
  (a :*: b) == (0 :*: _) = a == 0 || b == 0
  (_ :*: 0) == (c :*: d) = c == 0 || d == 0
  (a :*: b) == (c :*: d) = toInteger (a `div` c) == toInteger (d `div` b)

instance (Num a, Num b) => Num (Tensor a b) where
  a + b = biliftA2 (+) (+) a b
  a * b = biliftA2 (*) (*) a b
  signum = bimap signum signum
  abs = bimap abs abs
  fromInteger a = bipure (fromInteger a) (fromInteger a)

instance (ShowAll a, ShowAll b, Eq (Tensor a b)) => ShowAll (Tensor a b) where
  toList = nub [x :*: y | x <- toList, y <- toList]

newtype Z = Z Int deriving (Show, Eq, Ord, Enum, Real, Integral, Num)
newtype Z_Z6 = Z_Z6 Int deriving (Show, Ord, Enum, Real)
newtype Z6 = Z6 Int deriving (Show, Eq, Ord, Enum, Real, Integral, Num)

instance ShowAll Int where toList = 0 : concat [[x,-x] | x <- [1..]]
instance ShowAll Integer where toList = 0 : concat [[x,-x] | x <- [1..]]
instance ShowAll Z where toList = fmap Z (toList :: [Int])
instance ShowAll Z_Z6 where toList = [0..5]
instance ShowAll Z6 where toList = [fromInteger x*6 | x <- (toList :: [Integer])]

instance Eq Z_Z6 where
  (Z_Z6 a) == (Z_Z6 b) = (a - b) `mod` 6 == 0

instance Num Z_Z6 where
  (Z_Z6 a) + (Z_Z6 b) = Z_Z6 ((a + b) `mod` 6)
  (Z_Z6 a) * (Z_Z6 b) = Z_Z6 ((a * b) `mod` 6)
  signum (Z_Z6 n) = Z_Z6 (signum n)
  abs (Z_Z6 n) = Z_Z6 (abs n)
  fromInteger n = Z_Z6 (fromInteger n `mod` 6)
  negate (Z_Z6 n) = Z_Z6 (negate n)

instance Integral Z_Z6 where
  (Z_Z6 a) `quotRem` (Z_Z6 b)
    | a < b = (Z_Z6 (a+6)) `quotRem` (Z_Z6 b)
    | otherwise = bimap Z_Z6 Z_Z6 $ a `quotRem` b
  toInteger (Z_Z6 a)
    | a `mod` 6 < 0 = (fromIntegral a + 6) `mod` 6
    | otherwise = fromIntegral a `mod` 6

main = do
  print $ take 10 $ (toList :: [Tensor Z6 Z_Z6])
  print $ Z6 18 :*: Z_Z6 2 == Z6 6 :*: Z_Z6 0
  print $ Z6 6 :*: Z_Z6 0 == Z6 0 :*: Z_Z6 0