{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DataKinds        #-}
{-# LANGUAGE MonoLocalBinds   #-}
{-# LANGUAGE CPP              #-}

-- |
--
-- Module      : Utils
-- Description : A utility module for primitives.
-- Copyright   : (c) Piyush P Kurur, 2019
-- License     : Apache-2.0 OR BSD-3-Clause
-- Maintainer  : Piyush P Kurur <ppk@iitpkd.ac.in>
-- Stability   : experimental
--

module Utils
       ( processByteSource
       , processBuffer
       , updateCxt
       , finaliseCxt
       , transform
       ) where

import Data.ByteString          as B
import Data.ByteString.Internal as IB
import GHC.TypeLits

import Raaz.Core

import Implementation
import Buffer
import Context

-- Warning: Not to be exposed Internal function for allocation.
allocaFor :: BlockCount Prim -> (BufferPtr -> IO a) -> IO a
allocaFor :: BlockCount Prim -> (BufferPtr -> IO a) -> IO a
allocaFor BlockCount Prim
blks = BlockCount Prim
-> (AlignedPtr BufferAlignment (Tuple 16 (LE Word32)) -> IO a)
-> IO a
forall l (ptr :: * -> *) something b.
(LengthUnit l, Pointer ptr) =>
l -> (ptr something -> IO b) -> IO b
allocaBuffer BlockCount Prim
totalSize
  where totalSize :: BlockCount Prim
totalSize = BlockCount Prim
blks BlockCount Prim -> BlockCount Prim -> BlockCount Prim
forall a. Monoid a => a -> a -> a
`mappend` BlockCount Prim
additionalBlocks

-- | Process the complete byte source using the internals of the
-- primitive.
processByteSource :: ByteSource src => src -> Internals -> IO ()
processByteSource :: src -> Internals -> IO ()
processByteSource src
src Internals
imem
  = BlockCount Prim -> (BufferPtr -> IO ()) -> IO ()
forall a. BlockCount Prim -> (BufferPtr -> IO a) -> IO a
allocaFor BlockCount Prim
blks ((BufferPtr -> IO ()) -> IO ()) -> (BufferPtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
    \ BufferPtr
ptr -> IO ()
-> (BYTES Int -> IO ())
-> src
-> AlignedPtr BufferAlignment (Tuple 16 (LE Word32))
-> BlockCount Prim
-> IO ()
forall (ptr :: * -> *) (m :: * -> *) chunkSize src a b something.
(Pointer ptr, MonadIO m, LengthUnit chunkSize, ByteSource src) =>
m a
-> (BYTES Int -> m b) -> src -> ptr something -> chunkSize -> m b
processChunks (BufferPtr -> BlockCount Prim -> Internals -> IO ()
processBlocks BufferPtr
ptr BlockCount Prim
blks Internals
imem)
             (\ BYTES Int
sz -> BufferPtr -> BYTES Int -> Internals -> IO ()
processLast BufferPtr
ptr BYTES Int
sz Internals
imem)
             src
src AlignedPtr BufferAlignment (Tuple 16 (LE Word32))
BufferPtr
ptr BlockCount Prim
blks
  where blks :: BlockCount Prim
blks       = BYTES Int -> BlockCount Prim
forall src dest. (LengthUnit src, LengthUnit dest) => src -> dest
atLeast BYTES Int
l1Cache :: BlockCount Prim

-- | Process the contents of the given buffer using the processBlocks action.
processBuffer :: KnownNat n
              => Buffer n
              -> Internals
              -> IO ()
processBuffer :: Buffer n -> Internals -> IO ()
processBuffer = (BufferPtr -> BlockCount Prim -> Internals -> IO ())
-> Buffer n -> Internals -> IO ()
forall (n :: Nat) a.
KnownNat n =>
(BufferPtr -> BlockCount Prim -> a) -> Buffer n -> a
withBufferPtr BufferPtr -> BlockCount Prim -> Internals -> IO ()
processBlocks

-- | Update the context with the data from the source. This will process
-- any complete blocks on the way so that
updateCxt :: (KnownNat n, ByteSource src)
          => src
          -> Cxt n
          -> IO ()
updateCxt :: src -> Cxt n -> IO ()
updateCxt  = (BufferPtr -> BlockCount Prim -> Internals -> IO ())
-> src -> Cxt n -> IO ()
forall (n :: Nat) src.
(KnownNat n, ByteSource src) =>
(BufferPtr -> BlockCount Prim -> Internals -> IO ())
-> src -> Cxt n -> IO ()
unsafeUpdate BufferPtr -> BlockCount Prim -> Internals -> IO ()
processBlocks


-- | Finalise the computation by making use of what ever data is left
-- in the buffer.
finaliseCxt :: KnownNat n
            => Cxt n
            -> IO ()
finaliseCxt :: Cxt n -> IO ()
finaliseCxt = (BufferPtr -> BYTES Int -> Internals -> IO ()) -> Cxt n -> IO ()
forall (n :: Nat).
KnownNat n =>
(BufferPtr -> BYTES Int -> Internals -> IO ()) -> Cxt n -> IO ()
unsafeFinalise BufferPtr -> BYTES Int -> Internals -> IO ()
processLast

-- | Transform the given bytestring. Hint: use this very rearely.
transform :: ByteString -> Internals -> IO ByteString
transform :: ByteString -> Internals -> IO ByteString
transform ByteString
bs Internals
imem
  = BlockCount Prim -> (BufferPtr -> IO ByteString) -> IO ByteString
forall a. BlockCount Prim -> (BufferPtr -> IO a) -> IO a
allocaFor BlockCount Prim
bufSz ((BufferPtr -> IO ByteString) -> IO ByteString)
-> (BufferPtr -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$
    \ BufferPtr
buf -> do ByteString
-> AlignedPtr BufferAlignment (Tuple 16 (LE Word32)) -> IO ()
forall (ptr :: * -> *) a.
Pointer ptr =>
ByteString -> ptr a -> IO ()
unsafeCopyToPointer ByteString
bs AlignedPtr BufferAlignment (Tuple 16 (LE Word32))
BufferPtr
buf -- Copy the input to buffer.
                BufferPtr -> BYTES Int -> Internals -> IO ()
processLast BufferPtr
buf BYTES Int
strSz Internals
imem
                Int -> (Ptr Word8 -> IO ()) -> IO ByteString
IB.create Int
sbytes ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$
                  \ Ptr Word8
ptr -> Dest (Ptr Word8)
-> Src (AlignedPtr BufferAlignment (Tuple 16 (LE Word32)))
-> BYTES Int
-> IO ()
forall l (ptrS :: * -> *) (ptrD :: * -> *) dest src.
(LengthUnit l, Pointer ptrS, Pointer ptrD) =>
Dest (ptrD dest) -> Src (ptrS src) -> l -> IO ()
Raaz.Core.memcpy (Ptr Word8 -> Dest (Ptr Word8)
forall a. a -> Dest a
destination Ptr Word8
ptr) (AlignedPtr BufferAlignment (Tuple 16 (LE Word32))
-> Src (AlignedPtr BufferAlignment (Tuple 16 (LE Word32)))
forall a. a -> Src a
source AlignedPtr BufferAlignment (Tuple 16 (LE Word32))
BufferPtr
buf) BYTES Int
strSz
  where strSz :: BYTES Int
strSz           = ByteString -> BYTES Int
Raaz.Core.length ByteString
bs
        sbytes  :: Int
        sbytes :: Int
sbytes  = BYTES Int -> Int
forall a. Enum a => a -> Int
fromEnum BYTES Int
strSz
        --
        -- Buffer size is at least the size of the input.
        --
        bufSz :: BlockCount Prim
bufSz           = BYTES Int -> BlockCount Prim
forall src dest. (LengthUnit src, LengthUnit dest) => src -> dest
atLeast BYTES Int
strSz