Proper way to wrap selectively class instances (or "lift" functions like `sortBy`, `minimumBy`, ... automatically)

Question

Let some type instanced to many classes. What is the proper way to replace, selectively, certain instances's behaviors?

One way to express it could be construct the by operator then

data Person ...

sort personList              -- default Ord instance
(sort `by` age) personList   -- `age` modify `Ord` instance

here, sort could be any function (e.g. minimum) with any arity (e.g. insert).

If we have a function like

reportPersons :: [Person] -> Report

and it functions use Ord (to sort list), Show (to format records), ... or other especific instances; using funcBy pattern we must to write

reportPersonsBy :: (Person -> Person -> Ordering) -> (Person -> String) -> ... -> [Person] -> Report

but we can use by to wrap each behavior with original reportPersons without refactor reportPersonsBy (explained example and not solved related problems at the end).

My toy (and not fully satisfactory) solution is (complete code at the end):

A class to wrap types into types to override instances

class Wrappable m where
    wrap   :: forall a . a -> m a
    unwrap :: forall a . m a -> a

and by function to wrap functions

-- wrap functions: f a -> g a
by :: (Functor f, Functor g, Wrappable m) => (f (m a) -> g (m a)) -> m a -> f a -> g a
by f _ = fmap unwrap . f . fmap wrap

-- wrap functions: a -> f a -> g a
by_ f m a = f (wrap a) `by` m

Now we can write (at the bottom complete example)

-- f a -> f a
mapM_ print $  sort           personList
mapM_ print $ (sort `by` age) personList

-- f a -> g a
print $  minimum           personList
print $ (minimum `by` age) personList

-- a -> f a -> f a
print $  insert            jane personList
print $ (insert `by_` age) jane personList

Ok, by, by_, ... works but, what is the correct way? how write complete polymorphic by?

I've tried but not work

class Wrappable m => By m x f i o where
    by :: f m x -> m x -> i m x -> o m x

to be able to write function instances as

instance (Wrappable m, Functor f, Functor g) => By m a (f (m a) -> g (m a)) (f a) (g a) where
    by :: (f (m a) -> g (m a)) -> m a -> f a -> g a
    by f _ = fmap unwrap . f . fmap wrap

Thank you!

Report example

Suppose exists one report function for persons (wrappable persons)

reportPersons :: (Wrappable m, Show (m Person), Ord (m Person)) => [m Person] -> Maybe String
reportPersons = Just . unlines . map show . sort

with carried behaviors for each instance (Ord and Show).

