{-# OPTIONS_GHC -Wall -fwarn-tabs #-}
------------------------------------------------------------
--                                              ~ 2021.11.07
-- |
-- Module      :  Data.Trie.ByteStringInternal
-- Copyright   :  Copyright (c) 2008--2021 wren gayle romano
-- License     :  BSD3
-- Maintainer  :  wren@cpan.org
-- Stability   :  experimental
-- Portability :  GHC-only
--
-- Helper functions on 'ByteString's for "Data.Trie.Internal".
------------------------------------------------------------

module Data.Trie.ByteStringInternal
    ( ByteString, ByteStringElem
    , breakMaximalPrefix
    ) where

import qualified Data.ByteString as S
import Data.ByteString.Internal (ByteString(PS))
import Data.Word
import Foreign.ForeignPtr       (ForeignPtr, withForeignPtr)
import Foreign.Ptr              (Ptr, plusPtr)
import Foreign.Storable         (Storable(..))
-- This module name is since @__GLASGOW_HASKELL__ >= 611@.
import GHC.IO                   (unsafeDupablePerformIO)

------------------------------------------------------------
-- | Associated type of 'ByteString'
type ByteStringElem = Word8


------------------------------------------------------------
-- | Returns the longest shared prefix and the two remaining suffixes
-- for a pair of strings.
--
-- >    s == (\(pre,s',z') -> pre `append` s') (breakMaximalPrefix s z)
-- >    z == (\(pre,s',z') -> pre `append` z') (breakMaximalPrefix s z)
breakMaximalPrefix
    :: ByteString
    -> ByteString
    -> (ByteString, ByteString, ByteString)
breakMaximalPrefix :: ByteString -> ByteString -> (ByteString, ByteString, ByteString)
breakMaximalPrefix
    str1 :: ByteString
str1@(PS ForeignPtr Word8
s1 Int
off1 Int
len1)
    str2 :: ByteString
str2@(PS ForeignPtr Word8
s2 Int
off2 Int
len2)
    | Int
len1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = (ByteString
S.empty, ByteString
S.empty, ByteString
str2)
    | Int
len2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = (ByteString
S.empty, ByteString
str1, ByteString
S.empty)
    | Bool
otherwise = IO (ByteString, ByteString, ByteString)
-> (ByteString, ByteString, ByteString)
forall a. IO a -> a
unsafeDupablePerformIO (IO (ByteString, ByteString, ByteString)
 -> (ByteString, ByteString, ByteString))
-> IO (ByteString, ByteString, ByteString)
-> (ByteString, ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$
        ForeignPtr Word8
-> (Ptr Word8 -> IO (ByteString, ByteString, ByteString))
-> IO (ByteString, ByteString, ByteString)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
s1 ((Ptr Word8 -> IO (ByteString, ByteString, ByteString))
 -> IO (ByteString, ByteString, ByteString))
-> (Ptr Word8 -> IO (ByteString, ByteString, ByteString))
-> IO (ByteString, ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p1 ->
        ForeignPtr Word8
-> (Ptr Word8 -> IO (ByteString, ByteString, ByteString))
-> IO (ByteString, ByteString, ByteString)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
s2 ((Ptr Word8 -> IO (ByteString, ByteString, ByteString))
 -> IO (ByteString, ByteString, ByteString))
-> (Ptr Word8 -> IO (ByteString, ByteString, ByteString))
-> IO (ByteString, ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p2 -> do
            Int
i <- Ptr Word8 -> Ptr Word8 -> Int -> IO Int
indexOfDifference
                    (Ptr Word8
p1 Ptr Word8 -> Int -> Ptr Word8
forall a. Storable a => Ptr a -> Int -> Ptr a
`ptrElemOff` Int
off1)
                    (Ptr Word8
p2 Ptr Word8 -> Int -> Ptr Word8
forall a. Storable a => Ptr a -> Int -> Ptr a
`ptrElemOff` Int
off2)
                    (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
len1 Int
len2)
            let pre :: ByteString
pre = if Int
off1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
off2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len2  -- share the smaller one
                      then ForeignPtr Word8 -> Int -> Int -> ByteString
newPS ForeignPtr Word8
s1 Int
off1 Int
i
                      else ForeignPtr Word8 -> Int -> Int -> ByteString
newPS ForeignPtr Word8
s2 Int
off2 Int
i
            let s1' :: ByteString
s1' = ForeignPtr Word8 -> Int -> Int -> ByteString
newPS ForeignPtr Word8
s1 (Int
off1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i) (Int
len1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i)
            let s2' :: ByteString
s2' = ForeignPtr Word8 -> Int -> Int -> ByteString
newPS ForeignPtr Word8
s2 (Int
off2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i) (Int
len2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i)

            (ByteString, ByteString, ByteString)
-> IO (ByteString, ByteString, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ByteString, ByteString, ByteString)
 -> IO (ByteString, ByteString, ByteString))
-> (ByteString, ByteString, ByteString)
-> IO (ByteString, ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$! (,,) (ByteString
 -> ByteString
 -> ByteString
 -> (ByteString, ByteString, ByteString))
-> ByteString
-> ByteString
-> ByteString
-> (ByteString, ByteString, ByteString)
forall a b. (a -> b) -> a -> b
!$ ByteString
pre (ByteString -> ByteString -> (ByteString, ByteString, ByteString))
-> ByteString -> ByteString -> (ByteString, ByteString, ByteString)
forall a b. (a -> b) -> a -> b
!$ ByteString
s1' (ByteString -> (ByteString, ByteString, ByteString))
-> ByteString -> (ByteString, ByteString, ByteString)
forall a b. (a -> b) -> a -> b
!$ ByteString
s2'

-- | Get the 'sizeOf' type @a@, without requiring @-XScopedTypeVariables@
-- nor making a spurious call to 'System.IO.Unsafe.unsafePerformIO' or similar.
sizeOfPtr :: Storable a => Ptr a -> Int
sizeOfPtr :: Ptr a -> Int
sizeOfPtr = a -> Int
forall a. Storable a => a -> Int
sizeOf (a -> Int) -> (Ptr a -> a) -> Ptr a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Ptr a -> a
forall a. HasCallStack => a
undefined :: Ptr a -> a)
{-# INLINE sizeOfPtr #-}

-- | C-style pointer addition, without the excessively liberal type
-- of 'plusPtr'.
ptrElemOff :: Storable a => Ptr a -> Int -> Ptr a
ptrElemOff :: Ptr a -> Int -> Ptr a
ptrElemOff Ptr a
p Int
i = Ptr a
p Ptr a -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Ptr a -> Int
forall a. Storable a => Ptr a -> Int
sizeOfPtr Ptr a
p)
{-# INLINE ptrElemOff #-}

-- | Smart-constructor to share 'S.empty' as appropriate.
newPS :: ForeignPtr ByteStringElem -> Int -> Int -> ByteString
newPS :: ForeignPtr Word8 -> Int -> Int -> ByteString
newPS ForeignPtr Word8
s Int
o Int
l = if Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 then ByteString
S.empty else ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
s Int
o Int
l
{-# INLINE newPS #-}

-- | fix associativity bug
(!$) :: (a -> b) -> a -> b
!$ :: (a -> b) -> a -> b
(!$)  = (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
($!)
{-# INLINE (!$) #-}


------------------------------------------------------------
-- This naive algorithm doesn't depend on architecture details.  We
-- could speed things up (in theory) by checking a natural word at
-- a time and then falling back to checking each byte once the
-- mismatched word is found.  But in practice that doesn't seem to
-- actually speed things up.
--
-- | Calculates the first index where values differ.
indexOfDifference
    :: Ptr ByteStringElem
    -> Ptr ByteStringElem
    -> Int
    -> IO Int
indexOfDifference :: Ptr Word8 -> Ptr Word8 -> Int -> IO Int
indexOfDifference Ptr Word8
p1 Ptr Word8
p2 Int
limit = Int -> IO Int
goByte Int
0
    where
    goByte :: Int -> IO Int
goByte Int
n =
        if   Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
limit
        then Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
limit
        else do Word8
c1 <- Ptr Word8 -> Int -> IO Word8
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
p1 Int
n
                Word8
c2 <- Ptr Word8 -> Int -> IO Word8
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
p2 Int
n
                if Word8
c1 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
c2
                    then Int -> IO Int
goByte (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$! Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1
                    else Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n

------------------------------------------------------------
------------------------------------------------------- fin.