{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ViewPatterns #-}

-- Module      : Data.Text.Manipulate.Internal.Fusion
-- Copyright   : (c) 2014-2020 Brendan Hay <brendan.g.hay@gmail.com>
-- License     : This Source Code Form is subject to the terms of
--               the Mozilla Public License, v. 2.0.
--               A copy of the MPL can be found in the LICENSE file or
--               you can obtain it at http://mozilla.org/MPL/2.0/.
-- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)

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 (Step (CC s) Char -> s -> Step (CC s) Char
forall a b. a -> b -> a
const Step (CC s) Char
forall s a. Step s a
Done) forall s. Char -> s -> Step (CC s) Char
yield (Stream Token -> Stream Char)
-> (Stream Char -> Stream Token) -> Stream Char -> Stream Char
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) = (PairS Bool s -> Step (PairS Bool s) Char)
-> PairS Bool s -> Size -> Stream Char
forall a s. (s -> Step s a) -> s -> Size -> Stream a
Stream PairS Bool s -> Step (PairS Bool s) Char
next (Bool
True Bool -> s -> PairS Bool s
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 -> Step (PairS Bool s) Char
forall s a. Step s a
Done
        Skip s
s' -> PairS Bool s -> Step (PairS Bool s) Char
forall s a. s -> Step s a
Skip (Bool
skip Bool -> s -> PairS Bool s
forall a b. a -> b -> PairS a b
:*: s
s')
        Yield Token
t s
s' ->
          case Token
t of
            B Char
'\0' -> PairS Bool s -> Step (PairS Bool s) Char
forall s a. s -> Step s a
Skip (Bool
False Bool -> s -> PairS Bool s
forall a b. a -> b -> PairS a b
:*: s
s')
            B Char
_ | Bool
skip -> PairS Bool s -> Step (PairS Bool s) Char
forall s a. s -> Step s a
Skip (Bool
False Bool -> s -> PairS Bool s
forall a b. a -> b -> PairS a b
:*: s
s')
            B Char
c -> Char -> PairS Bool s -> Step (PairS Bool s) Char
forall s a. a -> s -> Step s a
Yield Char
c (Bool
False Bool -> s -> PairS Bool s
forall a b. a -> b -> PairS a b
:*: s
s')
            Token
_ | Bool
skip -> PairS Bool s -> Step (PairS Bool s) Char
forall s a. s -> Step s a
Skip (Bool
skip Bool -> s -> PairS Bool s
forall a b. a -> b -> PairS a b
:*: s
s')
            U Char
c -> Char -> PairS Bool s -> Step (PairS Bool s) Char
forall s a. a -> s -> Step s a
Yield Char
c (Bool
skip Bool -> s -> PairS Bool s
forall a b. a -> b -> PairS a b
:*: s
s')
            L Char
c -> Char -> PairS Bool s -> Step (PairS Bool s) Char
forall s a. a -> s -> Step s a
Yield Char
c (Bool
skip Bool -> s -> PairS Bool s
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 (Stream Char -> Stream Char)
-> (Stream Char -> Stream Char) -> Stream Char -> Stream Char
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 (Char -> s -> Step (CC s) Char
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 (Stream Token -> Stream Char)
-> (Stream Char -> Stream Token) -> Stream Char -> Stream Char
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 (Stream Char -> Stream Char)
-> (Stream Char -> Stream Char) -> Stream Char -> Stream Char
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 (Stream Token -> Stream Char)
-> (Stream Char -> Stream Token) -> Stream Char -> Stream Char
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 (Stream Char -> Stream Char)
-> (Stream Char -> Stream Char) -> Stream Char -> Stream Char
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 (Stream Token -> Stream Char)
-> (Stream Char -> Stream Token) -> Stream Char -> Stream Char
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 (Char -> s -> Step (CC s) Char
forall s. Char -> s -> Step (CC s) Char
yield Char
'_') forall s. Char -> s -> Step (CC s) Char
lower (Stream Token -> Stream Char)
-> (Stream Char -> Stream Token) -> Stream Char -> Stream Char
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 (Char -> s -> Step (CC s) Char
forall s. Char -> s -> Step (CC s) Char
yield Char
'-') forall s. Char -> s -> Step (CC s) Char
lower (Stream Token -> Stream Char)
-> (Stream Char -> Stream Token) -> Stream Char -> Stream Char
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 (Stream Char -> Stream Char)
-> (Stream Char -> Stream Char) -> Stream Char -> Stream Char
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 (Char -> s -> Step (CC s) Char
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 (Stream Token -> Stream Char)
-> (Stream Char -> Stream Token) -> Stream Char -> Stream Char
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' :: s -> Step (CC s) Char
skip' s
s = CC s -> Step (CC s) Char
forall s a. s -> Step s a
Skip (s -> Char -> Char -> CC s
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 :: Char -> s -> Step (CC s) Char
yield !Char
c s
s = Char -> CC s -> Step (CC s) Char
forall s a. a -> s -> Step s a
Yield Char
c (s -> Char -> Char -> CC s
forall s. s -> Char -> Char -> CC s
CC s
s Char
'\0' Char
'\0')
upper :: Char -> s -> Step (CC s) Char
upper !Char
c s
s = Char -> s -> Step (CC s) Char
forall s. Char -> s -> Step (CC s) Char
upperMapping Char
c s
s
lower :: Char -> s -> Step (CC s) Char
lower !Char
c s
s = Char -> s -> Step (CC s) Char
forall s. Char -> s -> Step (CC s) Char
lowerMapping Char
c s
s

#endif

-- | Step across word boundaries using a custom action, and transform
-- both subsequent uppercase and lowercase characters uniformly.
--
-- /See:/ 'transformWith'
transform ::
  -- | Boundary action.
  (forall s. s -> Step (CC s) Char) ->
  -- | Character mapping.
  (forall s. Char -> s -> Step (CC s) Char) ->
  -- | Input stream.
  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 #-}

-- | Step across word boundaries using a custom action, and transform
-- subsequent characters after the word boundary is encountered with a mapping
-- depending on case.
transformWith ::
  -- | Boundary action.
  (forall s. s -> Step (CC s) Char) ->
  -- | Boundary mapping.
  (forall s. Char -> s -> Step (CC s) Char) ->
  -- | Subsequent character mapping.
  (forall s. Char -> s -> Step (CC s) Char) ->
  -- | Input stream.
  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) =
  -- HINT: len incorrect when the boundary replacement yields a char.
#if MIN_VERSION_text(2,0,0)
  Stream next (CC (False :*: False :*: s0) 0) len
#else
  (CC (PairS (PairS Bool Bool) s)
 -> Step (CC (PairS (PairS Bool Bool) s)) Char)
-> CC (PairS (PairS Bool Bool) s) -> Size -> Stream Char
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 (PairS (PairS Bool Bool) s
-> Char -> Char -> CC (PairS (PairS Bool Bool) s)
forall s. s -> Char -> Char -> CC s
CC (Bool
False Bool -> Bool -> PairS Bool Bool
forall a b. a -> b -> PairS a b
:*: Bool
False PairS Bool Bool -> s -> PairS (PairS Bool Bool) s
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 -> Step (CC (PairS (PairS Bool Bool) s)) Char
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' -> CC (PairS (PairS Bool Bool) s)
-> Step (CC (PairS (PairS Bool Bool) s)) Char
forall s a. s -> Step s a
Skip (PairS (PairS Bool Bool) s
-> Char -> Char -> CC (PairS (PairS Bool Bool) s)
forall s. s -> Char -> Char -> CC s
CC (Bool
up Bool -> Bool -> PairS Bool Bool
forall a b. a -> b -> PairS a b
:*: Bool
prev PairS Bool Bool -> s -> PairS (PairS Bool Bool) s
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
_ -> PairS (PairS Bool Bool) s
-> Step (CC (PairS (PairS Bool Bool) s)) Char
forall s. s -> Step (CC s) Char
md (Bool
False Bool -> Bool -> PairS Bool Bool
forall a b. a -> b -> PairS a b
:*: Bool
True PairS Bool Bool -> s -> PairS (PairS Bool Bool) s
forall a b. a -> b -> PairS a b
:*: s
s')
            U Char
c | Bool
prev -> Char
-> PairS (PairS Bool Bool) s
-> Step (CC (PairS (PairS Bool Bool) s)) Char
forall s. Char -> s -> Step (CC s) Char
mu Char
c (Bool
True Bool -> Bool -> PairS Bool Bool
forall a b. a -> b -> PairS a b
:*: Bool
False PairS Bool Bool -> s -> PairS (PairS Bool Bool) s
forall a b. a -> b -> PairS a b
:*: s
s')
            L Char
c | Bool
prev -> Char
-> PairS (PairS Bool Bool) s
-> Step (CC (PairS (PairS Bool Bool) s)) Char
forall s. Char -> s -> Step (CC s) Char
mu Char
c (Bool
False Bool -> Bool -> PairS Bool Bool
forall a b. a -> b -> PairS a b
:*: Bool
False PairS Bool Bool -> s -> PairS (PairS Bool Bool) s
forall a b. a -> b -> PairS a b
:*: s
s')
            U Char
c | Bool
up -> Char
-> PairS (PairS Bool Bool) s
-> Step (CC (PairS (PairS Bool Bool) s)) Char
forall s. Char -> s -> Step (CC s) Char
mu Char
c (Bool
True Bool -> Bool -> PairS Bool Bool
forall a b. a -> b -> PairS a b
:*: Bool
False PairS Bool Bool -> s -> PairS (PairS Bool Bool) s
forall a b. a -> b -> PairS a b
:*: s
s')
            U Char
c -> Char
-> PairS (PairS Bool Bool) s
-> Step (CC (PairS (PairS Bool Bool) s)) Char
forall s. Char -> s -> Step (CC s) Char
mc Char
c (Bool
True Bool -> Bool -> PairS Bool Bool
forall a b. a -> b -> PairS a b
:*: Bool
False PairS Bool Bool -> s -> PairS (PairS Bool Bool) s
forall a b. a -> b -> PairS a b
:*: s
s')
            L Char
c -> Char
-> PairS (PairS Bool Bool) s
-> Step (CC (PairS (PairS Bool Bool) s)) Char
forall s. Char -> s -> Step (CC s) Char
mc Char
c (Bool
False Bool -> Bool -> PairS Bool Bool
forall a b. a -> b -> PairS a b
:*: Bool
False PairS Bool Bool -> s -> PairS (PairS Bool Bool) s
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) = Char
-> CC (PairS (PairS Bool Bool) s)
-> Step (CC (PairS (PairS Bool Bool) s)) Char
forall s a. a -> s -> Step s a
Yield Char
a (PairS (PairS Bool Bool) s
-> Char -> Char -> CC (PairS (PairS Bool Bool) s)
forall s. s -> Char -> Char -> CC s
CC PairS (PairS Bool Bool) s
s Char
b Char
'\0')
#endif
{-# INLINE [0] transformWith #-}

-- | A token representing characters and boundaries in a stream.
data Token
  = -- | Word boundary.
    B {-# UNPACK #-} !Char
  | -- | Upper case character.
    U {-# UNPACK #-} !Char
  | -- | Lower case character.
    L {-# UNPACK #-} !Char
  deriving (Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
(Int -> Token -> ShowS)
-> (Token -> String) -> ([Token] -> ShowS) -> Show Token
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 a character stream using the default 'isBoundary' predicate.
--
-- /See:/ 'tokeniseWith'
tokenise ::
  -- | Input stream.
  Stream Char ->
  Stream Token
tokenise :: Stream Char -> Stream Token
tokenise = (Char -> Bool) -> Stream Char -> Stream Token
tokeniseWith Char -> Bool
isBoundary
{-# INLINE [0] tokenise #-}

-- | Tokenise a character stream using a custom boundary predicate.
tokeniseWith ::
  -- | Boundary predicate.
  (Char -> Bool) ->
  -- | Input stream.
  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) =
  -- HINT: len incorrect if there are adjacent boundaries, which are skipped.
#if MIN_VERSION_text(2,0,0)
  Stream next (CC (True :*: False :*: False :*: s0) 0) len
#else
  (CC (PairS (PairS (PairS Bool Bool) Bool) s)
 -> Step (CC (PairS (PairS (PairS Bool Bool) Bool) s)) Token)
-> CC (PairS (PairS (PairS Bool Bool) Bool) s)
-> Size
-> Stream Token
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 (PairS (PairS (PairS Bool Bool) Bool) s
-> Char -> Char -> CC (PairS (PairS (PairS Bool Bool) Bool) s)
forall s. s -> Char -> Char -> CC s
CC (Bool
True Bool -> Bool -> PairS Bool Bool
forall a b. a -> b -> PairS a b
:*: Bool
False PairS Bool Bool -> Bool -> PairS (PairS Bool Bool) Bool
forall a b. a -> b -> PairS a b
:*: Bool
False PairS (PairS Bool Bool) Bool
-> s -> PairS (PairS (PairS Bool Bool) Bool) s
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 -> Step (CC (PairS (PairS (PairS Bool Bool) Bool) s)) Token
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' -> CC (PairS (PairS (PairS Bool Bool) Bool) s)
-> Step (CC (PairS (PairS (PairS Bool Bool) Bool) s)) Token
forall s a. s -> Step s a
Skip (PairS (PairS (PairS Bool Bool) Bool) s
-> Char -> Char -> CC (PairS (PairS (PairS Bool Bool) Bool) s)
forall s. s -> Char -> Char -> CC s
CC (Bool
start Bool -> Bool -> PairS Bool Bool
forall a b. a -> b -> PairS a b
:*: Bool
up PairS Bool Bool -> Bool -> PairS (PairS Bool Bool) Bool
forall a b. a -> b -> PairS a b
:*: Bool
prev PairS (PairS Bool Bool) Bool
-> s -> PairS (PairS (PairS Bool Bool) Bool) s
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 -> CC (PairS (PairS (PairS Bool Bool) Bool) s)
-> Step (CC (PairS (PairS (PairS Bool Bool) Bool) s)) Token
forall s a. s -> Step s a
Skip (Bool -> CC (PairS (PairS (PairS Bool Bool) Bool) s)
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 = Token
-> CC (PairS (PairS (PairS Bool Bool) Bool) s)
-> Step (CC (PairS (PairS (PairS Bool Bool) Bool) s)) Token
forall s a. a -> s -> Step s a
Yield (Char -> Token
B Char
c) (Bool -> CC (PairS (PairS (PairS Bool Bool) Bool) s)
forall a. a -> CC (PairS (PairS (PairS a Bool) Bool) s)
step Bool
False)
              | Bool
u, Bool
skip = Token
-> CC (PairS (PairS (PairS Bool Bool) Bool) s)
-> Step (CC (PairS (PairS (PairS Bool Bool) Bool) s)) Token
forall s a. a -> s -> Step s a
Yield (Char -> Token
U Char
c) (Bool -> CC (PairS (PairS (PairS Bool Bool) Bool) s)
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 = Token
-> CC (PairS (PairS (PairS Bool Bool) Bool) s)
-> Step (CC (PairS (PairS (PairS Bool Bool) Bool) s)) Token
forall s a. a -> s -> Step s a
Yield (Char -> Token
B Char
'\0') (PairS (PairS (PairS Bool Bool) Bool) s
-> Char -> Char -> CC (PairS (PairS (PairS Bool Bool) Bool) s)
forall s. s -> Char -> Char -> CC s
CC (Bool
False Bool -> Bool -> PairS Bool Bool
forall a b. a -> b -> PairS a b
:*: Bool
u PairS Bool Bool -> Bool -> PairS (PairS Bool Bool) Bool
forall a b. a -> b -> PairS a b
:*: Bool
b PairS (PairS Bool Bool) Bool
-> s -> PairS (PairS (PairS Bool Bool) Bool) s
forall a b. a -> b -> PairS a b
:*: s
s') Char
c Char
'\0')
#endif
              | Bool
otherwise = Token
-> CC (PairS (PairS (PairS Bool Bool) Bool) s)
-> Step (CC (PairS (PairS (PairS Bool Bool) Bool) s)) Token
forall s a. a -> s -> Step s a
Yield (Char -> Token
L Char
c) (Bool -> CC (PairS (PairS (PairS Bool Bool) Bool) s)
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 = PairS (PairS (PairS a Bool) Bool) s
-> Char -> Char -> CC (PairS (PairS (PairS a Bool) Bool) s)
forall s. s -> Char -> Char -> CC s
CC (a
p a -> Bool -> PairS a Bool
forall a b. a -> b -> PairS a b
:*: Bool
u PairS a Bool -> Bool -> PairS (PairS a Bool) Bool
forall a b. a -> b -> PairS a b
:*: Bool
b PairS (PairS a Bool) Bool
-> s -> PairS (PairS (PairS a Bool) Bool) s
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) = Token
-> CC (PairS (PairS (PairS Bool Bool) Bool) s)
-> Step (CC (PairS (PairS (PairS Bool Bool) Bool) s)) Token
forall s a. a -> s -> Step s a
Yield (Char -> Token
U Char
a) (PairS (PairS (PairS Bool Bool) Bool) s
-> Char -> Char -> CC (PairS (PairS (PairS Bool Bool) Bool) s)
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 = Stream Char
-> ((Char, Stream Char) -> Stream Char)
-> Maybe (Char, Stream Char)
-> Stream Char
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 #-}