Let (not polymorphic by :( )

by' :: (Functor f, Functor g, Wrappable m) => (f (m a) -> g b) -> m a -> f a -> g b
by' f _ = f . fmap wrap

and a new Wrappable instance for Persons

newtype Format1 a = Format1 a deriving (Eq, Ord)
instance Show (Format1 Person) where show (Format1 (Person n a)) = "Name := " ++ n ++ " (" ++ show a ++ " years old)"
format1 :: Format1 Person; format1 = undefined
instance Wrappable Format1 where  wrap               = Format1
                                  unwrap (Format1 p) = p

now, we can report persons overlapping selectively behaviors

putStrLn $ fromJust $ (reportPersons `by'` age)     personList
putStrLn $ fromJust $ (reportPersons `by'` format1) personList

with output

ByAge (Person {personName = "John", personAge = 16})
ByAge (Person {personName = "Anne", personAge = 24})
ByAge (Person {personName = "Zorn", personAge = 37})
ByAge (Person {personName = "Peter", personAge = 42})

Name := Anne (24 years old)
Name := John (16 years old)
Name := Peter (42 years old)
Name := Zorn (37 years old)

using TypeFamilies or other feature probably, we can chain Wrappables, etc... (it's a toy!!! and I don't know how to do in a good way)

(complete sandbox code)

{-# LANGUAGE RankNTypes, FlexibleInstances #-}
import Data.Maybe
import Prelude hiding (minimum)
import Data.List hiding (minimum)
import System.Random

{- safe minimum -}
minimum [] = Nothing; minimum xs = listToMaybe $ sort xs

data Person = Person { personName :: String, personAge :: Int } deriving (Eq, Show, Ord)

personList = [Person "Anne" 24, Person "John" 16, Person "Peter" 42, Person "Zorn" 37]
jane       =  Person "Jane" 26


class Wrappable m where
    wrap   :: forall a . a -> m a
    unwrap :: forall a . m a -> a

-- wrap functions: f a -> g a
by :: (Functor f, Functor g, Wrappable m) => (f (m a) -> g (m a)) -> m a -> f a -> g a
by f _ = fmap unwrap . f . fmap wrap

-- wrap functions: a -> f a -> g a
by_ f m a = f (wrap a) `by` m

newtype ByAge a = ByAge a deriving (Eq, Show)
instance Ord (ByAge Person) where (ByAge (Person _ a)) `compare` (ByAge (Person _ b)) = a `compare` b
age :: ByAge Person; age = undefined
instance Wrappable ByAge where  wrap             = ByAge
                                unwrap (ByAge p) = p

main = do

    -- f a -> f a
    mapM_ print $  sort           personList
    mapM_ print $ (sort `by` age) personList

    -- f a -> g a
    print $  minimum           personList
    print $ (minimum `by` age) personList

    -- a -> f a -> f a
    print $  insert            jane personList
    print $ (insert `by_` age) jane personList

Answer 1

I found one possible valid way.

Let our data type

data Person = Person { name :: String
                     , age  :: Int
                     } deriving (Show, Eq, Ord)

to grant overload selectively (and interdependently) instances we only need

class CPerson p where
    get :: p -> Person -- grant access to real data

instance CPerson Person where
    get = id

now, let any function without specify explicitly behaviors (like sortBy vs. sort)

reportPersons :: (Ord p, Show p, CPerson p) => [p] -> IO ()
reportPersons = mapM_ print . sort

with that, we can only report ordering by name and showing with default Show data instance

Person {name = "Alice", age = 24}
Person {name = "Anne", age = 16}
Person {name = "Peter", age = 16}
Person {name = "Pluto", age = 24}

A posteriori we need sort that report using any other field (eg. age), without modify (we won't, we can't, ...) reportPersons function we can do writing

-- Wrap our inner `CPerson`
newtype OrdByAge p = OrdByAge p deriving Eq -- Eq is invariant over wrapping

-- Grant access to other wrappers to final data
instance CPerson p => CPerson (OrdByAge p) where
    get (OrdByAge q) = get q

-- `Show` maybe or not invariant over wrapping, then bypass
instance (Show p, CPerson p) => Show (OrdByAge p) where
    show = show . get

-- `Ord` instance modification to sort by age
instance (Eq p, CPerson p) => Ord (OrdByAge p) where
    (OrdByAge a) `compare` (OrdByAge b) = (age $ get a) `compare` (age $ get b)

now, we can use the unmodified reportPersons ordering by age

reportPersons $ personList `as` OrdByAge

with result

Person {name = "Peter", age = 16}
Person {name = "Anne", age = 16}
Person {name = "Alice", age = 24}
Person {name = "Pluto", age = 24}

now, we won sort by age then by name, again without modify reportPersons

newtype ThenByName p = ThenByName p deriving (Show, Eq)
instance CPerson p => CPerson (ThenByName p) where
    get (ThenByName q) = get q

-- Using the chained instance to compare first by inner then by our instance
instance (Eq q, Ord q, CPerson q) => Ord (ThenByName q) where
    (ThenByName a) `compare` (ThenByName b) =
        case a `compare` b of
            EQ -> (name $ get a) `compare` (name $ get b)
            x  -> x

we can write many different instance versions, e.g. two different format instances

-- Short format:
newtype ShortFormat p = ShortFormat p deriving (Eq, Ord)
instance CPerson p => CPerson (ShortFormat p) where
    get (ShortFormat q) = get q
instance CPerson p => Show (ShortFormat p) where
    show p = (name $ get p) ++ " (" ++ (show $ age $ get p) ++ " years old)"

-- Long format:
newtype LongFormat p = LongFormat p deriving (Eq, Ord)
instance CPerson p => CPerson (LongFormat p) where
    get (LongFormat q) = get q
instance CPerson p => Show (LongFormat p) where
    show p = "Person:\n\tName: " ++ (name $ get p) ++ "\n\tAge: " ++ (show $ age $ get p)

and mix instances as we prefer, e.g. we can get a new modifiedReport as

let modifiedReport = reportPersons ~> OrdByAge
                                   .> ThenByName
                                   .> LongFormat

modifiedReport personList

with result

Person:
    Name: Anne
    Age: 16
Person:
    Name: Peter
    Age: 16
Person:
    Name: Alice
    Age: 24
Person:
    Name: Pluto
    Age: 24

(Complete sandbox code)

import Data.List

data Person = Person { name :: String
                     , age  :: Int
                     } deriving (Show, Eq, Ord)

class CPerson p where
    get :: p -> Person

instance CPerson Person where
    get = id

reportPersons :: (Ord p, Show p, CPerson p) => [p] -> IO ()
reportPersons = mapM_ print . sort

personList = [ Person "Peter" 16
             , Person "Alice" 24
             , Person "Pluto" 24
             , Person "Anne"  16
             ]

newtype OrdByAge p = OrdByAge p deriving Eq
instance CPerson p => CPerson (OrdByAge p) where
    get  (OrdByAge q) = get q
instance (Eq p, CPerson p) => Ord (OrdByAge p) where
    (OrdByAge a) `compare` (OrdByAge b) = (age $ get a) `compare` (age $ get b)
instance (Show p, CPerson p) => Show (OrdByAge p) where
    show = show . get

newtype ShortFormat p = ShortFormat p deriving (Eq, Ord)
instance CPerson p => CPerson (ShortFormat p) where
    get (ShortFormat q) = get q
instance CPerson p => Show (ShortFormat p) where
    show p = (name $ get p) ++ " (" ++ (show $ age $ get p) ++ " years old)"

newtype ThenByName p = ThenByName p deriving (Show, Eq)
instance CPerson p => CPerson (ThenByName p) where
    get (ThenByName q) = get q
instance (Eq q, Ord q, CPerson q) => Ord (ThenByName q) where
    (ThenByName a) `compare` (ThenByName b) =
        case a `compare` b of
            EQ -> (name $ get a) `compare` (name $ get b)
            x  -> x

newtype LongFormat p = LongFormat p deriving (Eq, Ord)
instance CPerson p => CPerson (LongFormat p) where
    get (LongFormat q) = get q
instance CPerson p => Show (LongFormat p) where
    show p = "Person:\n\tName: " ++ (name $ get p) ++ "\n\tAge: " ++ (show $ age $ get p)

xs `as` q = fmap q xs

f ~> q = f . fmap q  ; infixr 7 ~>
p .> q = q . p       ; infixr 8 .>

main = do

    reportPersons personList

    reportPersons $ personList `as` OrdByAge

    reportPersons $ personList `as` OrdByAge
                               `as` ThenByName
                               `as` ShortFormat

    let modifiedReport = reportPersons ~> OrdByAge
                                       .> ThenByName
                                       .> LongFormat

    modifiedReport personList

Answer 2

Let some type instanced to many classes. What is the proper way to replace, selectively, certain instances's behaviors?

The proper way is to use plain old functions and use sortBy, maximumBy, groupBy etc. instead.

I think this is abuse of typeclasses. Keep it simple, stupid! Yes, this is opinion-based, let stackoverflow's voting system sort(By) it out.