{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE MagicHash                  #-}
{-# LANGUAGE NoImplicitPrelude          #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE CPP                        #-}
module Basement.Alg.String
    ( copyFilter
    , validate
    , findIndexPredicate
    , revFindIndexPredicate
    ) where

import           GHC.Prim
import           GHC.ST
import           Basement.Alg.Class
import           Basement.Alg.UTF8
import           Basement.Compat.Base
import           Basement.Numerical.Additive
import           Basement.Types.OffsetSize
import           Basement.PrimType
import           Basement.Block (MutableBlock(..))

import           Basement.UTF8.Helper
import           Basement.UTF8.Table
import           Basement.UTF8.Types

copyFilter :: forall s container . Indexable container Word8
           => (Char -> Bool)
           -> CountOf Word8
           -> MutableByteArray# s
           -> container
           -> Offset Word8
           -> ST s (CountOf Word8)
copyFilter :: forall s container.
Indexable container Word8 =>
(Char -> Bool)
-> CountOf Word8
-> MutableByteArray# s
-> container
-> Offset Word8
-> ST s (CountOf Word8)
copyFilter Char -> Bool
predicate !CountOf Word8
sz MutableByteArray# s
dst container
src Offset Word8
start = Offset Word8 -> Offset Word8 -> ST s (CountOf Word8)
loop (forall ty. Int -> Offset ty
Offset Int
0) Offset Word8
start
  where
    !end :: Offset Word8
end = Offset Word8
start forall ty. Offset ty -> CountOf ty -> Offset ty
`offsetPlusE` CountOf Word8
sz
    loop :: Offset Word8 -> Offset Word8 -> ST s (CountOf Word8)
loop !Offset Word8
d !Offset Word8
s
        | Offset Word8
s forall a. Eq a => a -> a -> Bool
== Offset Word8
end  = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Offset a -> CountOf a
offsetAsSize Offset Word8
d)
        | Bool
otherwise =
            let !h :: StepASCII
h = forall container.
Indexable container Word8 =>
container -> Offset Word8 -> StepASCII
nextAscii container
src Offset Word8
s
             in case StepASCII -> Bool
headerIsAscii StepASCII
h of
                    Bool
True | Char -> Bool
predicate (StepASCII -> Char
toChar1 StepASCII
h) -> forall ty (prim :: * -> *).
(PrimType ty, PrimMonad prim) =>
MutableByteArray# (PrimState prim) -> Offset ty -> ty -> prim ()
primMbaWrite MutableByteArray# s
dst Offset Word8
d (StepASCII -> Word8
stepAsciiRawValue StepASCII
h) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Offset Word8 -> Offset Word8 -> ST s (CountOf Word8)
loop (Offset Word8
d forall a. Additive a => a -> a -> a
+ forall ty. Int -> Offset ty
Offset Int
1) (Offset Word8
s forall a. Additive a => a -> a -> a
+ forall ty. Int -> Offset ty
Offset Int
1)
                         | Bool
otherwise             -> Offset Word8 -> Offset Word8 -> ST s (CountOf Word8)
loop Offset Word8
d (Offset Word8
s forall a. Additive a => a -> a -> a
+ forall ty. Int -> Offset ty
Offset Int
1)
                    Bool
False ->
                        case forall container.
Indexable container Word8 =>
container -> Offset Word8 -> Step
next container
src Offset Word8
s of
                            Step Char
c Offset Word8
s' | Char -> Bool
predicate Char
c -> forall (prim :: * -> *) container.
(PrimMonad prim, RandomAccess container prim Word8) =>
container -> Offset Word8 -> Char -> prim (Offset Word8)
writeUTF8 (forall ty st. MutableByteArray# st -> MutableBlock ty st
MutableBlock MutableByteArray# s
dst :: MutableBlock Word8 s) Offset Word8
d Char
c forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Offset Word8
d' -> Offset Word8 -> Offset Word8 -> ST s (CountOf Word8)
loop Offset Word8
d' Offset Word8
s'
                                      | Bool
otherwise   -> Offset Word8 -> Offset Word8 -> ST s (CountOf Word8)
loop Offset Word8
d Offset Word8
s'
{-# INLINE copyFilter #-}

validate :: Indexable container Word8
         => Offset Word8
         -> container
         -> Offset Word8
         -> (Offset Word8, Maybe ValidationFailure)
validate :: forall container.
Indexable container Word8 =>
Offset Word8
-> container
-> Offset Word8
-> (Offset Word8, Maybe ValidationFailure)
validate Offset Word8
end container
ba Offset Word8
ofsStart = Offset Word8 -> (Offset Word8, Maybe ValidationFailure)
loop4 Offset Word8
ofsStart
  where
    loop4 :: Offset Word8 -> (Offset Word8, Maybe ValidationFailure)
loop4 !Offset Word8
ofs
        | Offset Word8
ofs4 forall a. Ord a => a -> a -> Bool
< Offset Word8
end =
            let h1 :: StepASCII
h1 = forall container.
Indexable container Word8 =>
container -> Offset Word8 -> StepASCII
nextAscii container
ba Offset Word8
ofs
                h2 :: StepASCII
h2 = forall container.
Indexable container Word8 =>
container -> Offset Word8 -> StepASCII
nextAscii container
ba (Offset Word8
ofsforall a. Additive a => a -> a -> a
+Offset Word8
1)
                h3 :: StepASCII
h3 = forall container.
Indexable container Word8 =>
container -> Offset Word8 -> StepASCII
nextAscii container
ba (Offset Word8
ofsforall a. Additive a => a -> a -> a
+Offset Word8
2)
                h4 :: StepASCII
h4 = forall container.
Indexable container Word8 =>
container -> Offset Word8 -> StepASCII
nextAscii container
ba (Offset Word8
ofsforall a. Additive a => a -> a -> a
+Offset Word8
3)
             in if StepASCII -> Bool
headerIsAscii StepASCII
h1 Bool -> Bool -> Bool
&& StepASCII -> Bool
headerIsAscii StepASCII
h2 Bool -> Bool -> Bool
&& StepASCII -> Bool
headerIsAscii StepASCII
h3 Bool -> Bool -> Bool
&& StepASCII -> Bool
headerIsAscii StepASCII
h4
                    then Offset Word8 -> (Offset Word8, Maybe ValidationFailure)
loop4 Offset Word8
ofs4
                    else Offset Word8 -> (Offset Word8, Maybe ValidationFailure)
loop Offset Word8
ofs
        | Bool
otherwise     = Offset Word8 -> (Offset Word8, Maybe ValidationFailure)
loop Offset Word8
ofs
      where
        !ofs4 :: Offset Word8
ofs4 = Offset Word8
ofsforall a. Additive a => a -> a -> a
+Offset Word8
4
    loop :: Offset Word8 -> (Offset Word8, Maybe ValidationFailure)
loop !Offset Word8
ofs
        | Offset Word8
ofs forall a. Eq a => a -> a -> Bool
== Offset Word8
end      = (Offset Word8
end, forall a. Maybe a
Nothing)
        | StepASCII -> Bool
headerIsAscii StepASCII
h = Offset Word8 -> (Offset Word8, Maybe ValidationFailure)
loop (Offset Word8
ofs forall a. Additive a => a -> a -> a
+ forall ty. Int -> Offset ty
Offset Int
1)
        | Bool
otherwise       = CountOf Word8
-> Offset Word8 -> (Offset Word8, Maybe ValidationFailure)
multi (forall ty. Int -> CountOf ty
CountOf forall a b. (a -> b) -> a -> b
$ StepASCII -> Int
getNbBytes StepASCII
h) Offset Word8
ofs
      where
        h :: StepASCII
h = forall container.
Indexable container Word8 =>
container -> Offset Word8 -> StepASCII
nextAscii container
ba Offset Word8
ofs

    multi :: CountOf Word8
-> Offset Word8 -> (Offset Word8, Maybe ValidationFailure)
multi (CountOf Int
0xff) Offset Word8
pos = (Offset Word8
pos, forall a. a -> Maybe a
Just ValidationFailure
InvalidHeader)
    multi CountOf Word8
nbConts Offset Word8
pos
        | (Offset Word8
posNext forall ty. Offset ty -> CountOf ty -> Offset ty
`offsetPlusE` CountOf Word8
nbConts) forall a. Ord a => a -> a -> Bool
> Offset Word8
end = (Offset Word8
pos, forall a. a -> Maybe a
Just ValidationFailure
MissingByte)
        | Bool
otherwise =
            case CountOf Word8
nbConts of
                CountOf Int
1 ->
                    let c1 :: Word8
c1 = forall container ty.
Indexable container ty =>
container -> Offset ty -> ty
index container
ba Offset Word8
posNext
                    in if Word8 -> Bool
isContinuation Word8
c1
                        then Offset Word8 -> (Offset Word8, Maybe ValidationFailure)
loop (Offset Word8
pos forall a. Additive a => a -> a -> a
+ forall ty. Int -> Offset ty
Offset Int
2)
                        else (Offset Word8
pos, forall a. a -> Maybe a
Just ValidationFailure
InvalidContinuation)
                CountOf Int
2 ->
                    let c1 :: Word8
c1 = forall container ty.
Indexable container ty =>
container -> Offset ty -> ty
index container
ba Offset Word8
posNext
                        c2 :: Word8
c2 = forall container ty.
Indexable container ty =>
container -> Offset ty -> ty
index container
ba (Offset Word8
pos forall a. Additive a => a -> a -> a
+ forall ty. Int -> Offset ty
Offset Int
2)
                     in if Word8 -> Word8 -> Bool
isContinuation2 Word8
c1 Word8
c2
                            then Offset Word8 -> (Offset Word8, Maybe ValidationFailure)
loop (Offset Word8
pos forall a. Additive a => a -> a -> a
+ forall ty. Int -> Offset ty
Offset Int
3)
                            else (Offset Word8
pos, forall a. a -> Maybe a
Just ValidationFailure
InvalidContinuation)
                CountOf Int
_ ->
                    let c1 :: Word8
c1 = forall container ty.
Indexable container ty =>
container -> Offset ty -> ty
index container
ba Offset Word8
posNext
                        c2 :: Word8
c2 = forall container ty.
Indexable container ty =>
container -> Offset ty -> ty
index container
ba (Offset Word8
pos forall a. Additive a => a -> a -> a
+ forall ty. Int -> Offset ty
Offset Int
2)
                        c3 :: Word8
c3 = forall container ty.
Indexable container ty =>
container -> Offset ty -> ty
index container
ba (Offset Word8
pos forall a. Additive a => a -> a -> a
+ forall ty. Int -> Offset ty
Offset Int
3)
                     in if Word8 -> Word8 -> Word8 -> Bool
isContinuation3 Word8
c1 Word8
c2 Word8
c3
                            then Offset Word8 -> (Offset Word8, Maybe ValidationFailure)
loop (Offset Word8
pos forall a. Additive a => a -> a -> a
+ forall ty. Int -> Offset ty
Offset Int
4)
                            else (Offset Word8
pos, forall a. a -> Maybe a
Just ValidationFailure
InvalidContinuation)
      where posNext :: Offset Word8
posNext = Offset Word8
pos forall a. Additive a => a -> a -> a
+ forall ty. Int -> Offset ty
Offset Int
1
{-# INLINE validate #-}

findIndexPredicate :: Indexable container Word8
                   => (Char -> Bool)
                   -> container
                   -> Offset Word8
                   -> Offset Word8
                   -> Offset Word8
findIndexPredicate :: forall container.
Indexable container Word8 =>
(Char -> Bool)
-> container -> Offset Word8 -> Offset Word8 -> Offset Word8
findIndexPredicate Char -> Bool
predicate container
ba !Offset Word8
startIndex !Offset Word8
endIndex = Offset Word8 -> Offset Word8
loop Offset Word8
startIndex
  where
    loop :: Offset Word8 -> Offset Word8
loop !Offset Word8
i
        | Offset Word8
i forall a. Ord a => a -> a -> Bool
< Offset Word8
endIndex Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
predicate Char
c) = Offset Word8 -> Offset Word8
loop (Offset Word8
i')
        | Bool
otherwise                         = Offset Word8
i
      where
        Step Char
c Offset Word8
i' = forall container.
Indexable container Word8 =>
container -> Offset Word8 -> Step
next container
ba Offset Word8
i
{-# INLINE findIndexPredicate #-}

revFindIndexPredicate :: Indexable container Word8
                      => (Char -> Bool)
                      -> container
                      -> Offset Word8
                      -> Offset Word8
                      -> Offset Word8
revFindIndexPredicate :: forall container.
Indexable container Word8 =>
(Char -> Bool)
-> container -> Offset Word8 -> Offset Word8 -> Offset Word8
revFindIndexPredicate Char -> Bool
predicate container
ba Offset Word8
startIndex Offset Word8
endIndex
    | Offset Word8
endIndex forall a. Ord a => a -> a -> Bool
> Offset Word8
startIndex = Offset Word8 -> Offset Word8
loop Offset Word8
endIndex
    | Bool
otherwise             = Offset Word8
endIndex
  where
    loop :: Offset Word8 -> Offset Word8
loop !Offset Word8
i
        | Char -> Bool
predicate Char
c     = Offset Word8
i'
        | Offset Word8
i' forall a. Ord a => a -> a -> Bool
> Offset Word8
startIndex = Offset Word8 -> Offset Word8
loop Offset Word8
i'
        | Bool
otherwise       = Offset Word8
endIndex
      where 
        StepBack Char
c Offset Word8
i' = forall container.
Indexable container Word8 =>
container -> Offset Word8 -> StepBack
prev container
ba Offset Word8
i
{-# INLINE revFindIndexPredicate #-}