{- |
Module      : Control.Lens.Grammar.Token
Description : lexical tokens
Copyright   : (C) 2026 - Eitan Chatav
License     : BSD-style (see the file LICENSE)
Maintainer  : Eitan Chatav <eitan.chatav@gmail.com>
Stability   : provisional
Portability : non-portable
-}

module Control.Lens.Grammar.Token
  ( -- * Tokenized
    Tokenized (..)
  , satisfy
  , tokens
    -- * Categorized
  , Categorized (..)
  , GeneralCategory (..)
  ) where

import Control.Lens
import Control.Lens.PartialIso
import Data.Char
import Data.Profunctor
import Data.Profunctor.Monoidal
import Data.Word

{- | `Categorized` provides a type family `Categorize`
and a function to `categorize` tokens into disjoint categories.

>>> :kind! Categorize Char
Categorize Char :: *
= GeneralCategory

>>> categorize 'a'
LowercaseLetter
-}
class (Ord token, Ord (Categorize token), Enum (Categorize token))
  => Categorized token where
  type Categorize token
  type Categorize token = ()
  categorize :: token -> Categorize token
  default categorize :: Categorize token ~ () => token -> Categorize token
  categorize token
_ = ()
instance Categorized Char where
  type Categorize Char = GeneralCategory
  categorize :: Char -> Categorize Char
categorize = Char -> GeneralCategory
Char -> Categorize Char
generalCategory
instance Categorized Word8
instance Categorized ()

{- | `Tokenized` combinators for constructing lexical tokens. -}
class Categorized token => Tokenized token p | p -> token where
  {- | Any single token. -}
  anyToken :: p

  {- | A single specified `token`. -}
  token :: token -> p
  default token
    :: (p ~ q token token, Choice q, Cochoice q)
    => token -> p
  token = (token -> Bool) -> q token token
forall a (p :: * -> * -> *).
(Tokenized a (p a a), Choice p, Cochoice p) =>
(a -> Bool) -> p a a
satisfy ((token -> Bool) -> q token token)
-> (token -> token -> Bool) -> token -> q token token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. token -> token -> Bool
forall token p. Tokenized token p => token -> p
token

  {- | A single token which is `oneOf` a set. -}
  oneOf :: Foldable f => f token -> p
  default oneOf
    :: (p ~ q token token, Choice q, Cochoice q, Foldable f)
    => f token -> p
  oneOf = (token -> Bool) -> q token token
forall a (p :: * -> * -> *).
(Tokenized a (p a a), Choice p, Cochoice p) =>
(a -> Bool) -> p a a
satisfy ((token -> Bool) -> q token token)
-> (f token -> token -> Bool) -> f token -> q token token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f token -> token -> Bool
forall token p (f :: * -> *).
(Tokenized token p, Foldable f) =>
f token -> p
forall (f :: * -> *). Foldable f => f token -> token -> Bool
oneOf

  {- | A single token which is `notOneOf` a set. -}
  notOneOf :: Foldable f => f token -> p
  default notOneOf
    :: (p ~ q token token, Choice q, Cochoice q, Foldable f)
    => f token -> p
  notOneOf = (token -> Bool) -> q token token
forall a (p :: * -> * -> *).
(Tokenized a (p a a), Choice p, Cochoice p) =>
(a -> Bool) -> p a a
satisfy ((token -> Bool) -> q token token)
-> (f token -> token -> Bool) -> f token -> q token token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f token -> token -> Bool
forall token p (f :: * -> *).
(Tokenized token p, Foldable f) =>
f token -> p
forall (f :: * -> *). Foldable f => f token -> token -> Bool
notOneOf

  {- | A single token which is `asIn` a category. -}
  asIn :: Categorize token -> p
  default asIn
    :: (p ~ q token token, Choice q, Cochoice q)
    => Categorize token -> p
  asIn = (token -> Bool) -> q token token
forall a (p :: * -> * -> *).
(Tokenized a (p a a), Choice p, Cochoice p) =>
(a -> Bool) -> p a a
satisfy ((token -> Bool) -> q token token)
-> (Categorize token -> token -> Bool)
-> Categorize token
-> q token token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Categorize token -> token -> Bool
forall token p. Tokenized token p => Categorize token -> p
asIn

  {- | A single token which is `notAsIn` a category. -}
  notAsIn :: Categorize token -> p
  default notAsIn
    :: (p ~ q token token, Choice q, Cochoice q)
    => Categorize token -> p
  notAsIn = (token -> Bool) -> q token token
