module Language.Lexer.Tlex.Syntax (
    Scanner (..),
    ScanRule (..),
    ScannerBuilder,
    ScannerBuilderContext,
    buildScanner,
    lexRule,
    Pattern.Pattern,
    Pattern.enumsP,
    Pattern.straightEnumSetP,
    anyoneP,
    maybeP,
    someP,
    manyP,
    orP,
    Pattern.StartState,
    Pattern.Accept (..),
    Pattern.AcceptPriority,
) where

import           Language.Lexer.Tlex.Prelude

import qualified Language.Lexer.Tlex.Data.SymEnumSet as SymEnumSet
import qualified Language.Lexer.Tlex.Machine.Pattern as Pattern


newtype Scanner unit action = Scanner
    { forall unit action. Scanner unit action -> [ScanRule unit action]
scannerRules :: [ScanRule unit action]
    }
    deriving (Scanner unit action -> Scanner unit action -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall unit action.
Eq action =>
Scanner unit action -> Scanner unit action -> Bool
/= :: Scanner unit action -> Scanner unit action -> Bool
$c/= :: forall unit action.
Eq action =>
Scanner unit action -> Scanner unit action -> Bool
== :: Scanner unit action -> Scanner unit action -> Bool
$c== :: forall unit action.
Eq action =>
Scanner unit action -> Scanner unit action -> Bool
Eq, Int -> Scanner unit action -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall unit action.
(Enum unit, Show unit, Show action) =>
Int -> Scanner unit action -> ShowS
forall unit action.
(Enum unit, Show unit, Show action) =>
[Scanner unit action] -> ShowS
forall unit action.
(Enum unit, Show unit, Show action) =>
Scanner unit action -> String
showList :: [Scanner unit action] -> ShowS
$cshowList :: forall unit action.
(Enum unit, Show unit, Show action) =>
[Scanner unit action] -> ShowS
show :: Scanner unit action -> String
$cshow :: forall unit action.
(Enum unit, Show unit, Show action) =>
Scanner unit action -> String
showsPrec :: Int -> Scanner unit action -> ShowS
$cshowsPrec :: forall unit action.
(Enum unit, Show unit, Show action) =>
Int -> Scanner unit action -> ShowS
Show, forall a b. a -> Scanner unit b -> Scanner unit a
forall a b. (a -> b) -> Scanner unit a -> Scanner unit b
forall unit a b. a -> Scanner unit b -> Scanner unit a
forall unit a b. (a -> b) -> Scanner unit a -> Scanner unit b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Scanner unit b -> Scanner unit a
$c<$ :: forall unit a b. a -> Scanner unit b -> Scanner unit a
fmap :: forall a b. (a -> b) -> Scanner unit a -> Scanner unit b
$cfmap :: forall unit a b. (a -> b) -> Scanner unit a -> Scanner unit b
Functor)

data ScanRule unit action = ScanRule
    { forall unit action. ScanRule unit action -> [StartState]
scanRuleStartStates    :: [Pattern.StartState]
    , forall unit action. ScanRule unit action -> Pattern unit
scanRulePattern        :: Pattern.Pattern unit
    , forall unit action. ScanRule unit action -> action
scanRuleSemanticAction :: action
    }
    deriving (ScanRule unit action -> ScanRule unit action -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall unit action.
Eq action =>
ScanRule unit action -> ScanRule unit action -> Bool
/= :: ScanRule unit action -> ScanRule unit action -> Bool
$c/= :: forall unit action.
Eq action =>
ScanRule unit action -> ScanRule unit action -> Bool
== :: ScanRule unit action -> ScanRule unit action -> Bool
$c== :: forall unit action.
Eq action =>
ScanRule unit action -> ScanRule unit action -> Bool
Eq, Int -> ScanRule unit action -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall unit action.
(Enum unit, Show unit, Show action) =>
Int -> ScanRule unit action -> ShowS
forall unit action.
(Enum unit, Show unit, Show action) =>
[ScanRule unit action] -> ShowS
forall unit action.
(Enum unit, Show unit, Show action) =>
ScanRule unit action -> String
showList :: [ScanRule unit action] -> ShowS
$cshowList :: forall unit action.
(Enum unit, Show unit, Show action) =>
[ScanRule unit action] -> ShowS
show :: ScanRule unit action -> String
$cshow :: forall unit action.
(Enum unit, Show unit, Show action) =>
ScanRule unit action -> String
showsPrec :: Int -> ScanRule unit action -> ShowS
$cshowsPrec :: forall unit action.
(Enum unit, Show unit, Show action) =>
Int -> ScanRule unit action -> ShowS
Show, forall a b. a -> ScanRule unit b -> ScanRule unit a
forall a b. (a -> b) -> ScanRule unit a -> ScanRule unit b
forall unit a b. a -> ScanRule unit b -> ScanRule unit a
forall unit a b. (a -> b) -> ScanRule unit a -> ScanRule unit b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ScanRule unit b -> ScanRule unit a
$c<$ :: forall unit a b. a -> ScanRule unit b -> ScanRule unit a
fmap :: forall a b. (a -> b) -> ScanRule unit a -> ScanRule unit b
$cfmap :: forall unit a b. (a -> b) -> ScanRule unit a -> ScanRule unit b
Functor)


