{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_HADDOCK prune not-home #-}

{- |
Module      : Redis.Glob.Internal
Copyright   : (c) 2022 Tim Emiola
Maintainer  : Tim Emiola <adetokunbo@emio.la>
SPDX-License-Identifier: BSD3

Provides types that model redis @glob@ patterns and combinators that can be used
to validate and interpret them.

Assumes that @glob@ do __not__ match the non-printable ASCII characters.
-}
module Redis.Glob.Internal (
  -- * modelling @Globs@
  Part (..),
  InSquare (..),

  -- * parse / print valid @Globs@
  parseParts,
  parsePart,
  fromParts,
  fromPart,

  -- * useful combinators
  reduceMany,
  matchParts,
) where

import qualified ASCII.Char as A
import Data.ByteString.Builder (Builder, toLazyByteString, word8)
import Data.ByteString.Lazy (ByteString)
import Data.Functor (($>))
import Data.Maybe (isJust, mapMaybe)
import Data.Void (Void)
import Data.Word (Word8)
import Text.Megaparsec
import qualified Text.Megaparsec.Byte as P


-- | Parse type for parsing @'ByteString'-like@
type Parser s m = (MonadParsec Void s m, Token s ~ Word8)


parseInSquare :: (Parser s m, Token s ~ Word8) => m a -> m a
parseInSquare :: forall s (m :: * -> *) a.
(Parser s m, Token s ~ Word8) =>
m a -> m a
parseInSquare = forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
P.char Word8
leftSquare) (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
P.char Word8
rightSquare)


notLeftSquare :: Parser s m => m Word8
notLeftSquare :: forall s (m :: * -> *). Parser s m => m Word8
notLeftSquare = forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (\Token s
x -> Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Word8 -> Bool
hasRole Token s
x Bool -> Bool -> Bool
&& Token s
x forall a. Ord a => a -> a -> Bool
< Token s
128)


notRightSquare :: Parser s m => m Word8
notRightSquare :: forall s (m :: * -> *). Parser s m => m Word8
notRightSquare = forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (\Token s
x -> Token s
x forall a. Eq a => a -> a -> Bool
/= Word8
rightSquare Bool -> Bool -> Bool
&& Token s
x forall a. Ord a => a -> a -> Bool
< Token s
128)


escapedChar :: Parser s m => m Word8
escapedChar :: forall s (m :: * -> *). Parser s m => m Word8
escapedChar = forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
P.char Word8
backslash forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Token s)
P.asciiChar


matchable :: Parser s m => m Word8
matchable :: forall s (m :: * -> *). Parser s m => m Word8
matchable = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall s (m :: * -> *). Parser s m => m Word8
escapedChar forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s (m :: * -> *). Parser s m => m Word8
notLeftSquare


parseInRange :: Parser s m => m InSquare
parseInRange :: forall s (m :: * -> *). Parser s m => m InSquare
parseInRange = do
  Word8
start <- forall s (m :: * -> *). Parser s m => m Word8
notRightSquare
  Token s
_dash <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
P.char Word8
dash
  Word8 -> Word8 -> InSquare
InRange Word8
start forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Token s)
P.asciiChar


parseAnyInSquare :: Parser s m => m InSquare
parseAnyInSquare :: forall s (m :: * -> *). Parser s m => m InSquare
parseAnyInSquare =
  forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ Word8 -> InSquare
Single forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). Parser s m => m Word8
escapedChar
    , forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall s (m :: * -> *). Parser s m => m InSquare
parseInRange
    , Word8 -> InSquare
Single forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). Parser s m => m Word8
notRightSquare
    ]


parseSquared :: Parser s m => m Part
parseSquared :: forall s (m :: * -> *). Parser s m => m Part
parseSquared = forall s (m :: * -> *) a.
(Parser s m, Token s ~ Word8) =>
m a -> m a
parseInSquare forall a b. (a -> b) -> a -> b
$ do
  Maybe (Token s)
isNegated <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
P.char Word8
hat
  InSquare
