-- Haskell (ghc) program eg.hs, L.A., 10/4/2025
-- This is an *entirely artificial* example to investigate whether a
-- class (e.g., Pair), whose instance types have some type-parameters,
-- can have a subclass (e.g., PairNum) where those type parameters are
-- more restricted (e.g., Num) or even completely fixed (e.g., Double).

-- {-# LANGUAGE GADTs #-} -- warnings if commented out, see 'GADTs' below
-- GADTs seem to do the trick; some other failed attempts are commented out.

import Prelude hiding (Pair, fst, snd)  -- NB. ***

class Pair pt where                        -- super-class Pair
  fst :: (pt u v) -> u
  snd :: (pt u v) -> v
  f   :: (pt u v) -> (pt v w) -> (pt u w)  -- f will cause difficulty later

data Ptype u v = ConsPtype u v deriving Show  -- type Ptype

instance Pair Ptype where                     -- is an instance of Pair
  fst (ConsPtype x y) = x
  snd (ConsPtype x y) = y
  f (ConsPtype a b) (ConsPtype c d) = ConsPtype a d  -- it's just an e.g.
---------------------------------------------------

class (Pair pnt) => PairNum pnt where    -- PairNum, subclass of Pair
  total :: (Num u) => pnt u u -> u       -- OK
  -- total :: pnt Double Double -> Double  -- also OK

fromPairNum pn = ConsPtype (fst pn) (snd pn) -- sidestep need of Show PNtype

-- data PNtype u v = (Num u, Num v) => ConsPNtype u v -- i.e. pairs of Num types
-- data PNtype = ConsPNtype Double Double -- error: makes PNtype's 'kind' *
data PNtype u v = (Num u, Num v, u~v) => ConsPNtype u v  -- OK but...
   -- the "u~v" above triggers *warnings* "Pattern matching on GADTs
   -- without MonoLocalBinds is fragile. Suggested fix:
   -- Enable any of the following extensions: GADTs, TypeFamilies"

instance Pair PNtype where     -- is an instance of Pair and ...
  fst (ConsPNtype x y) = x
  snd (ConsPNtype x y) = y
  -- f (ConsPNtype a b) (ConsPNtype c d) = undefined -- ?can this be fixed?...
  f (ConsPNtype a b) (ConsPNtype c d) = ConsPNtype (a+c) (b+d) -- type error or...
    -- maybe with GADTs? "Pattern matching on GADTs without MonoLocalBinds
    -- is fragile [...] extensions: GADTs, TypeFamilies"  Uh?!

instance PairNum PNtype where  -- ... also an instance of PairNum
  total (ConsPNtype x y) = x+y
---------------------------------------------------

two = 2 :: Int
a_2 = ConsPtype 'a' 2
-- a_2' = ConsPNtype 'a' 2 -- error (good): not a pair of Num
one_two  = ConsPNtype 1 2

main = putStrLn( "eg.hs:\n"
  ++ " a_2=" ++ show(a_2) ++ ", "
  ++ " fst a_2:"      ++ show(fst a_2) ++ ", "
  ++ " snd a_2:"      ++ show(snd a_2) ++ ", "
  ++ " fst one_two:" ++ show(fst one_two) ++ ", "
  ++ " total one_two:" ++ show(total one_two) ++ ", "
  ++ " f one_two one_two:" ++ (show(fromPairNum(f one_two one_two))) ++ ", "
  )