{-# LANGUAGE CPP #-}
module RegExDot.Repeatable(
Repetitions,
RepetitionBounds,
Repeatable(..),
oneOrMoreToken,
rangeDelimiters,
rangeSeparatorToken,
tokens,
zeroOrMoreToken,
zeroOrOneToken,
one,
oneOrMore,
oneOrMore',
zeroOrMore,
zeroOrMore',
zeroOrOne,
zeroOrOne',
repeatableParser,
showSuffix,
getFewest,
getMost,
focus,
toSingleton,
(^#->#),
(^#->#?),
(^#->),
(^#->?),
(^#),
isPrecise,
hasPreciseBounds
) where
import Control.Arrow((***))
import qualified Control.DeepSeq
import qualified Data.List
import qualified RegExDot.Consumer as Consumer
import qualified RegExDot.ConsumptionProfile as ConsumptionProfile
import qualified Text.ParserCombinators.Parsec as Parsec
import Text.ParserCombinators.Parsec((<?>))
import qualified ToolShed.Data.Pair
import qualified ToolShed.SelfValidate
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative((<$>), (<*>))
#endif
infix 6 ^#->#, ^#->#?, ^#->, ^#->?, ^#
type Repetitions = Int
type RepetitionBounds = (Repetitions, Maybe Repetitions)
precisely :: Repetitions -> RepetitionBounds
precisely i = (i, Just i)
hasPreciseBounds :: RepetitionBounds -> Bool
hasPreciseBounds (fewest, most) = Just fewest == most
data Repeatable a = MkRepeatable {
base :: a,
repetitionBounds :: RepetitionBounds,
isGreedy :: Bool
} deriving Eq
instance Functor Repeatable where
fmap f repeatable = repeatable { base = f $ base repeatable }
isPrecise :: Repeatable a -> Bool
isPrecise = hasPreciseBounds . repetitionBounds
repeatableParser :: a -> Parsec.Parser (Repeatable a)
repeatableParser b = Parsec.option (
one b
) $ do
repeatable <- Parsec.choice [
(Parsec.char oneOrMoreToken <?> "Repeatable.oneOrMoreToken " ++ show oneOrMoreToken) >> return (oneOrMore b),
(Parsec.char zeroOrOneToken <?> "Repeatable.zeroOrOneToken " ++ show zeroOrOneToken) >> return (zeroOrOne b),
(Parsec.char zeroOrMoreToken <?> "Repeatable.zeroOrMoreToken " ++ show zeroOrMoreToken) >> return (zeroOrMore b),
(b ^#->#) <$> uncurry Parsec.between (ToolShed.Data.Pair.mirror Parsec.char rangeDelimiters) (
do
fewest <- Parsec.spaces >> (read <$> Parsec.many1 Parsec.digit <?> "Repetition-range minimum")
most <- Parsec.spaces >> Parsec.option (
Just fewest
) (
do
i <- (
Parsec.char rangeSeparatorToken <?> "Repeatable.rangeSeparatorToken " ++ show rangeSeparatorToken
) >> Parsec.spaces >> Parsec.option Nothing (
Just . read <$> Parsec.many1 Parsec.digit <?> "Repetition-range maximum"
)
Parsec.spaces >> return i
)
return (fewest, most)
) <?> "Repeatable.rangeDelimiters " ++ show rangeDelimiters
]
g <- Parsec.option True $ (Parsec.char nonGreedyToken <?> "Repeatable.nonGreedyToken " ++ show nonGreedyToken) >> return False
return repeatable { isGreedy = g }
instance Read a => Read (Repeatable a) where
readsPrec _ s = case reads s of
[(base', s1)] -> (error . ("readsPrec Repeatable:\tparse-error; " ++) . show) `either` return $ Parsec.parse ((,) <$> repeatableParser base' <*> Parsec.getInput) "Repeatable" s1
_ -> []
showSuffix :: Repeatable a -> ShowS
showSuffix repeatable = let
showRange :: ShowS -> ShowS
showRange x = (\(begin, end) -> begin . x . end) $ ToolShed.Data.Pair.mirror showChar rangeDelimiters
in (
case repetitionBounds repeatable of
(0, Nothing) -> showChar zeroOrMoreToken
(1, Nothing) -> showChar oneOrMoreToken
(fewest, Nothing) -> showRange $ shows fewest . showChar rangeSeparatorToken
(0, Just 1) -> showChar zeroOrOneToken
(1, Just 1) -> id
(fewest, Just most) -> showRange $ if fewest == most
then shows fewest
else shows fewest . showChar rangeSeparatorToken . shows most
) . if ($ repeatable) `any` [isGreedy, isPrecise]
then id
else showChar nonGreedyToken
instance Show a => Show (Repeatable a) where
showsPrec _ repeatable = shows (base repeatable) . showSuffix repeatable
instance Consumer.Consumer a => Consumer.Consumer (Repeatable a) where
consumptionProfile MkRepeatable {
base = b,
repetitionBounds = (fewest, most)
} = baseConsumptionProfile {
ConsumptionProfile.consumptionBounds = (fewest *) *** ((*) <$> most <*>) $ ConsumptionProfile.consumptionBounds baseConsumptionProfile
} where
baseConsumptionProfile :: ConsumptionProfile.ConsumptionProfile
baseConsumptionProfile = Consumer.consumptionProfile b
starHeight MkRepeatable {
base = b,
repetitionBounds = r
} = Consumer.starHeight b + if hasPreciseBounds r then 0 else 1
instance ToolShed.SelfValidate.SelfValidator a => ToolShed.SelfValidate.SelfValidator (Repeatable a) where
getErrors MkRepeatable {
base = b,
repetitionBounds = (fewest, most),
isGreedy = g
}
| not $ ToolShed.SelfValidate.isValid b = ToolShed.SelfValidate.getErrors b
| otherwise = ToolShed.SelfValidate.extractErrors [
(fewest < 0, "Negative fewest=" ++ show fewest ++ "."),
(
case most of
Just m -> m < fewest
_ -> False,
"Invalid repetition-range; '" ++ show (fewest, most) ++ "'."
), (
not g && case most of
Just m -> fewest >= m
_ -> False,
"Invalid non-greedy repetition-range; '" ++ show (fewest, most) ++ "'."
)
]
instance Control.DeepSeq.NFData a => Control.DeepSeq.NFData (Repeatable a) where
rnf MkRepeatable {
base = b,
repetitionBounds = r,
isGreedy = g
} = Control.DeepSeq.rnf (b, r, g)
setNonGreedy :: Repeatable a -> Repeatable a
setNonGreedy r = r { isGreedy = False }
(^#->#)
:: a
-> RepetitionBounds
-> Repeatable a
b ^#-># bounds = MkRepeatable {
base = b,
repetitionBounds = bounds,
isGreedy = True
}
(^#->#?)
:: a
-> RepetitionBounds
-> Repeatable a
b ^#->#? bounds = setNonGreedy (b ^#-># bounds)
(^#->)
:: a
-> Repetitions
-> Repeatable a
b ^#-> fewest = b ^#-># (fewest, Nothing)
(^#->?)
:: a
-> Repetitions
-> Repeatable a
b ^#->? fewest = setNonGreedy (b ^#-> fewest)
(^#)
:: a
-> Repetitions
-> Repeatable a
b ^# r = b ^#-># precisely r
one :: a -> Repeatable a
one = (^# 1)
zeroOrOne :: a -> Repeatable a
zeroOrOne = (^#-># (0, Just 1))
zeroOrOne' :: a -> Repeatable a
zeroOrOne' = setNonGreedy . zeroOrOne
zeroOrMore :: a -> Repeatable a
zeroOrMore = (^#-> 0)
zeroOrMore' :: a -> Repeatable a
zeroOrMore' = setNonGreedy . zeroOrMore
oneOrMore :: a -> Repeatable a
oneOrMore = (^#-> 1)
oneOrMore' :: a -> Repeatable a
oneOrMore' = setNonGreedy . oneOrMore
focus :: Repeatable a -> Repetitions -> Repeatable a
focus r i = r { repetitionBounds = precisely i }
toSingleton :: Repeatable a -> Repeatable a
toSingleton = (`focus` 1)
getFewest :: Repeatable a -> Repetitions
getFewest MkRepeatable { repetitionBounds = (f, _) } = f
getMost :: Repeatable a -> Maybe Repetitions
getMost MkRepeatable { repetitionBounds = (_, m) } = m
nonGreedyToken :: Char
nonGreedyToken = '?'
zeroOrMoreToken :: Char
zeroOrMoreToken = '*'
zeroOrOneToken :: Char
zeroOrOneToken = '?'
oneOrMoreToken :: Char
oneOrMoreToken = '+'
rangeDelimiters :: (Char, Char)
rangeDelimiters = ('{', '}')
rangeSeparatorToken :: Char
rangeSeparatorToken = ','
tokens :: String
tokens = Data.List.nub [nonGreedyToken, zeroOrMoreToken, zeroOrOneToken, oneOrMoreToken, fst rangeDelimiters, snd rangeDelimiters, rangeSeparatorToken]