The problem with the "caching" solution as presented, however, is that it works for functions with the signature of sort. But most functions, such as maximum, have no such signature. But wait... polymorphism comes to the rescue!
> {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FunctionalDependencies #-}
> module Schwartz where
> import Data.List
> import Control.Applicative
> import Data.Function
Then a type for our Schwartzian transform:
> data Schwartz a b = Schwartz {sw_out :: !a, sw_trans :: !b}
> instance Eq b => Eq (Schwartz a b) where (==) = (==) `on` sw_trans
> instance Ord b => Ord (Schwartz a b) where compare = compare `on` sw_trans
Injection:
> sw_in f = Schwartz <*> f
And a higher order function for the [a] -> [a] case:
> schwartzAWith :: (a -> b) -> ([Schwartz a b] -> [Schwartz a b]) -> [a] -> [a]
> schwartzAWith f g = map sw_out . g . map (sw_in f)
And then for the [a] -> a case:
> schwartzBWith :: (a -> b) -> ([Schwartz a b] -> Schwartz a b) -> [a] -> a
> schwartzBWith f g = sw_out . g . map (sw_in f)
A bit clunky, but a typeclass that embodies the pattern:
> class ToSchwartz a b c d | c -> d where
> using :: (a -> b) -> ([Schwartz a b] -> c) -> [a] -> d
Instances:
> instance ToSchwartz a b [Schwartz a b] [a] where
> using u = schwartzAWith u
>
> instance ToSchwartz a b (Schwartz a b) a where
> using u = schwartzBWith u
And now....
GHCi> using negate sort [1..5]
[5,4,3,2,1]
GHCi> using negate maximum [1..5]
1
A solution that would please the most discerning Haskell programmer (or Mel Brooks).
--Sterl.