{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ViewPatterns #-}
module Data.Text.Manipulate.Internal.Fusion where
import qualified Data.Char as Char
import Data.Text (Text)
import qualified Data.Text.Internal.Fusion as Fusion
import Data.Text.Internal.Fusion.CaseMapping (lowerMapping, upperMapping)
import Data.Text.Internal.Fusion.Common
import Data.Text.Internal.Fusion.Types
import qualified Data.Text.Internal.Lazy.Fusion as LFusion
import qualified Data.Text.Lazy as LText
import Data.Text.Manipulate.Internal.Types
#if MIN_VERSION_text(2,0,0)
import Data.Bits (shiftL, shiftR, (.&.))
import GHC.Exts (Char(..), Int(..), chr#)
import GHC.Int (Int64(..))
#endif
takeWord :: Stream Char -> Stream Char
takeWord :: Stream Char -> Stream Char
takeWord = (forall s. s -> Step (CC s) Char)
-> (forall s. Char -> s -> Step (CC s) Char)
-> Stream Token
-> Stream Char
transform (forall a b. a -> b -> a
const forall s a. Step s a
Done) forall s. Char -> s -> Step (CC s) Char
yield forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream Char -> Stream Token
tokenise
{-# INLINE [0] takeWord #-}
dropWord :: Stream Char -> Stream Char
dropWord :: Stream Char -> Stream Char
dropWord (Stream Char -> Stream Token
tokenise -> Stream s -> Step s Token
next0 s
s0 Size
len) = forall a s. (s -> Step s a) -> s -> Size -> Stream a
Stream PairS Bool s -> Step (PairS Bool s) Char
next (Bool
True forall a b. a -> b -> PairS a b
:*: s
s0) Size
len
where
next :: PairS Bool s -> Step (PairS Bool s) Char
next (Bool
skip :*: s
s) =
case s -> Step s Token
next0 s
s of
Step s Token
Done -> forall s a. Step s a
Done
Skip s
s' -> forall s a. s -> Step s a
Skip (Bool
skip forall a b. a -> b -> PairS a b
:*: s
s')
Yield Token
t s
s' ->
case Token
t of
B Char
'\0' -> forall s a. s -> Step s a
Skip (Bool
False forall a b. a -> b -> PairS a b
:*: s
s')
B Char
_ | Bool
skip -> forall s a. s -> Step s a
Skip (Bool
False forall a b. a -> b -> PairS a b
:*: s
s')
B Char
c -> forall s a. a -> s -> Step s a
Yield Char
c (Bool
False forall a b. a -> b -> PairS a b
:*: s
s')
Token
_ | Bool
skip -> forall s a. s -> Step s a
Skip (Bool
skip forall a b. a -> b -> PairS a b
:*: s
s')
U Char
c -> forall s a. a -> s -> Step s a
Yield Char
c (Bool
skip forall a b. a -> b -> PairS a b
:*: s
s')
L Char
c -> forall s a. a -> s -> Step s a
Yield Char
c (Bool
skip forall a b. a -> b -> PairS a b
:*: s
s')
{-# INLINE [0] dropWord #-}
toTitle :: Stream Char -> Stream Char
toTitle :: Stream Char -> Stream Char
toTitle = (Stream Char -> Stream Char) -> Stream Char -> Stream Char
mapHead Stream Char -> Stream Char
toUpper forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall s. s -> Step (CC s) Char)
-> (forall s. Char -> s -> Step (CC s) Char)
-> (forall s. Char -> s -> Step (CC s) Char)
-> Stream Token
-> Stream Char
transformWith (forall s. Char -> s -> Step (CC s) Char
yield Char
' ') forall s. Char -> s -> Step (CC s) Char
upper forall s. Char -> s -> Step (CC s) Char
lower forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream Char -> Stream Token
tokenise
{-# INLINE [0] toTitle #-}
toCamel :: Stream Char -> Stream Char
toCamel :: Stream Char -> Stream Char
toCamel = (Stream Char -> Stream Char) -> Stream Char -> Stream Char
mapHead Stream Char -> Stream Char
toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall s. s -> Step (CC s) Char)
-> (forall s. Char -> s -> Step (CC s) Char)
-> (forall s. Char -> s -> Step (CC s) Char)
-> Stream Token
-> Stream Char
transformWith forall s. s -> Step (CC s) Char
skip' forall s. Char -> s -> Step (CC s) Char
upper forall s. Char -> s -> Step (CC s) Char
lower forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream Char -> Stream Token
tokenise
{-# INLINE [0] toCamel #-}
toPascal :: Stream Char -> Stream Char
toPascal :: Stream Char -> Stream Char
toPascal = (Stream Char -> Stream Char) -> Stream Char -> Stream Char
mapHead Stream Char -> Stream Char
toUpper forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall s. s -> Step (CC s) Char)
-> (forall s. Char -> s -> Step (CC s) Char)
-> (forall s. Char -> s -> Step (CC s) Char)
-> Stream Token
-> Stream Char
transformWith forall s. s -> Step (CC s) Char
skip' forall s. Char -> s -> Step (CC s) Char
upper forall s. Char -> s -> Step (CC s) Char
lower forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream Char -> Stream Token
tokenise
{-# INLINE [0] toPascal #-}
toSnake :: Stream Char -> Stream Char
toSnake :: Stream Char -> Stream Char
toSnake = (forall s. s -> Step (CC s) Char)
-> (forall s. Char -> s -> Step (CC s) Char)
-> Stream Token
-> Stream Char
transform (forall s. Char -> s -> Step (CC s) Char
yield Char
'_') forall s. Char -> s -> Step (CC s) Char
lower forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream Char -> Stream Token
tokenise
{-# INLINE [0] toSnake #-}
toSpinal :: Stream Char -> Stream Char
toSpinal :: Stream Char -> Stream Char
toSpinal = (forall s. s -> Step (CC s) Char)
-> (forall s. Char -> s -> Step (CC s) Char)
-> Stream Token
-> Stream Char
transform (forall s. Char -> s -> Step (CC s) Char
yield Char
'-') forall s. Char -> s -> Step (CC s) Char
lower forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream Char -> Stream Token
tokenise
{-# INLINE [0] toSpinal #-}
toTrain :: Stream Char -> Stream Char
toTrain :: Stream Char -> Stream Char
toTrain = (Stream Char -> Stream Char) -> Stream Char -> Stream Char
mapHead Stream Char -> Stream Char
toUpper forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall s. s -> Step (CC s) Char)
-> (forall s. Char -> s -> Step (CC s) Char)
-> (forall s. Char -> s -> Step (CC s) Char)
-> Stream Token
-> Stream Char
transformWith (forall s. Char -> s -> Step (CC s) Char
yield Char
'-') forall s. Char -> s -> Step (CC s) Char
upper forall s. Char -> s -> Step (CC s) Char
lower forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream Char -> Stream Token
tokenise
{-# INLINE [0] toTrain #-}
strict :: (Stream Char -> Stream Char) -> Text -> Text
strict :: (Stream Char -> Stream Char) -> Text -> Text
strict Stream Char -> Stream Char
f Text
t = Stream Char -> Text
Fusion.unstream (Stream Char -> Stream Char
f (Text -> Stream Char
Fusion.stream Text
t))
{-# INLINE [0] strict #-}
lazy :: (Stream Char -> Stream Char) -> LText.Text -> LText.Text
lazy :: (Stream Char -> Stream Char) -> Text -> Text
lazy Stream Char -> Stream Char
f Text
t = Stream Char -> Text
LFusion.unstream (Stream Char -> Stream Char
f (Text -> Stream Char
LFusion.stream Text
t))
{-# INLINE [0] lazy #-}
skip' :: forall s. s -> Step (CC s) Char
#if MIN_VERSION_text(2,0,0)
skip' s = Skip (CC s 0)
#else
skip' :: forall s. s -> Step (CC s) Char
skip' s
s = forall s a. s -> Step s a
Skip (forall s. s -> Char -> Char -> CC s
CC s
s Char
'\0' Char
'\0')
#endif
yield, upper, lower :: forall s. Char -> s -> Step (CC s) Char
#if MIN_VERSION_text(2,0,0)
yield !c s = Yield c (CC s 0)
upper !c@(C# c#) s = case I64# (upperMapping c#) of
0 -> Yield c (CC s 0)
ab -> let (a, b) = chopOffChar ab in
Yield a (CC s b)
lower !c@(C# c#) s = case I64# (lowerMapping c#) of
0 -> Yield c (CC s 0)
ab -> let (a, b) = chopOffChar ab in
Yield a (CC s b)
chopOffChar :: Int64 -> (Char, Int64)
chopOffChar ab = (chr a, ab `shiftR` 21)
where
chr (I# n) = C# (chr# n)
mask = (1 `shiftL` 21) - 1
a = fromIntegral $ ab .&. mask
#else
yield :: forall s. Char -> s -> Step (CC s) Char
yield !Char
c s
s = forall s a. a -> s -> Step s a
Yield Char
c (forall s. s -> Char -> Char -> CC s
CC s
s Char
'\0' Char
'\0')
upper :: forall s. Char -> s -> Step (CC s) Char
upper !Char
c s
s = forall s. Char -> s -> Step (CC s) Char
upperMapping Char
c s
s
lower :: forall s. Char -> s -> Step (CC s) Char
lower !Char
c s
s = forall s. Char -> s -> Step (CC s) Char
lowerMapping Char
c s
s
#endif
transform ::
(forall s. s -> Step (CC s) Char) ->
(forall s. Char -> s -> Step (CC s) Char) ->
Stream Token ->
Stream Char
transform :: (forall s. s -> Step (CC s) Char)
-> (forall s. Char -> s -> Step (CC s) Char)
-> Stream Token
-> Stream Char
transform forall s. s -> Step (CC s) Char
s forall s. Char -> s -> Step (CC s) Char
m = (forall s. s -> Step (CC s) Char)
-> (forall s. Char -> s -> Step (CC s) Char)
-> (forall s. Char -> s -> Step (CC s) Char)
-> Stream Token
-> Stream Char
transformWith forall s. s -> Step (CC s) Char
s forall s. Char -> s -> Step (CC s) Char
m forall s. Char -> s -> Step (CC s) Char
m
{-# INLINE [0] transform #-}
transformWith ::
(forall s. s -> Step (CC s) Char) ->
(forall s. Char -> s -> Step (CC s) Char) ->
(forall s. Char -> s -> Step (CC s) Char) ->
Stream Token ->
Stream Char
transformWith :: (forall s. s -> Step (CC s) Char)
-> (forall s. Char -> s -> Step (CC s) Char)
-> (forall s. Char -> s -> Step (CC s) Char)
-> Stream Token
-> Stream Char
transformWith forall s. s -> Step (CC s) Char
md forall s. Char -> s -> Step (CC s) Char
mu forall s. Char -> s -> Step (CC s) Char
mc (Stream s -> Step s Token
next0 s
s0 Size
len) =
#if MIN_VERSION_text(2,0,0)
Stream next (CC (False :*: False :*: s0) 0) len
#else
forall a s. (s -> Step s a) -> s -> Size -> Stream a
Stream CC (PairS (PairS Bool Bool) s)
-> Step (CC (PairS (PairS Bool Bool) s)) Char
next (forall s. s -> Char -> Char -> CC s
CC (Bool
False forall a b. a -> b -> PairS a b
:*: Bool
False forall a b. a -> b -> PairS a b
:*: s
s0) Char
'\0' Char
'\0') Size
len
#endif
where
#if MIN_VERSION_text(2,0,0)
next (CC (up :*: prev :*: s) 0) =
#else
next :: CC (PairS (PairS Bool Bool) s)
-> Step (CC (PairS (PairS Bool Bool) s)) Char
next (CC (Bool
up :*: Bool
prev :*: s
s) Char
'\0' Char
_) =
#endif
case s -> Step s Token
next0 s
s of
Step s Token
Done -> forall s a. Step s a
Done
#if MIN_VERSION_text(2,0,0)
Skip s' -> Skip (CC (up :*: prev :*: s') 0)
#else
Skip s
s' -> forall s a. s -> Step s a
Skip (forall s. s -> Char -> Char -> CC s
CC (Bool
up forall a b. a -> b -> PairS a b
:*: Bool
prev forall a b. a -> b -> PairS a b
:*: s
s') Char
'\0' Char
'\0')
#endif
Yield Token
t s
s' ->
case Token
t of
B Char
_ -> forall s. s -> Step (CC s) Char
md (Bool
False forall a b. a -> b -> PairS a b
:*: Bool
True forall a b. a -> b -> PairS a b
:*: s
s')
U Char
c | Bool
prev -> forall s. Char -> s -> Step (CC s) Char
mu Char
c (Bool
True forall a b. a -> b -> PairS a b
:*: Bool
False forall a b. a -> b -> PairS a b
:*: s
s')
L Char
c | Bool
prev -> forall s. Char -> s -> Step (CC s) Char
mu Char
c (Bool
False forall a b. a -> b -> PairS a b
:*: Bool
False forall a b. a -> b -> PairS a b
:*: s
s')
U Char
c | Bool
up -> forall s. Char -> s -> Step (CC s) Char
mu Char
c (Bool
True forall a b. a -> b -> PairS a b
:*: Bool
False forall a b. a -> b -> PairS a b
:*: s
s')
U Char
c -> forall s. Char -> s -> Step (CC s) Char
mc Char
c (Bool
True forall a b. a -> b -> PairS a b
:*: Bool
False forall a b. a -> b -> PairS a b
:*: s
s')
L Char
c -> forall s. Char -> s -> Step (CC s) Char
mc Char
c (Bool
False forall a b. a -> b -> PairS a b
:*: Bool
False forall a b. a -> b -> PairS a b
:*: s
s')
#if MIN_VERSION_text(2,0,0)
next (CC s ab) = let (a, b) = chopOffChar ab in Yield a (CC s b)
#else
next (CC PairS (PairS Bool Bool) s
s Char
a Char
b) = forall s a. a -> s -> Step s a
Yield Char
a (forall s. s -> Char -> Char -> CC s
CC PairS (PairS Bool Bool) s
s Char
b Char
'\0')
#endif
{-# INLINE [0] transformWith #-}
data Token
=
B {-# UNPACK #-} !Char
|
U {-# UNPACK #-} !Char
|
L {-# UNPACK #-} !Char
deriving (Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Token] -> ShowS
$cshowList :: [Token] -> ShowS
show :: Token -> String
$cshow :: Token -> String
showsPrec :: Int -> Token -> ShowS
$cshowsPrec :: Int -> Token -> ShowS
Show)
tokenise ::
Stream Char ->
Stream Token
tokenise :: Stream Char -> Stream Token
tokenise = (Char -> Bool) -> Stream Char -> Stream Token
tokeniseWith Char -> Bool
isBoundary
{-# INLINE [0] tokenise #-}
tokeniseWith ::
(Char -> Bool) ->
Stream Char ->
Stream Token
tokeniseWith :: (Char -> Bool) -> Stream Char -> Stream Token
tokeniseWith Char -> Bool
f (Stream s -> Step s Char
next0 s
s0 Size
len) =
#if MIN_VERSION_text(2,0,0)
Stream next (CC (True :*: False :*: False :*: s0) 0) len
#else
forall a s. (s -> Step s a) -> s -> Size -> Stream a
Stream CC (PairS (PairS (PairS Bool Bool) Bool) s)
-> Step (CC (PairS (PairS (PairS Bool Bool) Bool) s)) Token
next (forall s. s -> Char -> Char -> CC s
CC (Bool
True forall a b. a -> b -> PairS a b
:*: Bool
False forall a b. a -> b -> PairS a b
:*: Bool
False forall a b. a -> b -> PairS a b
:*: s
s0) Char
'\0' Char
'\0') Size
len
#endif
where
#if MIN_VERSION_text(2,0,0)
next (CC (start :*: up :*: prev :*: s) 0) =
#else
next :: CC (PairS (PairS (PairS Bool Bool) Bool) s)
-> Step (CC (PairS (PairS (PairS Bool Bool) Bool) s)) Token
next (CC (Bool
start :*: Bool
up :*: Bool
prev :*: s
s) Char
'\0' Char
_) =
#endif
case s -> Step s Char
next0 s
s of
Step s Char
Done -> forall s a. Step s a
Done
#if MIN_VERSION_text(2,0,0)
Skip s' -> Skip (CC (start :*: up :*: prev :*: s') 0)
#else
Skip s
s' -> forall s a. s -> Step s a
Skip (forall s. s -> Char -> Char -> CC s
CC (Bool
start forall a b. a -> b -> PairS a b
:*: Bool
up forall a b. a -> b -> PairS a b
:*: Bool
prev forall a b. a -> b -> PairS a b
:*: s
s') Char
'\0' Char
'\0')
#endif
Yield Char
c s
s'
| Bool -> Bool
not Bool
b, Bool
start -> Step (CC (PairS (PairS (PairS Bool Bool) Bool) s)) Token
push
| Bool
up -> Step (CC (PairS (PairS (PairS Bool Bool) Bool) s)) Token
push
| Bool
b, Bool
prev -> forall s a. s -> Step s a
Skip (forall {a}. a -> CC (PairS (PairS (PairS a Bool) Bool) s)
step Bool
start)
| Bool
otherwise -> Step (CC (PairS (PairS (PairS Bool Bool) Bool) s)) Token
push
where
push :: Step (CC (PairS (PairS (PairS Bool Bool) Bool) s)) Token
push
| Bool
b = forall s a. a -> s -> Step s a
Yield (Char -> Token
B Char
c) (forall {a}. a -> CC (PairS (PairS (PairS a Bool) Bool) s)
step Bool
False)
| Bool
u, Bool
skip = forall s a. a -> s -> Step s a
Yield (Char -> Token
U Char
c) (forall {a}. a -> CC (PairS (PairS (PairS a Bool) Bool) s)
step Bool
False)
#if MIN_VERSION_text(2,0,0)
| u = Yield (B '\0') (CC (False :*: u :*: b :*: s') (fromIntegral (Char.ord c)))
#else
| Bool
u = forall s a. a -> s -> Step s a
Yield (Char -> Token
B Char
'\0') (forall s. s -> Char -> Char -> CC s
CC (Bool
False forall a b. a -> b -> PairS a b
:*: Bool
u forall a b. a -> b -> PairS a b
:*: Bool
b forall a b. a -> b -> PairS a b
:*: s
s') Char
c Char
'\0')
#endif
| Bool
otherwise = forall s a. a -> s -> Step s a
Yield (Char -> Token
L Char
c) (forall {a}. a -> CC (PairS (PairS (PairS a Bool) Bool) s)
step Bool
False)
#if MIN_VERSION_text(2,0,0)
step p = CC (p :*: u :*: b :*: s') 0
#else
step :: a -> CC (PairS (PairS (PairS a Bool) Bool) s)
step a
p = forall s. s -> Char -> Char -> CC s
CC (a
p forall a b. a -> b -> PairS a b
:*: Bool
u forall a b. a -> b -> PairS a b
:*: Bool
b forall a b. a -> b -> PairS a b
:*: s
s') Char
'\0' Char
'\0'
#endif
skip :: Bool
skip = Bool
up Bool -> Bool -> Bool
|| Bool
start Bool -> Bool -> Bool
|| Bool
prev
b :: Bool
b = Char -> Bool
f Char
c
u :: Bool
u = Char -> Bool
Char.isUpper Char
c
#if MIN_VERSION_text(2,0,0)
next (CC s ab) = let (a, b) = chopOffChar ab in Yield (U a) (CC s b)
#else
next (CC PairS (PairS (PairS Bool Bool) Bool) s
s Char
a Char
b) = forall s a. a -> s -> Step s a
Yield (Char -> Token
U Char
a) (forall s. s -> Char -> Char -> CC s
CC PairS (PairS (PairS Bool Bool) Bool) s
s Char
b Char
'\0')
#endif
{-# INLINE [0] tokeniseWith #-}
mapHead :: (Stream Char -> Stream Char) -> Stream Char -> Stream Char
mapHead :: (Stream Char -> Stream Char) -> Stream Char -> Stream Char
mapHead Stream Char -> Stream Char
f Stream Char
s = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Stream Char
s (\(Char
x, Stream Char
s') -> Stream Char -> Stream Char
f (Char -> Stream Char
singleton Char
x) Stream Char -> Stream Char -> Stream Char
`append` Stream Char
s') (Stream Char -> Maybe (Char, Stream Char)
uncons Stream Char
s)
{-# INLINE [0] mapHead #-}