module Raaz.Core.Types.Tuple
(
Tuple, dimension, initial
, unsafeFromList
) where
import Control.Applicative
import qualified Data.List as L
import Data.Monoid
#if MIN_VERSION_base(4,7,0)
import Data.Proxy
#endif
import qualified Data.Vector.Unboxed as V
import GHC.TypeLits
import Foreign.Ptr ( castPtr )
import Foreign.Storable ( Storable(..) )
import Prelude hiding ( length )
import Raaz.Core.Types.Equality
import Raaz.Core.Types.Endian
import Raaz.Core.Write
import Raaz.Core.Parse.Applicative
newtype Tuple (dim :: Nat) a = Tuple { unTuple :: V.Vector a }
deriving Show
instance (V.Unbox a, Equality a) => Equality (Tuple dim a) where
eq (Tuple u) (Tuple v) = V.foldl' mappend mempty $ V.zipWith eq u v
instance (V.Unbox a, Equality a) => Eq (Tuple dim a) where
(==) = (===)
getA :: Tuple dim a -> a
getA _ = undefined
#if !MIN_VERSION_base(4,7,0)
dimension :: (V.Unbox a, SingI dim) => Tuple dim a -> Int
dimensionP :: (SingI dim, V.Unbox a)
=> Sing dim
-> Tuple dim a
-> Int
dimension = withSing dimensionP
dimensionP sz _ = fromEnum $ fromSing sz
#else
dimension :: (V.Unbox a, KnownNat dim) => Tuple dim a -> Int
dimensionP :: (KnownNat dim, V.Unbox a)
=> Proxy dim
-> Tuple dim a
-> Int
dimensionP sz _ = fromEnum $ natVal sz
dimension = dimensionP Proxy
#endif
#if !MIN_VERSION_base(4,7,0)
getParseDimension :: (V.Unbox a, SingI dim)
=> Parser (Tuple dim a) -> Int
getTupFromP :: (V.Unbox a, SingI dim)
=> Parser (Tuple dim a) -> Tuple dim a
#else
getParseDimension :: (V.Unbox a, KnownNat dim)
=> Parser (Tuple dim a)
-> Int
getTupFromP :: (V.Unbox a, KnownNat dim)
=> Parser (Tuple dim a)
-> Tuple dim a
#endif
getParseDimension = dimension . getTupFromP
getTupFromP _ = undefined
#if !MIN_VERSION_base(4,7,0)
instance (V.Unbox a, Storable a, SingI dim)
=> Storable (Tuple dim a) where
#else
instance (V.Unbox a, Storable a, KnownNat dim)
=> Storable (Tuple dim a) where
#endif
sizeOf tup = dimension tup * sizeOf (getA tup)
alignment = alignment . getA
peek = unsafeRunParser tupParser . castPtr
where len = getParseDimension tupParser
tupParser = Tuple <$> unsafeParseStorableVector len
poke ptr tup = unsafeWrite writeTup cptr
where writeTup = writeStorableVector $ unTuple tup
cptr = castPtr ptr
#if !MIN_VERSION_base(4,7,0)
instance (V.Unbox a, EndianStore a, SingI dim)
=> EndianStore (Tuple dim a) where
#else
instance (V.Unbox a, EndianStore a, KnownNat dim)
=> EndianStore (Tuple dim a) where
#endif
load = unsafeRunParser $ tupParser
where tupParser = Tuple <$> unsafeParseVector len
len = getParseDimension tupParser
store cptr tup = unsafeWrite writeTup cptr
where writeTup = writeVector $ unTuple tup
#if !MIN_VERSION_base(4,7,0)
unsafeFromList :: (V.Unbox a, SingI dim) => [a] -> Tuple dim a
#else
unsafeFromList :: (V.Unbox a, KnownNat dim) => [a] -> Tuple dim a
#endif
unsafeFromList xs
| dimension tup == L.length xs = tup
| otherwise = wrongLengthMesg
where tup = Tuple $ V.fromList xs
wrongLengthMesg = error "tuple: unsafeFromList: wrong length"
#if !MIN_VERSION_base(4,7,0)
initial :: (V.Unbox a, SingI dim0, SingI dim1)
=> Tuple dim1 a
-> Tuple dim0 a
#else
initial :: (V.Unbox a, KnownNat dim0, KnownNat dim1)
=> Tuple dim1 a
-> Tuple dim0 a
#endif
initial tup = tup0
where tup0 = Tuple $ V.take (dimension tup0) $ unTuple tup