x <- forall s (m :: * -> *). Parser s m => m InSquare
parseAnyInSquare
  [InSquare]
xs <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall s (m :: * -> *). Parser s m => m InSquare
parseAnyInSquare
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe (InSquare -> [InSquare] -> Part
Squared InSquare
x [InSquare]
xs) (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ InSquare -> [InSquare] -> Part
Negated InSquare
x [InSquare]
xs) Maybe (Token s)
isNegated


parseUnescaped :: Parser s m => m Part
parseUnescaped :: forall s (m :: * -> *). Parser s m => m Part
parseUnescaped = do
  Word8
choice1 <- forall s (m :: * -> *). Parser s m => m Word8
matchable
  [Word8]
others <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall s (m :: * -> *). Parser s m => m Word8
matchable
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Word8 -> [Word8] -> Part
Unescaped Word8
choice1 [Word8]
others


parseAnyPart :: Parser s m => m Part
parseAnyPart :: forall s (m :: * -> *). Parser s m => m Part
parseAnyPart =
  forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
P.char Word8
star forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Part
Many
    , forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
P.char Word8
qmark forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Part
Any
    , forall s (m :: * -> *). Parser s m => m Part
parseSquared
    , forall s (m :: * -> *). Parser s m => m Part
parseUnescaped
    ]


-- | Parse several @'Part'@ from a glob @pattern@
parseParts :: ByteString -> Maybe [Part]
parseParts :: ByteString -> Maybe [Part]
parseParts = forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
parseMaybe forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall s (m :: * -> *). Parser s m => m Part
parseAnyPart


-- | Parse a single @'Part'@ from a glob @pattern@
parsePart :: ByteString -> Maybe Part
parsePart :: ByteString -> Maybe Part
parsePart = forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
parseMaybe forall s (m :: * -> *). Parser s m => m Part
parseAnyPart


-- | Represents part of a valid redis glob pattern.
data Part
  = Any
  | Many
  | GenerousMany
  | Unescaped Word8 [Word8]
  | Squared InSquare [InSquare]
  | Negated InSquare [InSquare]
  deriving (Part -> Part -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Part -> Part -> Bool
$c/= :: Part -> Part -> Bool
== :: Part -> Part -> Bool
$c== :: Part -> Part -> Bool
Eq, Int -> Part -> ShowS
[Part] -> ShowS
Part -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Part] -> ShowS
$cshowList :: [Part] -> ShowS
show :: Part -> String
$cshow :: Part -> String
showsPrec :: Int -> Part -> ShowS
$cshowsPrec :: Int -> Part -> ShowS
Show)


-- | Represents part of a valid redis glob pattern.
data InSquare
  = Single Word8
  | InRange Word8 Word8
  deriving (InSquare -> InSquare -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InSquare -> InSquare -> Bool
$c/= :: InSquare -> InSquare -> Bool
== :: InSquare -> InSquare -> Bool
$c== :: InSquare -> InSquare -> Bool
Eq, Int -> InSquare -> ShowS
[InSquare] -> ShowS
InSquare -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InSquare] -> ShowS
$cshowList :: [InSquare] -> ShowS
show :: InSquare -> String
$cshow :: InSquare -> String
showsPrec :: Int -> InSquare -> ShowS
$cshowsPrec :: Int -> InSquare -> ShowS
Show)


-- | Confirm that a @target@ 'ByteString' matches the pattern provided as @['Part']@.
matchParts :: ByteString -> [Part] -> Bool
matchParts :: ByteString -> [Part] -> Bool
matchParts ByteString
target = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip [Part] -> ByteString -> Maybe [Word8]
parseAsMatcher ByteString
target


parseAsMatcher :: [Part] -> ByteString -> Maybe [Word8]
parseAsMatcher :: [Part] -> ByteString -> Maybe [Word8]
parseAsMatcher [Part]
parts = forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
parseMaybe forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). Parser s m => [Part] -> m [Word8]
matcher [Part]
parts


