{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE RankNTypes #-}
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 (upperMapping, lowerMapping)
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
takeWord :: Stream Char -> Stream Char
takeWord = transform (const Done) yield . tokenise
{-# INLINE [0] takeWord #-}
dropWord :: Stream Char -> Stream Char
dropWord (tokenise -> Stream next0 s0 len) = Stream next (True :*: s0) len
where
next (skip :*: s) =
case next0 s of
Done -> Done
Skip s' -> Skip (skip :*: s')
Yield t s' ->
case t of
B '\0' -> Skip (False :*: s')
B _ | skip -> Skip (False :*: s')
B c -> Yield c (False :*: s')
_ | skip -> Skip (skip :*: s')
U c -> Yield c (skip :*: s')
L c -> Yield c (skip :*: s')
{-# INLINE [0] dropWord #-}
toTitle :: Stream Char -> Stream Char
toTitle = mapHead toUpper . transformWith (yield ' ') upper lower . tokenise
{-# INLINE [0] toTitle #-}
toCamel :: Stream Char -> Stream Char
toCamel = mapHead toLower . transformWith skip' upper lower . tokenise
{-# INLINE [0] toCamel #-}
toPascal :: Stream Char -> Stream Char
toPascal = mapHead toUpper . transformWith skip' upper lower . tokenise
{-# INLINE [0] toPascal #-}
toSnake :: Stream Char -> Stream Char
toSnake = transform (yield '_') lower . tokenise
{-# INLINE [0] toSnake #-}
toSpinal :: Stream Char -> Stream Char
toSpinal = transform (yield '-') lower . tokenise
{-# INLINE [0] toSpinal #-}
toTrain :: Stream Char -> Stream Char
toTrain = mapHead toUpper . transformWith (yield '-') upper lower . tokenise
{-# INLINE [0] toTrain #-}
strict :: (Stream Char -> Stream Char) -> Text -> Text
strict f t = Fusion.unstream (f (Fusion.stream t))
{-# INLINE [0] strict #-}
lazy :: (Stream Char -> Stream Char) -> LText.Text -> LText.Text
lazy f t = LFusion.unstream (f (LFusion.stream t))
{-# INLINE [0] lazy #-}
skip' :: forall s. s -> Step (CC s) Char
skip' s = Skip (CC s '\0' '\0')
yield, upper, lower :: forall s. Char -> s -> Step (CC s) Char
yield !c s = Yield c (CC s '\0' '\0')
upper !c s = upperMapping c s
lower !c s = lowerMapping c s
transform :: (forall s. s -> Step (CC s) Char)
-> (forall s. Char -> s -> Step (CC s) Char)
-> Stream Token
-> Stream Char
transform s m = transformWith s m 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 md mu mc (Stream next0 s0 len) =
Stream next (CC (False :*: False :*: s0) '\0' '\0') len
where
next (CC (up :*: prev :*: s) '\0' _) =
case next0 s of
Done -> Done
Skip s' -> Skip (CC (up :*: prev :*: s') '\0' '\0')
Yield t s' ->
case t of
B _ -> md (False :*: True :*: s')
U c | prev -> mu c (True :*: False :*: s')
L c | prev -> mu c (False :*: False :*: s')
U c | up -> mu c (True :*: False :*: s')
U c -> mc c (True :*: False :*: s')
L c -> mc c (False :*: False :*: s')
next (CC s a b) = Yield a (CC s b '\0')
{-# INLINE [0] transformWith #-}
data Token
= B {-# UNPACK #-} !Char
| U {-# UNPACK #-} !Char
| L {-# UNPACK #-} !Char
deriving (Show)
tokenise :: Stream Char
-> Stream Token
tokenise = tokeniseWith isBoundary
{-# INLINE [0] tokenise #-}
tokeniseWith :: (Char -> Bool)
-> Stream Char
-> Stream Token
tokeniseWith f (Stream next0 s0 len) =
Stream next (CC (True :*: False :*: False :*: s0) '\0' '\0') len
where
next (CC (start :*: up :*: prev :*: s) '\0' _) =
case next0 s of
Done -> Done
Skip s' -> Skip (CC (start :*: up :*: prev :*: s') '\0' '\0')
Yield c s'
| not b, start -> push
| up -> push
| b, prev -> Skip (step start)
| otherwise -> push
where
push | b = Yield (B c) (step False)
| u, skip = Yield (U c) (step False)
| u = Yield (B '\0') (CC (False :*: u :*: b :*: s') c '\0')
| otherwise = Yield (L c) (step False)
step p = CC (p :*: u :*: b :*: s') '\0' '\0'
skip = up || start || prev
b = f c
u = Char.isUpper c
next (CC s a b) = Yield (U a) (CC s b '\0')
{-# INLINE [0] tokeniseWith #-}
mapHead :: (Stream Char -> Stream Char) -> Stream Char -> Stream Char
mapHead f s = maybe s (\(x, s') -> f (singleton x) `append` s') (uncons s)
{-# INLINE [0] mapHead #-}