Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Polymorphic types in records

Tags:

haskell

I'm trying to write a function that reads raw bytes from a file, "casts" it to a "plain" type, then sorts it.

In order to do this, I need to tell the sort how it should interpret the binary data - i.e., what the type of the binary data is.

In order for it to be "binary" data, in the sense of "I can treat this data as raw bits, as I read and write it from disk", the type of the data must be Binary and Bits. And, to sort it, it must be a member of Ord.

Any type constrained these ways should be sortable.

As a little hack, in order to pass the type to the sort function, I am passing an inhabitant of the type instead. (If there's a way to pass the type itself and achieve the results, I'd love to know.)

{-# LANGUAGE RankNTypes #-}

import Data.Binary.Get
import Data.Binary.Put

type Sortable = forall a. (Bits a, Binary a, Ord a) => a

data SortOpts = SortOpts { maxFiles :: Int
    , maxMemory :: Integer
    , maxThreads :: Int
    , binType    :: Sortable
}

defaultOpts = SortOpts { maxFiles = 128
    , maxMemory = 1000 * 1000 * 1000 * 1000
    , maxThreads = 4
    , binType = 0 :: Word32
};

putBinaryValues :: Binary a => Handle -> [a] -> IO ()
putBinaryValues out vals = do
    let bytes = runPut . mapM_ put $ vals
    BL.hPut out bytes

binaryValues :: (Binary a, Bits a) => a -> Handle -> IO [a]
binaryValues t inf = do 
    size <- hFileSize inf
    let cast = runGet (genericReplicateM (size `div` byteWidth) get)
    cast . BL.fromChunks . (:[]) <$> BS.hGetContents inf
    where genericReplicateM n = sequence . (DL.genericReplicate n)
          byteWidth = fromIntegral $ (bitSize t) `div` 8

But this doesn't compile. Apparently Haskell insists that all of the values of the record are concrete types. At least, that's what I'm gathering from the error message:

Could not deduce (a ~ Word32)
    from the context (Bits a, Ord a, Binary a)
        bound by a type expected by the context:
             (Bits a, Ord a, Binary a) => a
at ...
    `a' is a rigid type variable bound by
        a type expected by the context: (Bits a, Ord a, Binary a) => a

So, how could I achieve this generalization?

EDIT:

I wanted to use record update syntax to "configure" the sort. E.G.:

configure = defaultOpts -- and exporting that

and later

let myOpts = configure{ binType = 42 :: Word16 }

But this doesn't work, and I can't quite understand why, unless it's just NYI.

Record update for insufficiently polymorphic field: binType :: a
In the expression: configure {binType = words !! 0}
In an equation for `o': o = configure {binType = words !! 0}
In the expression:
  do { inTestHandle <- inTest;
       words <- testRandomWords;
       putBinaryValues inTestHandle $ take 100 words;
       seekBeg inTestHandle;
       .... }

So, does my client code just have to copy the values out of defaultOpts piecemeal and make a new record every it wants to reconfigure the sort?

like image 505
masonk Avatar asked Sep 03 '13 17:09

masonk


2 Answers

The Problem

The problem is the RankNTypes. Look at Sortable, it is a function which will return an arbitrary a, where a is an instance of Ord, Bits, and Bytes. In other words, you don't have just an instance of the 3 classes there, you have all instances there.

Word32 obviously can't do this, so trying to put it there is an error.

Think of this like undefined, undefined isn't "some type compatible with a", it can be all types. It would be equivalent to saying

foo :: a
foo = 1

If you want some vocab: a is universally quantified, so the caller chooses the implementation. What you want is an existential quantification, where the callee chooses the concrete type.

Possible Fixes

So the simplest remedy is

data SortOpts a = SortOpts { 
    maxFiles :: Int
    , maxMemory :: Integer
    , maxThreads :: Int
    , binType    :: a
}

and constrain a on each function

 someFun :: (Bits a, Bytes a, Ord a) => SortOpts a -> whatever

To ease the typing,

 class (Ord a, Bytes a, Bits a) => Sortable a where
 instance (Ord a, Bytes a, Bits a) => Sortable a where

Otherwise you'll need to create an existential "boxing" type. Here I use a GADT to do that.

 {-# LANGUAGE GADTs #-}

 data SortBox where
     Sort :: (Bits a, Bytes a, Ord a) => a -> SortBox

and then create instances of Bits, Bytes, and Ord on it simply by unboxing the hidden a and operating on it. This let's you box up any type with Sort and then use it generically as a Bits, Bytes, or Ord. It's transparent at the type level, but at the value level you must box stuff up which is odd.

data SortOpts a = SortOpts { 
    maxFiles :: Int
    , maxMemory :: Integer
    , maxThreads :: Int
    , binType    :: SortBox
}
like image 91
Daniel Gratzer Avatar answered Nov 15 '22 10:11

Daniel Gratzer


You can use ExistentialQuantification in your SortOpts type. The following compiles:

{-# LANGUAGE ExistentialQuantification #-}

import Data.Bits
import Data.Word
import Data.Binary
import Data.Binary.Get
import Data.Binary.Put

data SortOpts = forall a. (Bits a, Binary a, Ord a) => SortOpts
    { maxFiles   :: Int
    , maxMemory  :: Integer
    , maxThreads :: Int
    , binType    :: a
    }

defaultOpts = SortOpts
    { maxFiles = 128
    , maxMemory = 1000 * 1000 * 1000 * 1000
    , maxThreads = 4
    , binType = 0 :: Word32
    }

However, note that you cannot use binType as a function because it would have a type like exists a. SortOpts -> a and you cannot existential types as return values. You can however get the field value by pattern matching, for example

test :: SortOpts -> ByteString -> ByteString -> Ordering
test (SortOpts{binType=binType}) bsa bsb = compare a b where
    a = runGet get bsa `asTypeOf` binType
    b = runGet get bsb `asTypeOf` binType

This deserializes and compares the two bytestrings using the existential binType in the given SortOpts.

As you noticed, Haskell's record-update syntax doesn't support existential fields, so you need to do something like this to update binType:

defaultOpts = SortOpts
    { maxFiles = 128
    , maxMemory = 1000 * 1000 * 1000 * 1000
    , maxThreads = 4
    , binType = 0 :: Word32
    }

alternativeOpts = withBinType (0 :: Word16) $ defaultOpts
    { maxFiles = 256 }

withBinType :: (Bits a, Binary a, Ord a) => a -> SortOpts -> SortOpts
withBinType bt (SortOpts{..}) = SortOpts maxFiles maxMemory maxThreads bt

The above uses RecordWildCards to make copying the record a bit easier. It's also a handy extension when using the options record later on.

Alternatively, as jozefg suggested, you could use a wrapper type for binType. You would use it like this:

{-# LANGUAGE ExistentialQuantification #-}

data BinType = forall a. (Bits a, Binary a, Ord a) => BinType a

data SortOpts = SortOpts
    { maxFiles   :: Int
    , maxMemory  :: Integer
    , maxThreads :: Int
    , binType    :: BinType
    }

defaultOpts = SortOpts
    { maxFiles = 128
    , maxMemory = 1000 * 1000 * 1000 * 1000
    , maxThreads = 4
    , binType = BinType (0 :: Word32)
    }

alternativeOpts = defaultOpts
    { binType = BinType (0 :: Word16) }

Since SortOpts is now just a regular record type you can use all record operations normally. To refer to the unwrapped binType, you need to pattern match on the wrapper so the test example from before would become (using RecordWildCards)

test :: SortOpts -> ByteString -> ByteString -> Ordering
test (SortOpts{..}) bsa bsb = case binType of
    BinType bt -> compare a b where
        a = runGet get bsa `asTypeOf` bt
        b = runGet get bsb `asTypeOf` bt

Note that all of the above assumes that you have a particular use-case where you need to be able to hide the exact type parameter behind an existential for some reason. Normally, you would just leave the type-parameter in SortOpts and constrain it in the functions that use SortOpts. I.e.

data SortOpts a = SortOpts
    { maxFiles   :: Int
    , maxMemory  :: Integer
    , maxThreads :: Int
    , binType    :: a
    }

test :: (Bits a, Binary a, Ord a) => SortOpts a -> ByteString -> ByteString -> Ordering
test (SortOpts{..}) bsa bsb = compare a b where
    a = runGet get bsa `asTypeOf` binType
    b = runGet get bsb `asTypeOf` binType

You can use the ConstraintKinds extension to make a shorter alias if needed, as in

{-# LANGUAGE ConstraintKinds #-}

type BinType a = (Bits a, Binary a, Ord a)

test :: BinType a => SortOpts a -> ByteString -> ByteString -> Ordering
like image 32
shang Avatar answered Nov 15 '22 09:11

shang