buildScanner :: Enum unit
    => ScannerBuilder state unit action () -> Scanner unit action
buildScanner :: forall {k} unit (state :: k) action.
Enum unit =>
ScannerBuilder state unit action () -> Scanner unit action
buildScanner ScannerBuilder state unit action ()
builder = Scanner
    { $sel:scannerRules:Scanner :: [ScanRule unit action]
scannerRules = forall {k} (state :: k) unit action.
ScannerBuilderContext state unit action -> [ScanRule unit action]
unScannerBuilderContext
        do forall s a. State s a -> s -> s
execState ScannerBuilder state unit action ()
builder do forall {k} (state :: k) unit action.
[ScanRule unit action] -> ScannerBuilderContext state unit action
ScannerBuilderContext []
    }

newtype ScannerBuilderContext state unit action = ScannerBuilderContext
    { forall {k} (state :: k) unit action.
ScannerBuilderContext state unit action -> [ScanRule unit action]
unScannerBuilderContext :: [ScanRule unit action]
    }
    deriving (ScannerBuilderContext state unit action
-> ScannerBuilderContext state unit action -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (state :: k) unit action.
Eq action =>
ScannerBuilderContext state unit action
-> ScannerBuilderContext state unit action -> Bool
/= :: ScannerBuilderContext state unit action
-> ScannerBuilderContext state unit action -> Bool
$c/= :: forall k (state :: k) unit action.
Eq action =>
ScannerBuilderContext state unit action
-> ScannerBuilderContext state unit action -> Bool
== :: ScannerBuilderContext state unit action
-> ScannerBuilderContext state unit action -> Bool
$c== :: forall k (state :: k) unit action.
Eq action =>
ScannerBuilderContext state unit action
-> ScannerBuilderContext state unit action -> Bool
Eq, Int -> ScannerBuilderContext state unit action -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (state :: k) unit action.
(Enum unit, Show unit, Show action) =>
Int -> ScannerBuilderContext state unit action -> ShowS
forall k (state :: k) unit action.
(Enum unit, Show unit, Show action) =>
[ScannerBuilderContext state unit action] -> ShowS
forall k (state :: k) unit action.
(Enum unit, Show unit, Show action) =>
ScannerBuilderContext state unit action -> String
showList :: [ScannerBuilderContext state unit action] -> ShowS
$cshowList :: forall k (state :: k) unit action.
(Enum unit, Show unit, Show action) =>
[ScannerBuilderContext state unit action] -> ShowS
show :: ScannerBuilderContext state unit action -> String
$cshow :: forall k (state :: k) unit action.
(Enum unit, Show unit, Show action) =>
ScannerBuilderContext state unit action -> String
showsPrec :: Int -> ScannerBuilderContext state unit action -> ShowS
$cshowsPrec :: forall k (state :: k) unit action.
(Enum unit, Show unit, Show action) =>
Int -> ScannerBuilderContext state unit action -> ShowS
Show, forall k (state :: k) unit a b.
a
-> ScannerBuilderContext state unit b
-> ScannerBuilderContext state unit a
forall k (state :: k) unit a b.
(a -> b)
-> ScannerBuilderContext state unit a
-> ScannerBuilderContext state unit b
forall a b.
a
-> ScannerBuilderContext state unit b
-> ScannerBuilderContext state unit a
forall a b.
(a -> b)
-> ScannerBuilderContext state unit a
-> ScannerBuilderContext state unit b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b.
a
-> ScannerBuilderContext state unit b
-> ScannerBuilderContext state unit a
$c<$ :: forall k (state :: k) unit a b.
a
-> ScannerBuilderContext state unit b
-> ScannerBuilderContext state unit a
fmap :: forall a b.
(a -> b)
-> ScannerBuilderContext state unit a
-> ScannerBuilderContext state unit b
$cfmap :: forall k (state :: k) unit a b.
(a -> b)
-> ScannerBuilderContext state unit a
-> ScannerBuilderContext state unit b
Functor)

