module Sasha (
    -- * Sasha the lexer

    -- | This is the ordinary Haskell (i.e. slow) interface.
    --
    -- The fast one is in "Sasha.TTH" module, but that requires @TemplateHaskell@.
    --
    Sasha,
    sasha,
    -- * ERE specification
    ERE,
    empty,
    eps,
    char,
    charRange,
    utf8Char,
    anyChar,
    anyUtf8Char,
    appends,
    unions,
    intersections,
    star,
    plus,
    string,
    utf8String,
    complement,
    satisfy,
    digit,
) where

import Control.Applicative ((<|>))
import Data.Maybe          (listToMaybe)
import Data.Word           (Word8)

import qualified Data.ByteString as BS

import Sasha.Internal.ERE

-- | Lexer grammar specification: tags and regular expressions.
type Sasha tag = [(tag, ERE)]

-- | Scan for a single token.
sasha
    :: forall tag. Sasha tag                      -- ^ scanner definition
    -> BS.ByteString                              -- ^ input
    -> Maybe (tag, BS.ByteString, BS.ByteString)  -- ^ matched token, consumed bytestring, left over bytestring
sasha :: forall tag.
Sasha tag -> ByteString -> Maybe (tag, ByteString, ByteString)
sasha Sasha tag
grammar ByteString
input0 = (tag, Int) -> (tag, ByteString, ByteString)
finish forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (tag, Int)
-> Int -> ByteString -> Sasha tag -> Maybe (tag, Int)
go forall a. Maybe a
Nothing Int
0 ByteString
input0 Sasha tag
grammar
  where
    finish :: (tag, Int) -> (tag, BS.ByteString, BS.ByteString)
    finish :: (tag, Int) -> (tag, ByteString, ByteString)
finish (tag
tag, Int
i) = case Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
i ByteString
input0 of
        (ByteString
pfx, ByteString
sfx) -> (tag
tag, ByteString
pfx, ByteString
sfx)

    go :: Maybe (tag, Int) -> Int -> BS.ByteString -> Sasha tag -> Maybe (tag, Int)
    go :: Maybe (tag, Int)
-> Int -> ByteString -> Sasha tag -> Maybe (tag, Int)
go Maybe (tag, Int)
acc !Int
_   ByteString
_       [] = Maybe (tag, Int)
acc
    go Maybe (tag, Int)
acc !Int
pfx ByteString
input   Sasha tag
ts = case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
input of
        Maybe (Word8, ByteString)
Nothing       -> Maybe (tag, Int)
acc
        Just (Word8
c, ByteString
sfx) -> Maybe (tag, Int)
-> Int -> ByteString -> Sasha tag -> Maybe (tag, Int)
go (Maybe (tag, Int)
acc' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (tag, Int)
acc) (Int
pfx forall a. Num a => a -> a -> a
+ Int
1) ByteString
sfx Sasha tag
ts'
          where
            ts' :: Sasha tag
ts' = forall tag. Word8 -> Sasha tag -> Sasha tag
derivativeSasha Word8
c Sasha tag
ts
            acc' :: Maybe (tag, Int)
acc' = forall a. [a] -> Maybe a
listToMaybe [ (tag
tag, Int
pfx forall a. Num a => a -> a -> a
+ Int
1) | (tag
tag, ERE
ere) <- Sasha tag
ts', ERE -> Bool
nullable ERE
ere]

derivativeSasha :: Word8 -> Sasha tag -> Sasha tag
derivativeSasha :: forall tag. Word8 -> Sasha tag -> Sasha tag
derivativeSasha Word8
c Sasha tag
ts =
    [ (tag
t, ERE
ere')
    | (tag
t, ERE
ere) <- Sasha tag
ts
    , let ere' :: ERE
ere' = Word8 -> ERE -> ERE
derivative Word8
c ERE
ere
    , Bool -> Bool
not (ERE -> Bool
isEmpty ERE
ere')
    ]