matcher :: Parser s m => [Part] -> m [Word8]
matcher :: forall s (m :: * -> *). Parser s m => [Part] -> m [Word8]
matcher = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall s (m :: * -> *).
Parser s m =>
Part -> m [Word8] -> m [Word8]
matcherStep (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Part] -> [Part]
reduceMany


{- | Normalise parsed @'Part's@

All but a terminating @Many@ are replaced with GenerousMany;
Consecutive @Many@s are replaced by a single GenerousMany
-}
reduceMany :: [Part] -> [Part]
reduceMany :: [Part] -> [Part]
reduceMany =
  let step :: Part -> [Part] -> [Part]
step Part
Many [] = [Part
Many]
      step Part
Many (Part
Many : [Part]
xs) = Part
GenerousMany forall a. a -> [a] -> [a]
: [Part]
xs
      step Part
Many (Part
GenerousMany : [Part]
xs) = Part
GenerousMany forall a. a -> [a] -> [a]
: [Part]
xs
      step Part
Many [Part]
xs = Part
GenerousMany forall a. a -> [a] -> [a]
: [Part]
xs
      step Part
x [Part]
xs = Part
x forall a. a -> [a] -> [a]
: [Part]
xs
   in forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Part -> [Part] -> [Part]
step []


matcherStep :: Parser s m => Part -> m [Word8] -> m [Word8]
-- assumes the Part comes from the output of reduceMany; then only the last
-- element will be Many and the accumulator can be replaced in this way
matcherStep :: forall s (m :: * -> *).
Parser s m =>
Part -> m [Word8] -> m [Word8]
matcherStep Part
Many m [Word8]
_ = forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Token s)
P.asciiChar
matcherStep Part
GenerousMany m [Word8]
acc = forall s (m :: * -> *) a.
(Parser s m, Token s ~ Word8) =>
m a -> m a
innerStar_ m [Word8]
acc
matcherStep (Unescaped Word8
x [Word8]
xs) m [Word8]
acc = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
P.char (Word8
x forall a. a -> [a] -> [a]
: [Word8]
xs) forall s (m :: * -> *).
Parser s m =>
m [Word8] -> m [Word8] -> m [Word8]
`thenParse` m [Word8]
acc
matcherStep (Squared InSquare
x [InSquare]
xs) m [Word8]
acc = forall s (m :: * -> *).
Parser s m =>
InSquare -> [InSquare] -> m Word8
squaredParser InSquare
x [InSquare]
xs forall s (m :: * -> *).
Parser s m =>
m Word8 -> m [Word8] -> m [Word8]
`thenParse'` m [Word8]
acc
matcherStep (Negated InSquare
x [InSquare]
xs) m [Word8]
acc = forall s (m :: * -> *).
Parser s m =>
InSquare -> [InSquare] -> m Word8
negatedParser InSquare
x [InSquare]
xs forall s (m :: * -> *).
Parser s m =>
m Word8 -> m [Word8] -> m [Word8]
`thenParse'` m [Word8]
acc
matcherStep Part
Any m [Word8]
acc = forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Token s)
P.asciiChar forall s (m :: * -> *).
Parser s m =>
m Word8 -> m [Word8] -> m [Word8]
`thenParse'` m [Word8]
acc


thenParse :: Parser s m => m [Word8] -> m [Word8] -> m [Word8]
thenParse :: forall s (m :: * -> *).
Parser s m =>
m [Word8] -> m [Word8] -> m [Word8]
thenParse m [Word8]
x m [Word8]
y = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [Word8]
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m [Word8]
y