forall a (p :: * -> * -> *).
(Tokenized a (p a a), Choice p, Cochoice p) =>
(a -> Bool) -> p a a
satisfy ((token -> Bool) -> q token token)
-> (Categorize token -> token -> Bool)
-> Categorize token
-> q token token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Categorize token -> token -> Bool
forall token p. Tokenized token p => Categorize token -> p
notAsIn

instance Categorized token => Tokenized token (token -> Bool) where
  anyToken :: token -> Bool
anyToken token
_ = Bool
True
  token :: token -> token -> Bool
token = token -> token -> Bool
forall a. Eq a => a -> a -> Bool
(==)
  oneOf :: forall (f :: * -> *). Foldable f => f token -> token -> Bool
oneOf = (token -> f token -> Bool) -> f token -> token -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip token -> f token -> Bool
forall a. Eq a => a -> f a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem
  notOneOf :: forall (f :: * -> *). Foldable f => f token -> token -> Bool
notOneOf = (token -> f token -> Bool) -> f token -> token -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip token -> f token -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem
  asIn :: Categorize token -> token -> Bool
asIn = (token -> Categorize token)
-> (Categorize token -> Bool) -> token -> Bool
forall a b c. (a -> b) -> (b -> c) -> a -> c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap token -> Categorize token
forall token. Categorized token => token -> Categorize token
categorize ((Categorize token -> Bool) -> token -> Bool)
-> (Categorize token -> Categorize token -> Bool)
-> Categorize token
-> token
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Categorize token -> Categorize token -> Bool
forall a. Eq a => a -> a -> Bool
(==)
  notAsIn :: Categorize token -> token -> Bool
notAsIn = (token -> Categorize token)
-> (Categorize token -> Bool) -> token -> Bool
forall a b c. (a -> b) -> (b -> c) -> a -> c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap token -> Categorize token
forall token. Categorized token => token -> Categorize token
categorize ((Categorize token -> Bool) -> token -> Bool)
-> (Categorize token -> Categorize token -> Bool)
-> Categorize token
-> token
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Categorize token -> Categorize token -> Bool
forall a. Eq a => a -> a -> Bool
(/=)

{- | A single token that satisfies a predicate. -}
satisfy
  :: (Tokenized a (p a a), Choice p, Cochoice p)
  => (a -> Bool) -> p a a
satisfy :: forall a (p :: * -> * -> *).
(Tokenized a (p a a), Choice p, Cochoice p) =>
(a -> Bool) -> p a a
satisfy a -> Bool
f = (a -> Bool) -> PartialIso' a a
forall a. (a -> Bool) -> PartialIso' a a
satisfied a -> Bool
f (PartialExchange a a a (Maybe a)
 -> PartialExchange a a a (Maybe a))
-> p a a -> p a a
forall (p :: * -> * -> *) s t a b.
(Choice p, Cochoice p) =>
APartialIso s t a b -> p a b -> p s t
>?< p a a
forall token p. Tokenized token p => p
anyToken

{- | A specified stream of `tokens`. -}
tokens
  :: ( Foldable f, Tokenized a (p a a)
     , Monoidal p, Choice p
     , AsEmpty s, Cons s s a a
     )
  => f a -> p s s
tokens :: forall (f :: * -> *) a (p :: * -> * -> *) s.
(Foldable f, Tokenized a (p a a), Monoidal p, Choice p, AsEmpty s,
 Cons s s a a) =>
f a -> p s s
tokens = (a -> p s s -> p s s) -> p s s -> f a -> p s s
forall a b. (a -> b -> b) -> b -> f a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (p a a -> p s s -> p s s
forall s t a b (p :: * -> * -> *).
(Cons s t a b, Monoidal p, Choice p) =>
p a b -> p s t -> p s t
(>:<) (p a a -> p s s -> p s s) -> (a -> p a a) -> a -> p s s -> p s s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> p a a
forall token p. Tokenized token p => token -> p
token) p s s
forall s (p :: * -> * -> *).
(AsEmpty s, Monoidal p, Choice p) =>
p s s
asEmpty