{-# 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 #-}