thenParse' :: Parser s m => m Word8 -> m [Word8] -> m [Word8]
thenParse' :: forall s (m :: * -> *).
Parser s m =>
m Word8 -> m [Word8] -> m [Word8]
thenParse' m Word8
x m [Word8]
y = (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word8
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m [Word8]
y


innerStar_ :: (Parser s m, Token s ~ Word8) => m a -> m a
innerStar_ :: forall s (m :: * -> *) a.
(Parser s m, Token s ~ Word8) =>
m a -> m a
innerStar_ = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a.
(Parser s m, Token s ~ Word8) =>
m a -> m ([Word8], a)
innerStar


innerStar :: (Parser s m, Token s ~ Word8) => m a -> m ([Word8], a)
innerStar :: forall s (m :: * -> *) a.
(Parser s m, Token s ~ Word8) =>
m a -> m ([Word8], a)
innerStar m a
parser = do
  ([Word8]
a, a
b) <- forall (m :: * -> *) a end.
MonadPlus m =>
m a -> m end -> m ([a], end)
someTill_ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Token s)
P.asciiChar m a
parser
  forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Word8]
a, a
b)


singleOf :: InSquare -> Maybe Word8
singleOf :: InSquare -> Maybe Word8
singleOf (Single Word8
x) = forall a. a -> Maybe a
Just Word8
x
singleOf InSquare
_ = forall a. Maybe a
Nothing


rangeOf :: InSquare -> Maybe (Word8, Word8)
rangeOf :: InSquare -> Maybe (Word8, Word8)
rangeOf (InRange Word8
x Word8
y) | Word8
x forall a. Ord a => a -> a -> Bool
<= Word8
y = forall a. a -> Maybe a
Just (Word8
x, Word8
y)
rangeOf (InRange Word8
x Word8
y) = forall a. a -> Maybe a
Just (Word8
y, Word8
x)
rangeOf InSquare
_ = forall a. Maybe a
Nothing


boundedBy :: (Bool -> Bool) -> [Word8] -> [(Word8, Word8)] -> Word8 -> Bool
boundedBy :: (Bool -> Bool) -> [Word8] -> [(Word8, Word8)] -> Word8 -> Bool
boundedBy Bool -> Bool
orNor [Word8]
ys [(Word8, Word8)]
xs Word8
z = Bool -> Bool
orNor forall a b. (a -> b) -> a -> b
$ Word8
z forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Word8]
ys Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(Word8
x, Word8
y) -> Word8
z forall a. Ord a => a -> a -> Bool
>= Word8
x Bool -> Bool -> Bool
&& Word8
z forall a. Ord a => a -> a -> Bool
<= Word8
y) [(Word8, Word8)]
xs


squaredParser :: Parser s m => InSquare -> [InSquare] -> m Word8
squaredParser :: forall s (m :: * -> *).
Parser s m =>
InSquare -> [InSquare] -> m Word8
squaredParser InSquare
x [InSquare]
xs =
  let xs' :: [InSquare]
xs' = InSquare
x forall a. a -> [a] -> [a]
: [InSquare]
xs
   in forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy forall a b. (a -> b) -> a -> b
