{- |
Module      : Control.Lens.Grammar.Symbol
Description : terminal & nonterminal symbols
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.Symbol
  ( -- * Symbol
    TerminalSymbol (..)
  , NonTerminalSymbol (..)
  ) where

import Control.Lens
import Control.Lens.PartialIso
import Control.Lens.Grammar.Token
import Data.Bifunctor.Joker
import Data.Profunctor
import Data.Profunctor.Monoidal
import Text.ParserCombinators.ReadP (ReadP, string)

-- | A `terminal` symbol in a grammar.
class TerminalSymbol token s | s -> token where
  terminal :: [token] -> s
  default terminal
    :: (p () () ~ s, Tokenized token (p token token), Monoidal p, Choice p, Cochoice p)
    => [token] -> s
  terminal [token]
str = [token] -> Prism' [token] ()
forall a. Eq a => a -> Prism' a ()
only [token]
str (Market () () () (Identity ())
 -> Market () () [token] (Identity [token]))
-> p [token] [token] -> p () ()
forall (p :: * -> * -> *) b a t s.
Cochoice p =>
APrism b a t s -> p a b -> p s t
?< [token] -> p [token] [token]
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 [token]
str

-- | A `nonTerminal` symbol in a grammar.
class NonTerminalSymbol s where
  nonTerminal :: String -> s

-- instances
instance TerminalSymbol token (f ())
  => TerminalSymbol token (Joker f () ()) where
    terminal :: [token] -> Joker f () ()
terminal = f () -> Joker f () ()
forall {k} {k1} (g :: k -> *) (a :: k1) (b :: k).
g b -> Joker g a b
Joker (f () -> Joker f () ())
-> ([token] -> f ()) -> [token] -> Joker f () ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall token s. TerminalSymbol token s => [token] -> s
terminal @token
instance TerminalSymbol Char (ReadP ()) where
  terminal :: [Char] -> ReadP ()
terminal [Char]
str = [Char] -> ReadP [Char]
string [Char]
str ReadP [Char] -> ReadP () -> ReadP ()
forall a b. ReadP a -> ReadP b -> ReadP b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> () -> ReadP ()
forall a. a -> ReadP a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()