{-# 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 :: (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 (Int -> Offset Word8 forall ty. Int -> Offset ty Offset Int 0) Offset Word8 start where !end :: Offset Word8 end = Offset Word8 start Offset Word8 -> CountOf Word8 -> Offset Word8 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 Offset Word8 -> Offset Word8 -> Bool forall a. Eq a => a -> a -> Bool == Offset Word8 end = CountOf Word8 -> ST s (CountOf Word8) forall (f :: * -> *) a. Applicative f => a -> f a pure (Offset Word8 -> CountOf Word8 forall a. Offset a -> CountOf a offsetAsSize Offset Word8 d) | Bool otherwise = let !h :: StepASCII h = container -> Offset Word8 -> StepASCII 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) -> MutableByteArray# (PrimState (ST s)) -> Offset Word8 -> Word8 -> ST s () forall ty (prim :: * -> *). (PrimType ty, PrimMonad prim) => MutableByteArray# (PrimState prim) -> Offset ty -> ty -> prim () primMbaWrite MutableByteArray# s MutableByteArray# (PrimState (ST s)) dst Offset Word8 d (StepASCII -> Word8 stepAsciiRawValue StepASCII h) ST s () -> ST s (CountOf Word8) -> ST s (CountOf Word8) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> Offset Word8 -> Offset Word8 -> ST s (CountOf Word8) loop (Offset Word8 d Offset Word8 -> Offset Word8 -> Offset Word8 forall a. Additive a => a -> a -> a + Int -> Offset Word8 forall ty. Int -> Offset ty Offset Int 1) (Offset Word8 s Offset Word8 -> Offset Word8 -> Offset Word8 forall a. Additive a => a -> a -> a + Int -> Offset Word8 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 Offset Word8 -> Offset Word8 -> Offset Word8 forall a. Additive a => a -> a -> a + Int -> Offset Word8 forall ty. Int -> Offset ty Offset Int 1) Bool False -> case container -> Offset Word8 -> Step 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 -> MutableBlock Word8 s -> Offset Word8 -> Char -> ST s (Offset Word8) forall (prim :: * -> *) container. (PrimMonad prim, RandomAccess container prim Word8) => container -> Offset Word8 -> Char -> prim (Offset Word8) writeUTF8 (MutableByteArray# s -> MutableBlock Word8 s forall ty st. MutableByteArray# st -> MutableBlock ty st MutableBlock MutableByteArray# s dst :: MutableBlock Word8 s) Offset Word8 d Char c ST s (Offset Word8) -> (Offset Word8 -> ST s (CountOf Word8)) -> ST s (CountOf Word8) 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 :: 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 Offset Word8 -> Offset Word8 -> Bool forall a. Ord a => a -> a -> Bool < Offset Word8 end = let h1 :: StepASCII h1 = container -> Offset Word8 -> StepASCII forall container. Indexable container Word8 => container -> Offset Word8 -> StepASCII nextAscii container ba Offset Word8 ofs h2 :: StepASCII h2 = container -> Offset Word8 -> StepASCII forall container. Indexable container Word8 => container -> Offset Word8 -> StepASCII nextAscii container ba (Offset Word8 ofsOffset Word8 -> Offset Word8 -> Offset Word8 forall a. Additive a => a -> a -> a +Offset Word8 1) h3 :: StepASCII h3 = container -> Offset Word8 -> StepASCII forall container. Indexable container Word8 => container -> Offset Word8 -> StepASCII nextAscii container ba (Offset Word8 ofsOffset Word8 -> Offset Word8 -> Offset Word8 forall a. Additive a => a -> a -> a +Offset Word8 2) h4 :: StepASCII h4 = container -> Offset Word8 -> StepASCII forall container. Indexable container Word8 => container -> Offset Word8 -> StepASCII nextAscii container ba (Offset Word8 ofsOffset Word8 -> Offset Word8 -> Offset Word8 forall 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 ofsOffset Word8 -> Offset Word8 -> Offset Word8 forall a. Additive a => a -> a -> a +Offset Word8 4 loop :: Offset Word8 -> (Offset Word8, Maybe ValidationFailure) loop !Offset Word8 ofs | Offset Word8 ofs Offset Word8 -> Offset Word8 -> Bool forall a. Eq a => a -> a -> Bool == Offset Word8 end = (Offset Word8 end, Maybe ValidationFailure forall a. Maybe a Nothing) | StepASCII -> Bool headerIsAscii StepASCII h = Offset Word8 -> (Offset Word8, Maybe ValidationFailure) loop (Offset Word8 ofs Offset Word8 -> Offset Word8 -> Offset Word8 forall a. Additive a => a -> a -> a + Int -> Offset Word8 forall ty. Int -> Offset ty Offset Int 1) | Bool otherwise = CountOf Word8 -> Offset Word8 -> (Offset Word8, Maybe ValidationFailure) multi (Int -> CountOf Word8 forall ty. Int -> CountOf ty CountOf (Int -> CountOf Word8) -> Int -> CountOf Word8 forall a b. (a -> b) -> a -> b $ StepASCII -> Int getNbBytes StepASCII h) Offset Word8 ofs where h :: StepASCII h = container -> Offset Word8 -> StepASCII 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, ValidationFailure -> Maybe ValidationFailure forall a. a -> Maybe a Just ValidationFailure InvalidHeader) multi CountOf Word8 nbConts Offset Word8 pos | (Offset Word8 posNext Offset Word8 -> CountOf Word8 -> Offset Word8 forall ty. Offset ty -> CountOf ty -> Offset ty `offsetPlusE` CountOf Word8 nbConts) Offset Word8 -> Offset Word8 -> Bool forall a. Ord a => a -> a -> Bool > Offset Word8 end = (Offset Word8 pos, ValidationFailure -> Maybe ValidationFailure forall a. a -> Maybe a Just ValidationFailure MissingByte) | Bool otherwise = case CountOf Word8 nbConts of CountOf Int 1 -> let c1 :: Word8 c1 = container -> Offset Word8 -> Word8 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 Offset Word8 -> Offset Word8 -> Offset Word8 forall a. Additive a => a -> a -> a + Int -> Offset Word8 forall ty. Int -> Offset ty Offset Int 2) else (Offset Word8 pos, ValidationFailure -> Maybe ValidationFailure forall a. a -> Maybe a Just ValidationFailure InvalidContinuation) CountOf Int 2 -> let c1 :: Word8 c1 = container -> Offset Word8 -> Word8 forall container ty. Indexable container ty => container -> Offset ty -> ty index container ba Offset Word8 posNext c2 :: Word8 c2 = container -> Offset Word8 -> Word8 forall container ty. Indexable container ty => container -> Offset ty -> ty index container ba (Offset Word8 pos Offset Word8 -> Offset Word8 -> Offset Word8 forall a. Additive a => a -> a -> a + Int -> Offset Word8 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 Offset Word8 -> Offset Word8 -> Offset Word8 forall a. Additive a => a -> a -> a + Int -> Offset Word8 forall ty. Int -> Offset ty Offset Int 3) else (Offset Word8 pos, ValidationFailure -> Maybe ValidationFailure forall a. a -> Maybe a Just ValidationFailure InvalidContinuation) CountOf Int _ -> let c1 :: Word8 c1 = container -> Offset Word8 -> Word8 forall container ty. Indexable container ty => container -> Offset ty -> ty index container ba Offset Word8 posNext c2 :: Word8 c2 = container -> Offset Word8 -> Word8 forall container ty. Indexable container ty => container -> Offset ty -> ty index container ba (Offset Word8 pos Offset Word8 -> Offset Word8 -> Offset Word8 forall a. Additive a => a -> a -> a + Int -> Offset Word8 forall ty. Int -> Offset ty Offset Int 2) c3 :: Word8 c3 = container -> Offset Word8 -> Word8 forall container ty. Indexable container ty => container -> Offset ty -> ty index container ba (Offset Word8 pos Offset Word8 -> Offset Word8 -> Offset Word8 forall a. Additive a => a -> a -> a + Int -> Offset Word8 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 Offset Word8 -> Offset Word8 -> Offset Word8 forall a. Additive a => a -> a -> a + Int -> Offset Word8 forall ty. Int -> Offset ty Offset Int 4) else (Offset Word8 pos, ValidationFailure -> Maybe ValidationFailure forall a. a -> Maybe a Just ValidationFailure InvalidContinuation) where posNext :: Offset Word8 posNext = Offset Word8 pos Offset Word8 -> Offset Word8 -> Offset Word8 forall a. Additive a => a -> a -> a + Int -> Offset Word8 forall ty. Int -> Offset ty Offset Int 1 {-# INLINE validate #-} findIndexPredicate :: Indexable container Word8 => (Char -> Bool) -> container -> Offset Word8 -> Offset Word8 -> Offset Word8 findIndexPredicate :: (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 Offset Word8 -> Offset Word8 -> Bool 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' = container -> Offset Word8 -> Step 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 :: (Char -> Bool) -> container -> Offset Word8 -> Offset Word8 -> Offset Word8 revFindIndexPredicate Char -> Bool predicate container ba Offset Word8 startIndex Offset Word8 endIndex | Offset Word8 endIndex Offset Word8 -> Offset Word8 -> Bool 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' Offset Word8 -> Offset Word8 -> Bool 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' = container -> Offset Word8 -> StepBack forall container. Indexable container Word8 => container -> Offset Word8 -> StepBack prev container ba Offset Word8 i {-# INLINE revFindIndexPredicate #-}