{-# LANGUAGE DeriveLift, DeriveAnyClass, DeriveGeneric, OverloadedStrings #-}
{-|
  Module      : Language.ANTLR4.Boot.Syntax
  Description : Both the boot and core syntax data types for G4
  Copyright   : (c) Karl Cronburg, 2018
  License     : BSD3
  Maintainer  : karl@cs.tufts.edu
  Stability   : experimental
  Portability : POSIX
-}
module Language.ANTLR4.Boot.Syntax
  ( G4(..), PRHS(..), ProdElem(..), GAnnot(..)
  , Directive(..)
  , LRHS(..), Regex(..), isGTerm, isGNonTerm
  , TermAnnot(..), isMaybeAnnot, isNoAnnot, annot
  , prodElemSymbol
  ) where
import Text.ANTLR.Grammar ()
import Language.Haskell.TH.Lift (Lift(..))

import Language.Haskell.TH.Syntax (Exp)
import qualified Language.Haskell.TH.Syntax as S

import Text.ANTLR.Set ( Hashable(..), Generic(..) )
import Text.ANTLR.Pretty -- (rshow, Prettify(..), pStr, pshow, pStr')

-- | .g4 style syntax representation
data G4 = -- | Grammar name declaration in g4
          Grammar { gName :: String -- ^ Name
                  }
        -- | One or more g4 productions
        | Prod { pName    :: String -- ^ Production's name
               , patterns :: [PRHS] -- ^ List of rules to match on
               }
        -- | A single, possibly annotated, g4 lexical rule
        | Lex  { annotation :: Maybe GAnnot -- ^ Lexical annotation (@fragment@)
               , lName      :: String       -- ^ Lexical rule name
               , pattern    :: LRHS         -- ^ The regex to match on
               }
  deriving (Show, Eq, Lift, Generic, Hashable)

instance Prettify G4 where
  prettify (Grammar gn) = do
    pStr "grammar "
    pStr' gn
  prettify (Prod n ps) = do
    pStr' n
    pStr " -> "
    incrIndent $ length n + 4
    pListLines ps
    incrIndent $ 0 - (length n + 4)
  prettify (Lex annot ln (LRHS regex dir)) = do
    pStr' ln
    pStr " -> "
    incrIndent $ length ln + 4
    prettify regex
    incrIndent $ 0 - (length ln + 4)
    pStr "("
    prettify dir
    pStr ")"


instance Lift Exp

-- | The right-hand side of a G4 production rule.
data PRHS = PRHS
  { alphas      :: [ProdElem] -- ^ In-order list of elements defining this rule
  , pred        :: Maybe Exp  -- ^ Arbitrary boolean predicate to test whether or not this rule should fire
  , mutator     :: Maybe Exp  -- ^ Arbitrary mutator to run when this rule fires
  , pDirective  :: Maybe Directive -- ^ How to construct a Haskell type when this rules fires
  } deriving (Show, Eq, Lift, Generic)

instance Prettify PRHS where
  prettify (PRHS as pred mut pDir) = do
    prettify as
    pStr "("
    pStr' $ show pred; pStr ","
    pStr' $ show mut;  pStr ","
    prettify pDir; pStr ")"

-- | Antiquoted (or g4-embedded) string that goes to the right of an arrow in
--   a g4 production rule. This specifies how to construct a Haskell type.
data Directive =
    UpperD String       -- ^ Probably a Haskell data constructor
  | LowerD String       -- ^ Probably just a Haskell function to call
  | HaskellD String     -- ^ Arbitrary antiquoted Haskell code embedded in the G4 grammar
  deriving (Show, Eq, Ord, Lift, Generic, Hashable)

instance Prettify Directive where prettify = rshow

instance Hashable PRHS where
  hashWithSalt salt prhs = salt `hashWithSalt` alphas prhs

-- | Annotations on a term (nonterminal or terminal) for extending our G4
--   BNF-like syntax with regular expression modifiers.
data TermAnnot =
    Regular Char -- ^ Regular expression modifier (e.g. +, ?, *)
  | NoAnnot      -- ^ Term is not annotated with anything
  deriving (Show, Eq, Ord, Lift, Generic, Hashable)

instance Prettify TermAnnot where
  prettify NoAnnot = return ()
  prettify (Regular c) = pStr' [c]

-- | Get the annotation from a 'ProdElem'
annot :: ProdElem -> TermAnnot
annot (GTerm a _) = a
annot (GNonTerm a _) = a

-- | Is this 'TermAnnot' a maybe?
isMaybeAnnot :: TermAnnot -> Bool
isMaybeAnnot (Regular '?') = True
isMaybeAnnot _             = False

-- | Does this 'TermAnnot' have no annotation?
isNoAnnot :: TermAnnot -> Bool
isNoAnnot NoAnnot = True
isNoAnnot _       = False

-- | A single production element with any accompanying regex annotation
data ProdElem =
    GTerm     TermAnnot String -- ^ G4 terminal
  | GNonTerm  TermAnnot String -- ^ G4 nonterminal
  deriving (Show, Eq, Ord, Lift, Generic, Hashable)

instance Prettify ProdElem where
  prettify (GTerm annot s) = do
    pStr' s
    prettify annot
  prettify (GNonTerm annot s) = do
    pStr' s
    prettify annot

prodElemSymbol (GTerm _ s) = s
prodElemSymbol (GNonTerm _ s) = s

-- | Is this a terminal G4 element?
isGTerm (GTerm _ _) = True
isGTerm _           = False

-- | Is this a nonterminal G4 element?
isGNonTerm (GNonTerm _ _) = True
isGNonTerm _              = False

-- | Allowable annotations on a lexical production rule
data    GAnnot   = Fragment -- ^ For now the only annotation is @fragment@.
  deriving (Show, Eq, Lift, Generic, Hashable)

-- | Right-hand side of a lexical G4 rule
data LRHS = LRHS
  { regex     :: Regex Char      -- ^ A regular expression over characters as tokens.
  , directive :: Maybe Directive -- ^ Optional directive: @Nothing@ is equivalent to @(Just "String")@.
  }
  deriving (Show, Eq, Lift, Generic, Hashable)

-- | G4 representation of a regex (G4 regex syntax, not regexs used by tokenizer)
data Regex s =
    Epsilon              -- ^ Consume no input
  | Literal    [s]       -- ^ Match on a literal string (sequence of characters)
  | Union      [Regex s] -- ^ Match on any
  | Concat     [Regex s] -- ^ Match in sequence
  | Kleene     (Regex s) -- ^ Match zero or more times
  | PosClos    (Regex s) -- ^ Match one or more times
  | Question   (Regex s) -- ^ Match zero or one time.
  | CharSet    [s]       -- ^ Match once on any of the characters
  | Negation   (Regex s) -- ^ Match anything that doesn't match this
  | Named      String    -- ^ A reference to some other regex (need to track an environment)
  deriving (Lift, Eq, Show, Generic, Hashable)
-- TODO: Lex regexs (e.g. complement sets, escape chars, ...)
-- TODO: Set s, and ranges of characters

instance (Show s, Prettify s) => Prettify (Regex s) where
  prettify Epsilon = pStr "ε"
  prettify (Literal ss) = do
    pStr "\""
    mapM prettify ss
    pStr "\""
  prettify rest = pStr' $ show rest