Question

Suppose I have a simple data type like:

data Cell = Open | Blocked

and I'd like to use a UArray Int Cell. Is there an easy way to do this? Can I somehow reuse the definition for UArray Int Bool?

Was it helpful?

Solution

This answer explains why Vectors are better than Arrays, so I'm going to give you the answer for unboxed vectors.

I did try deriving an MArray and IArray instance for Cell based on the Bool instances, but the Bool instances are quite complicated; it would be at least as ugly as manually deriving an Unbox instance for vectors. Unlike vectors, you also can't just derive Storable and use Storable arrays: you still need the Marray and IArray instances. There doesn't appear to be a nice TH solution yet, so you're better off using vectors for those reasons as well.

There are several ways to do this, some more painful than others.

  1. vector-th-unbox

    Pros: Straightforward, much shorter than manually deriving Unbox instances

    Cons: Requires -XTemplateHaskell

    {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, TypeFamilies #-}
    
    import Data.Vector.Unboxed
    import Data.Vector.Unboxed.Deriving
    import qualified Data.Vector.Generic
    import qualified Data.Vector.Generic.Mutable
    
    data Cell = Open | Blocked deriving (Show)
    
    derivingUnbox "Cell"
        [t| Cell -> Bool |]
        [| \ x -> case x of
            Open -> True
            Blocked -> False |]
        [| \ x -> case x of
            True -> Open
            False -> Blocked |]
    
    main = print $ show $ singleton Open
    
  2. Write your own Unbox, M.MVector, and V.Vector instances, plus two data instances

    {-# LANGUAGE TypeFamilies, MultiParamTypeClasses #-}
    
    import qualified Data.Vector.Generic            as V
    import qualified Data.Vector.Generic.Mutable    as M
    import qualified Data.Vector.Unboxed            as U
    import Control.Monad
    
    data Cell = Open | Blocked deriving (Show)
    
    data instance U.MVector s Cell = MV_Cell (U.MVector s Cell)
    data instance U.Vector Cell = V_Cell (U.Vector Cell)
    
    instance U.Unbox Cell
    
    {- purloined and tweaked from code in `vector` 
       package that defines types as unboxed -}
    instance M.MVector U.MVector Cell where
      {-# INLINE basicLength #-}
      {-# INLINE basicUnsafeSlice #-}
      {-# INLINE basicOverlaps #-}
      {-# INLINE basicUnsafeNew #-}
      {-# INLINE basicUnsafeReplicate #-}
      {-# INLINE basicUnsafeRead #-}
      {-# INLINE basicUnsafeWrite #-}
      {-# INLINE basicClear #-}
      {-# INLINE basicSet #-}
      {-# INLINE basicUnsafeCopy #-}
      {-# INLINE basicUnsafeGrow #-}
    
      basicLength (MV_Cell v) = M.basicLength v
      basicUnsafeSlice i n (MV_Cell v) = MV_Cell $ M.basicUnsafeSlice i n v
      basicOverlaps (MV_Cell v1) (MV_Cell v2) = M.basicOverlaps v1 v2
      basicUnsafeNew n = MV_Cell `liftM` M.basicUnsafeNew n
      basicUnsafeReplicate n x = MV_Cell `liftM` M.basicUnsafeReplicate n x
      basicUnsafeRead (MV_Cell v) i = M.basicUnsafeRead v i
      basicUnsafeWrite (MV_Cell v) i x = M.basicUnsafeWrite v i x
      basicClear (MV_Cell v) = M.basicClear v
      basicSet (MV_Cell v) x = M.basicSet v x
      basicUnsafeCopy (MV_Cell v1) (MV_Cell v2) = M.basicUnsafeCopy v1 v2
      basicUnsafeMove (MV_Cell v1) (MV_Cell v2) = M.basicUnsafeMove v1 v2
      basicUnsafeGrow (MV_Cell v) n = MV_Cell `liftM` M.basicUnsafeGrow v n
    
    instance V.Vector U.Vector Cell where
      {-# INLINE basicUnsafeFreeze #-}
      {-# INLINE basicUnsafeThaw #-}
      {-# INLINE basicLength #-}
      {-# INLINE basicUnsafeSlice #-}
      {-# INLINE basicUnsafeIndexM #-}
      {-# INLINE elemseq #-}
    
      basicUnsafeFreeze (MV_Cell v) = V_Cell `liftM` V.basicUnsafeFreeze v
      basicUnsafeThaw (V_Cell v) = MV_Cell `liftM` V.basicUnsafeThaw v
      basicLength (V_Cell v) = V.basicLength v
      basicUnsafeSlice i n (V_Cell v) = V_Cell $ V.basicUnsafeSlice i n v
      basicUnsafeIndexM (V_Cell v) i = V.basicUnsafeIndexM v i
      basicUnsafeCopy (MV_Cell mv) (V_Cell v) = V.basicUnsafeCopy mv v
      elemseq _ = seq
    
    main = print $ show $ U.singleton Open
    

    Wasn't that fun?

  3. Create a Storable instance and use Data.Vector.Storable instead.

    Pros: No TH, and relatively simple instance

    Cons: The instance is less obvious than the TH definition. Also, whenever you ask a SO question about Storable vectors, someone will inevitably ask why you aren't using Unboxed vectors, though no one seems to know why Unboxed vectors are better.

    For a data:

    {-# LANGUAGE ScopedTypeVariables #-}
    
    import Control.Monad
    import Data.Vector.Storable
    import Foreign.Storable
    
    import GHC.Ptr
    import GHC.Int
    
    -- defined in HsBaseConfig.h as 
    -- #define HTYPE_INT Int32
    type HTYPE_INT = Int32
    
    data Cell = Open | Blocked deriving (Show)
    
    instance Storable Cell where
     sizeOf _          = sizeOf (undefined::HTYPE_INT)
     alignment _       = alignment (undefined::HTYPE_INT)
     peekElemOff p i   = liftM (\x -> case x of 
                            (0::HTYPE_INT) -> Blocked
                            otherwise -> Open) $ peekElemOff (castPtr p) i
     pokeElemOff p i x = pokeElemOff (castPtr p) i $ case x of
        Blocked -> 0
        Open -> (1 :: HTYPE_INT)
    
    main = print $ show $ singleton Open
    

    Or for a newtype:

    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    
    import Data.Vector.Storable as S
    import Foreign.Storable
    
    newtype Cell = IsOpen Bool deriving (Show)
    
    main = print $ show $ S.singleton (Foo True)
    
  4. Unbox instances for newtype

    This doesn't directly apply to your question since you don't have a newtype, but I'll include it for completeness.

    Pros: No TH, no code to write, still using Unboxed vectors for the haters

    Cons: None?

    {-# LANGUAGE GeneralizedNewtypeDeriving, 
                 StandaloneDeriving, 
                 MultiParamTypeClasses #-}
    
    import Data.Vector.Generic as V
    import Data.Vector.Generic.Mutable as M
    import Data.Vector.Unboxed as U
    
    newtype Cell = IsOpen Bool deriving (Unbox, Show)
    deriving instance V.Vector U.Vector Cell
    deriving instance M.MVector U.MVector Cell
    
    main = print $ show $ U.singleton (IsOpen True)
    

    EDIT

    Note that this solution currently isn't possible in GHC 7.8.

Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top