{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnliftedFFITypes #-}
{-# LANGUAGE NoImplicitPrelude #-}
#if defined(PURE_HASKELL)
{-# LANGUAGE BangPatterns #-}
#endif

{-# OPTIONS_HADDOCK not-home #-}

-- | Implements 'reverse', using efficient C routines by default.
module Data.Text.Internal.Reverse (reverse, reverseNonEmpty) where

#if !defined(PURE_HASKELL)
import GHC.Exts as Exts
import Control.Monad.ST.Unsafe (unsafeIOToST)
import Foreign.C.Types (CSize(..))
#else
import Control.Monad.ST (ST)
import Data.Text.Internal.Encoding.Utf8 (utf8LengthByLeader)
#endif
#if defined(ASSERTS)
import GHC.Stack (HasCallStack)
#endif
import Prelude hiding (reverse)
import Data.Text.Internal (Text(..), empty)
import Control.Monad.ST (runST)
import qualified Data.Text.Array as A

-- | /O(n)/ Reverse the characters of a string.
--
-- Example:
--
-- $setup
-- >>> T.reverse "desrever"
-- "reversed"
reverse ::
#if defined(ASSERTS)
  HasCallStack =>
#endif
  Text -> Text
reverse :: Text -> Text
reverse (Text Array
_ Int
_ Int
0) = Text
empty
reverse Text
t            = Text -> Text
reverseNonEmpty Text
t
{-# INLINE reverse #-}

-- | /O(n)/ Reverse the characters of a string.
-- Assume that the @Text@ is non-empty. The returned @Text@ is guaranteed to be non-empty.
reverseNonEmpty ::
  Text -> Text
#if defined(PURE_HASKELL)
reverseNonEmpty (Text src off len) = runST $ do
    dest <- A.new len
    _ <- reversePoints src off dest len
    result <- A.unsafeFreeze dest
    pure $ Text result 0 len

-- Step 0:
--
-- Input:  R E D R U M
--         ^
--         x
-- Output: _ _ _ _ _ _
--                     ^
--                     y
--
-- Step 1:
--
-- Input:  R E D R U M
--           ^
--           x
--
-- Output: _ _ _ _ _ R
--                   ^
--                   y
reversePoints
    :: A.Array -- ^ Input array
    -> Int -- ^ Input index
    -> A.MArray s -- ^ Output array
    -> Int -- ^ Output index
    -> ST s ()
reversePoints src xx dest yy = go xx yy where
    go !_ y | y <= 0 = pure ()
    go x y =
        let pLen = utf8LengthByLeader (A.unsafeIndex src x)
            -- The next y is also the start of the current point in the output
            yNext = y - pLen
        in do
            A.copyI pLen dest yNext src x
            go (x + pLen) yNext
#else
reverseNonEmpty :: Text -> Text
reverseNonEmpty (Text (A.ByteArray ByteArray#
ba) Int
off Int
len) = (forall s. ST s Text) -> Text
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Text) -> Text) -> (forall s. ST s Text) -> Text
forall a b. (a -> b) -> a -> b
$ do
    marr :: MArray s
marr@(A.MutableByteArray MutableByteArray# s
mba) <- Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
A.new Int
len
    IO () -> ST s ()
forall a s. IO a -> ST s a
unsafeIOToST (IO () -> ST s ()) -> IO () -> ST s ()
forall a b. (a -> b) -> a -> b
$ MutableByteArray# s -> ByteArray# -> CSize -> CSize -> IO ()
forall s.
MutableByteArray# s -> ByteArray# -> CSize -> CSize -> IO ()
c_reverse MutableByteArray# s
mba ByteArray#
ba (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
off) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
    Array
brr <- MArray s -> ST s Array
forall s. MArray s -> ST s Array
A.unsafeFreeze MArray s
marr
    Text -> ST s Text
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ST s Text) -> Text -> ST s Text
forall a b. (a -> b) -> a -> b
$ Array -> Int -> Int -> Text
Text Array
brr Int
0 Int
len
#endif
{-# INLINE reverseNonEmpty #-}

#if !defined(PURE_HASKELL)
-- | The input buffer (src :: ByteArray#, off :: CSize, len :: CSize)
-- must specify a valid UTF-8 sequence, this condition is not checked.
foreign import ccall unsafe "_hs_text_reverse" c_reverse
    :: Exts.MutableByteArray# s -> ByteArray# -> CSize -> CSize -> IO ()
#endif

-- $setup
-- >>> :set -XOverloadedStrings
-- >>> import qualified Data.Text.Internal.Reverse as T