$ (Bool -> Bool) -> [Word8] -> [(Word8, Word8)] -> Word8 -> Bool
boundedBy forall a. a -> a
id (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe InSquare -> Maybe Word8
singleOf [InSquare]
xs') (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe InSquare -> Maybe (Word8, Word8)
rangeOf [InSquare]
xs')


negatedParser :: Parser s m => InSquare -> [InSquare] -> m Word8
negatedParser :: forall s (m :: * -> *).
Parser s m =>
InSquare -> [InSquare] -> m Word8
negatedParser InSquare
x [InSquare]
xs =
  let xs' :: [InSquare]
xs' = InSquare
x forall a. a -> [a] -> [a]
: [InSquare]
xs
   in forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy forall a b. (a -> b) -> a -> b
$ (Bool -> Bool) -> [Word8] -> [(Word8, Word8)] -> Word8 -> Bool
boundedBy Bool -> Bool
not (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe InSquare -> Maybe Word8
singleOf [InSquare]
xs') (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe InSquare -> Maybe (Word8, Word8)
rangeOf [InSquare]
xs')


-- | Convert a @'Part'@ to the form it would be parsed from
fromPart :: Part -> ByteString
fromPart :: Part -> ByteString
fromPart = Builder -> ByteString
toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. BuilderOf a => a -> Builder
builderOf


-- | Convert several @'Part's@ to the form they can be parsed from.
fromParts :: [Part] -> ByteString
fromParts :: [Part] -> ByteString
fromParts = Builder -> ByteString
toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. BuilderOf a => a -> Builder
builderOf


class BuilderOf a where
  builderOf :: a -> Builder


instance BuilderOf InSquare where
  builderOf :: InSquare -> Builder
builderOf (Single Word8
x) = Word8 -> Builder
escaped8 Word8
x
  builderOf (InRange Word8
x Word8
y) = Word8 -> Builder
word8 Word8
x forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
word8 Word8
dash forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
word8 Word8
y


instance BuilderOf Part where
  builderOf :: Part -> Builder
builderOf Part
Any = Word8 -> Builder
word8 Word8
qmark
  builderOf Part
Many = Word8 -> Builder
word8 Word8
star
  builderOf Part
GenerousMany = Word8 -> Builder
word8 Word8
star
  builderOf (Unescaped Word8
x [Word8]
xs) = Word8 -> Builder
escaped8 Word8
x forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Builder
escaped8 [Word8]
xs)
  builderOf (Squared InSquare
x [InSquare]
xs) = Builder -> Builder
inSquare forall a b. (a -> b) -> a -> b
$ forall a. BuilderOf a => a -> Builder
builderOf InSquare
x forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map forall a. BuilderOf a => a -> Builder
builderOf [InSquare]
xs)
  builderOf (Negated InSquare
x [InSquare]
xs) = Builder -> Builder
inSquare forall a b. (a -> b) -> a -> b
$ Word8 -> Builder
word8 Word8
hat forall a. Semigroup a => a -> a -> a
<> forall a. BuilderOf a => a -> Builder
builderOf InSquare
x forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map forall a. BuilderOf a => a -> Builder
builderOf [InSquare]
xs)


escaped8 :: Word8 -> Builder
escaped8 :: Word8 -> Builder
escaped8 Word8
x | Word8 -> Bool
hasRole Word8
x = Word8 -> Builder
escaped Word8
x
escaped8 Word8
x = Word8 -> Builder
word8 Word8
x


escaped :: Word8 -> Builder
escaped :: Word8 -> Builder
escaped = (Word8 -> Builder
word8 Word8
backslash forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Builder
word8


hasRole :: Word8 -> Bool
hasRole :: Word8 -> Bool
hasRole Word8
x = Word8
x forall a. Eq a => a -> a -> Bool
== Word8
star Bool -> Bool -> Bool
|| Word8
x forall a. Eq a => a -> a -> Bool
== Word8
backslash Bool -> Bool -> Bool
|| Word8
x forall a. Eq a => a -> a -> Bool
== Word8
leftSquare Bool -> Bool -> Bool
|| Word8
x forall a. Eq a => a -> a -> Bool
== Word8
qmark


inSquare :: Builder -> Builder
inSquare :: Builder -> Builder
inSquare Builder
inside = Word8 -> Builder
word8 Word8
leftSquare forall a. Semigroup a => a -> a -> a
<> Builder
inside forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
word8 Word8
rightSquare


hat, qmark, star, leftSquare, rightSquare, dash, backslash :: Word8
hat :: Word8
hat = Char -> Word8
A.toWord8 Char
A.Caret
qmark :: Word8
qmark = Char -> Word8
A.toWord8 Char
A.QuestionMark
star :: Word8
star = Char -> Word8
A.toWord8 Char
A.Asterisk
leftSquare :: Word8
leftSquare = Char -> Word8
A.toWord8 Char
A.LeftSquareBracket
rightSquare :: Word8
rightSquare = Char -> Word8
A.toWord8 Char
A.RightSquareBracket
dash :: Word8
dash = Char -> Word8
A.toWord8 Char
A.HyphenMinus
backslash :: Word8
backslash = Char -> Word8
A.toWord8 Char
A.Backslash