module Test.Agata.Related where

import Control.Monad


-- -XGeneralizedNewtypeDeriving would be nice
newtype Related a b = Related b deriving (Eq,Ord,Show)

instance Num b => Num (Related a b) where
  (+) = liftM2 (+)
  (*) = liftM2 (*)
  (-) = liftM2 (-)
  negate = liftM negate
  abs = liftM abs
  signum = liftM signum
  fromInteger = return . fromInteger

instance Real b => Real (Related a b) where
  toRational = toRational . unrelated

instance Integral b => Integral (Related a b) where
  quot = liftM2 quot
  rem = liftM2 rem
  div = liftM2 div
  mod = liftM2 mod
  quotRem a b = unrelated $ liftM2 quotRem a b >>= \(x,y) -> return (return x,return y)
  divMod a b = unrelated $ liftM2 divMod a b >>= \(x,y) -> return (return x,return y)
  toInteger = toInteger . unrelated

instance Enum b => Enum (Related a b) where
  succ = liftM succ
  pred = liftM pred
  toEnum = return . toEnum
  fromEnum = fromEnum . unrelated
  enumFrom = map return . unrelated . liftM enumFrom
  enumFromThen a = map return . unrelated . liftM2 enumFromThen a
  enumFromTo a = map return . unrelated . liftM2 enumFromTo a
  enumFromThenTo a b = map return . unrelated . liftM3 enumFromThenTo a b


instance Functor (Related a) where
  fmap f (Related a) = Related $ f a

instance Monad (Related a) where
  return = Related
  (Related a) >>= f = f a



unrelated :: Related a b -> b
unrelated (Related b) = b

rerelate :: Related a b -> Related c b
rerelate = return . unrelated

relatedTo :: Related a b -> a -> Related a b
r `relatedTo` _ = r

relatedTo1 :: Related a b -> x a -> Related a b
r `relatedTo1` _ = r

relatedTo2 :: Related a b -> x a x1 -> Related a b
r `relatedTo2` _ = r

relatedTo3 :: Related a b -> x a x1 x2 -> Related a b
r `relatedTo3` _ = r


related :: a -> b -> Related a b
related _ = return

related1 :: x1 a -> b -> Related a b
related1 _ = return

related2 :: x1 a x2 -> b -> Related a b
related2 _ = return

related3 :: x1 a x2 x3 -> b -> Related a b
related3 _ = return


param1 :: Related a b -> Related (x1 a) b
param1 = rerelate