--------------------------------------------------------------------------------
--                                                                            --
--  SubType is used to define a subtype relationship                          --
--                                                                            --
--------------------------------------------------------------------------------

-- SubType class

class SubType sub sup where
  inj :: sub -> sup
  prj :: sup -> sub

-- runtime error facility (this should never occur)

prjErr = const (error "prj : don't know where to go to") 

-- ONLY SubType instance (only overlaps with sum)

instance SubType u (ONLY u) where
  inj = only 
  prj = ylno
    
-- sum SubType instances

instance Sum sum => SubType sub (sum sub any) where
  inj = inl
  prj = id <+> prjErr

instance (Sum sum, SubType sub sup) => SubType sub (sum any sup) where
  inj = inr . inj 
  prj = prjErr <+> prj
           
-- monadic reflexivity 

class    SubType (m v -> m v) v => Reflexive m v
instance SubType (m v -> m v) v => Reflexive m v

-- utility

resultInj :: (Monad m, SubType sub sup) => sub -> m sup
resultInj = result . inj

--------------------------------------------------------------------------------
