module Raaz.Core.Types.Tuple
(
Tuple, Dimension, dimension, initial, diagonal
, repeatM
, 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, Ptr )
import Foreign.Storable ( Storable(..) )
import Prelude hiding ( length )
import Raaz.Core.Types.Equality
import Raaz.Core.Types.Endian
import Raaz.Core.Transfer
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)
type Dimension (dim :: Nat) = KnownNat dim
dimension :: Dimension dim => Tuple dim a -> Int
dimensionP :: Dimension dim
=> Proxy dim
-> Tuple dim a
-> Int
dimensionP sz _ = fromEnum $ natVal sz
dimension = dimensionP Proxy
#else
type Dimension (dim :: Nat) = SingI dim
dimension :: (V.Unbox a, Dimension dim) => Tuple dim a -> Int
dimensionP :: (Dimension dim, V.Unbox a)
=> Sing dim
-> Tuple dim a
-> Int
dimension = withSing dimensionP
dimensionP sz _ = fromEnum $ fromSing sz
#endif
getParseDimension :: (V.Unbox a, Dimension dim)
=> Parser (Tuple dim a) -> Int
getTupFromP :: (V.Unbox a, Dimension dim)
=> Parser (Tuple dim a) -> Tuple dim a
getParseDimension = dimension . getTupFromP
getTupFromP _ = undefined
instance (V.Unbox a, Storable a, Dimension dim)
=> Storable (Tuple dim a) where
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
instance (V.Unbox a, EndianStore a, Dimension dim)
=> EndianStore (Tuple dim a) where
load = unsafeRunParser tupParser . castPtr
where tupParser = Tuple <$> unsafeParseVector len
len = getParseDimension tupParser
store ptr tup = unsafeWrite writeTup cptr
where writeTup = writeVector $ unTuple tup
cptr = castPtr ptr
adjustEndian ptr n = adjustEndian (unTupPtr ptr) $ nos ptr undefined
where nos :: Ptr (Tuple dim a) -> Tuple dim a -> Int
nos _ w = dimension w * n
unTupPtr :: Ptr (Tuple dim a) -> Ptr a
unTupPtr = castPtr
repeatM :: (Functor m, Monad m, V.Unbox a, Dimension dim) => m a -> m (Tuple dim a)
repeatM action = result
where result = Tuple <$> V.replicateM sz action
sz = dimension $ getTup result
getTup :: (Monad m, Dimension n)=> m (Tuple n a) -> Tuple n a
getTup _ = undefined
unsafeFromList :: (V.Unbox a, Dimension dim) => [a] -> Tuple dim a
unsafeFromList xs
| dimension tup == L.length xs = tup
| otherwise = wrongLengthMesg
where tup = Tuple $ V.fromList xs
wrongLengthMesg = error "tuple: unsafeFromList: wrong length"
initial :: (V.Unbox a, Dimension dim0)
=> Tuple dim1 a
-> Tuple dim0 a
initial tup = tup0
where tup0 = Tuple $ V.take (dimension tup0) $ unTuple tup
diagonal :: (V.Unbox a, Dimension dim) => a -> Tuple dim a
diagonal a = tup
where tup = Tuple $ V.replicate (dimension tup) a