type ScannerBuilder state unit action = State (ScannerBuilderContext state unit action)

lexRule :: Enum state => Enum unit
    => [state] -> Pattern.Pattern unit -> action -> ScannerBuilder state unit action ()
lexRule :: forall state unit action.
(Enum state, Enum unit) =>
[state]
-> Pattern unit -> action -> ScannerBuilder state unit action ()
lexRule [state]
ss Pattern unit
p action
act = forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' \(ScannerBuilderContext [ScanRule unit action]
rs0) ->
    forall {k} (state :: k) unit action.
[ScanRule unit action] -> ScannerBuilderContext state unit action
ScannerBuilderContext
        do forall unit action.
[StartState] -> Pattern unit -> action -> ScanRule unit action
ScanRule [forall s. Enum s => s -> StartState
Pattern.startStateFromEnum state
s | state
s <- [state]
ss] Pattern unit
p action
actforall a. a -> [a] -> [a]
:[ScanRule unit action]
rs0


-- | Wildcard pattern which accepts an any unit.
anyoneP :: Enum unit => Pattern.Pattern unit
anyoneP :: forall unit. Enum unit => Pattern unit
anyoneP = forall e. SymEnumSet e -> Pattern e
Pattern.Range forall a. Enum a => SymEnumSet a
SymEnumSet.full

-- | Maybe pattern which accepts given pattern or nothing.
maybeP :: Enum unit => Pattern.Pattern unit -> Pattern.Pattern unit
maybeP :: forall unit. Enum unit => Pattern unit -> Pattern unit
maybeP Pattern unit
x = forall unit. Enum unit => [Pattern unit] -> Pattern unit
orP [Pattern unit
x, forall e. Pattern e
Pattern.Epsilon]

-- | Some pattern which accepts one given pattern or more times.
someP :: Enum unit => Pattern.Pattern unit -> Pattern.Pattern unit
someP :: forall unit. Enum unit => Pattern unit -> Pattern unit
someP Pattern unit
x = Pattern unit
x forall a. Semigroup a => a -> a -> a
<> forall e. Pattern e -> Pattern e
Pattern.Many Pattern unit
x

-- | Many pattern which accepts nothing or given pattern more times.
manyP :: Enum unit => Pattern.Pattern unit -> Pattern.Pattern unit
manyP :: forall unit. Enum unit => Pattern unit -> Pattern unit
manyP Pattern unit
x = forall e. Pattern e -> Pattern e
Pattern.Many Pattern unit
x

-- | Or pattern which accepts one of given patterns.
orP :: Enum unit => [Pattern.Pattern unit] -> Pattern.Pattern unit
orP :: forall unit. Enum unit => [Pattern unit] -> Pattern unit
orP = \case
  []   -> forall e. Pattern e
Pattern.Epsilon
  Pattern unit
p:[Pattern unit]
ps -> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall e. Pattern e -> Pattern e -> Pattern e
(Pattern.:|:) Pattern unit
p [Pattern unit]
ps
{-# INLINE orP #-}