How do I wrap type signatures using GADT

Question

Background

The general task is to dig into a list of (very complicated) records, reporting on what they contain. This means inventing lots of filters and maps over the list and reporting back.

The simplified problem looks something like this:

{-# LANGUAGE OverloadedStrings, DataKinds, ExistentialQuantification, GADTs #-}

import qualified Data.Map as Map
import Control.Monad (void)

data Rec = Rec
  { _rInt   :: Int
  , _rChar  :: Char
  } deriving (Show,Eq,Ord)

tRec = take 10 $ zipWith Rec [1..] ['a'..]

count :: (Ord a) => [b] -> (b -> a) -> (b -> Bool) -> Map.Map a Int
count list key pred' =
    let fn a = Map.insertWith (+) (key a) 1 in
    foldr fn Map.empty (filter pred' list)

report :: (Ord a, Show a) => [b] -> String -> (b -> a) -> (b -> Bool) -> IO ()
report list str key pred' = do
  let c = count list key pred'
  (putStrLn . (str ++) . show) c

For example:

λ: report tRec "count of characters with odd ints: " _rChar (odd . _rInt) 
count of characters with odd ints: fromList [('a',1),('c',1),('e',1),('g',1),('i',1)]

Standard datatype wrapper

The various reports can be bundled up quite nicely (and ready for further refactoring) using a higher-order type wrapper like so:

data Wrap = WrapInt Int | WrapChar Char deriving (Show, Eq, Ord)

demoWrap = void $ sequence $
  zipWith3
    (report tRec)
    ["count of all ints: ","count of characters with odd ints: "]
    [WrapInt . _rInt, WrapChar . _rChar]
    [const True, odd . _rInt]

Which gives:

λ: demoWrap
count of all ints: fromList [(WrapInt 1,1),(WrapInt 2,1),(WrapInt 3,1),(WrapInt     4,1),(WrapInt 5,1),(WrapInt 6,1),(WrapInt 7,1),(WrapInt 8,1),(WrapInt 9,1),(WrapInt 10,1)]
count of characters with odd ints: fromList [(WrapChar 'a',1),(WrapChar 'c',1),(    WrapChar 'e',1),(WrapChar 'g',1),(WrapChar 'i',1)]

GADT solution

In an attempt to remove the wrapper type ugliness I thought an ADT/GADT solution might help.

Here's my attempt:

-- GADTs attempt

data Useable where
  MkUseable :: (Show a, Eq a, Ord a) => a -> Useable

wrap :: (Show a, Eq a, Ord a) => a -> Useable
wrap = MkUseable

instance Show Useable where
  showsPrec p (MkUseable a) = showsPrec p a


-- this doesn't work
instance Eq Useable
--  where
--  (MkUseable a) == (MkUseable b) = a == b

instance Ord Useable
--  where
--  compare (MkUseable a) (MkUseable b) = compare a b

demoGADT = void $ sequence $
  zipWith3
    (report tRec)
    ["all ints:","odd chars:"]
    [wrap . _rInt, wrap . _rChar]
    [const True, odd . _rInt]

The compiler (quite rightly) barfs at Eq and Ord instances of Useable having potentially different types. But the intention isn't to ever compare Useables with different types - it's to more simply wrap any (Show a, Ord a) type so I can put them in a list.

So two questions:

How can types be wrapped using GADT in the spirit of the standard wrapper solution above?

What am I missing (more generally) - are there easier ways to functionally interrogate data?

Answer 1

This will require changes to your original functions, but one way to solve this with GADTs is to wrap the whole keying function instead of the return value. I.e.

data Key b where
    Key :: (Ord a, Show a) => (b -> a) -> Key b

count :: [b] -> Key b -> (b -> Bool) -> Map.Map a Int
count list (Key key) pred' =
    let fn a = Map.insertWith (+) (key a) 1 in
    foldr fn Map.empty (filter pred' list)

report :: [b] -> String -> Key b -> (b -> Bool) -> IO ()
report list str key pred' = do
  let c = count list key pred'
  (putStrLn . (str ++) . show) c

However, the problem now is that we promise to return a Map.Map a Int from count but we have no idea what a might be, since it's hidden away in the Key existential. But since we don't really care (at least in the scope of this example), we can wrap the result Map in another existential that hides the type of the key.

{-# LANGUAGE StandaloneDeriving #-}

data CountMap where
    CountMap :: (Ord a, Show a) => Map.Map a Int -> CountMap

deriving instance Show CountMap

and change count accordingly

count :: [b] -> Key b -> (b -> Bool) -> CountMap
count list (Key key) pred' =
    let fn a = Map.insertWith (+) (key a) 1 in
    CountMap $ foldr fn Map.empty (filter pred' list)

Now we can do

demoWrap = void $ sequence $
  zipWith3
    (report tRec)
    ["count of all ints: ","count of characters with odd ints: "]
    [Key _rInt, Key _rChar]
    [const True, odd . _rInt]

Answer 2

You created an existential type, but that's not what you want.

A non-existential ("transparent") wrapper looks like this:

data Useable a where
  MkUseable :: (Show a, Eq a, Ord a) => a -> Useable a

Notice how the Useable type carries information about what's inside it via its type parameter.

By the way, you can define the same wrapper using the ordinary (non-GADT) syntax, too:

data Useable a = (Show a, Eq a, Ord a) => Useable a

(still requires a language extension like -XGADTs, though)

Answer 3

You could of course go completely dynamic and use

import Data.Typeable

data Useable where
  MkUseable :: (Show a, Eq a, Ord a, Typeable a) => a -> Useable

instance Eq Useable where
  (MkUseable a) == (MkUseable b)
    | Just a' <- cast a  = a' == b
    | otherwise          = False

Ord could be implemented as well. But as you'd probably say yourself right away, this is not really nice.

I think you just shouldn't have such a type for demoGADT. With such a polymorphic Map type you won't (without Typeable) be able to actually use the values for anything more anyway; here you're indeed discarding the types entirely by going in IO(). So you might as well do

demoNoGADT = void . sequence $ zipWith3 (\s f p -> f p s)
    ["all ints:", "odd chars:"]
    [r _rInt    , r _rChar    ]
    [const True ,odd . _rInt  ]
  where r :: (Ord a, Show a) => (Rec -> a) -> (Rec -> Bool) -> String -> IO ()
        r key pred' descript = report descript tRec key pred'

No GADTs/exitentials needed. To make this more general you may however need {-# LANGUAGE RankNTypes #-}, to allow for different report functions:

demoRankNParam :: 
   ( forall a b . (Ord a, Show a) => [b] -> String -> (b -> a) -> (b -> Bool) -> IO () )
        -> IO ()
demoRankNParam report' = void . sequence $ zipWith3 (\s f p -> f p s)
    ["all ints:", "odd chars:"]
    [r _rInt    , r _rChar    ]
    [const True ,odd . _rInt  ]
  where r :: (Ord a, Show a) => (Rec -> a) -> (Rec -> Bool) -> String -> IO ()
        r key pred' descript = report' descript tRec key pred'

Now you can pass report, or variations of it, as a parameter.