module Ast.Parser.Literal where

import qualified Ast.Parser.State as PS
import qualified Ast.Parser.Utils as PU
import qualified Ast.Types as AT
import qualified Control.Monad.State as S
import qualified Text.Megaparsec as M
import qualified Text.Megaparsec.Char as MC
import qualified Text.Megaparsec.Char.Lexer as ML

-- | Symbol for the boolean `true` literal.
trueSymbol :: String
trueSymbol :: String
trueSymbol = String
"true"

-- | Symbol for the boolean `false` literal.
falseSymbol :: String
falseSymbol :: String
falseSymbol = String
"false"

-- | Symbol for the `null` literal.
nullSymbol :: String
nullSymbol :: String
nullSymbol = String
"null"

-- | Parses a literal, which can be an array, character, float, integer, boolean, `null`, or a structure.
-- Returns the parsed `AT.Literal`.
parseLiteral :: PU.Parser AT.Literal
parseLiteral :: Parser Literal
parseLiteral = [Parser Literal] -> Parser Literal
forall a. [Parser a] -> Parser a
PU.triedChoice [Parser Literal
parseArray, Parser Literal
parseChar, Parser Literal
parseFloat, Parser Literal
parseInt, Parser Literal
parseBool, Parser Literal
parseNull, Parser Literal
parseStruct]

-- | Parses an integer literal, supporting signed values.
-- Returns a `Literal` of type `LInt`.
parseInt :: PU.Parser AT.Literal
parseInt :: Parser Literal
parseInt = Integer -> Literal
AT.LInt (Integer -> Literal)
-> ParsecT ParseErrorCustom String (StateT ParserState IO) Integer
-> Parser Literal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ParseErrorCustom String (StateT ParserState IO) ()
-> ParsecT ParseErrorCustom String (StateT ParserState IO) Integer
-> ParsecT ParseErrorCustom String (StateT ParserState IO) Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
ML.signed (() -> ParsecT ParseErrorCustom String (StateT ParserState IO) ()
forall a.
a -> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) ParsecT ParseErrorCustom String (StateT ParserState IO) Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
ML.decimal

-- | Parses a floating-point literal.
-- Returns a `Literal` of type `LFloat`.
parseFloat :: PU.Parser AT.Literal
parseFloat :: Parser Literal
parseFloat = do
  Double
decimal <-
    ParsecT ParseErrorCustom String (StateT ParserState IO) ()
-> ParsecT ParseErrorCustom String (StateT ParserState IO) Double
-> ParsecT ParseErrorCustom String (StateT ParserState IO) Double
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
ML.signed
      (() -> ParsecT ParseErrorCustom String (StateT ParserState IO) ()
forall a.
a -> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
      ( do
          Integer
wholePart <- ParsecT ParseErrorCustom String (StateT ParserState IO) Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
ML.decimal :: (PU.Parser Integer)
          String
fractionalPart <- Token String
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MC.char Char
Token String
',' ParsecT ParseErrorCustom String (StateT ParserState IO) Char
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
forall a b.
ParsecT ParseErrorCustom String (StateT ParserState IO) a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT ParseErrorCustom String (StateT ParserState IO) Char
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
M.some ParsecT ParseErrorCustom String (StateT ParserState IO) Char
ParsecT
  ParseErrorCustom String (StateT ParserState IO) (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
MC.digitChar
          let fractional :: Double
fractional = String -> Double
forall a. Read a => String -> a
read (String
"0." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fractionalPart) :: Double
          let value :: Double
value = Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
wholePart Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
fractional
          Double
-> ParsecT ParseErrorCustom String (StateT ParserState IO) Double
forall a.
a -> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Double
value
      )
  Maybe (Double -> Literal)
type' <- ParsecT
  ParseErrorCustom String (StateT ParserState IO) (Double -> Literal)
-> ParsecT
     ParseErrorCustom
     String
     (StateT ParserState IO)
     (Maybe (Double -> Literal))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
M.optional (ParsecT
   ParseErrorCustom String (StateT ParserState IO) (Double -> Literal)
 -> ParsecT
      ParseErrorCustom
      String
      (StateT ParserState IO)
      (Maybe (Double -> Literal)))
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) (Double -> Literal)
-> ParsecT
     ParseErrorCustom
     String
     (StateT ParserState IO)
     (Maybe (Double -> Literal))
forall a b. (a -> b) -> a -> b
$ [ParsecT
   ParseErrorCustom
   String
   (StateT ParserState IO)
   (Double -> Literal)]
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) (Double -> Literal)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
M.choice [Double -> Literal
AT.LDouble (Double -> Literal)
-> ParsecT ParseErrorCustom String (StateT ParserState IO) Char
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) (Double -> Literal)
forall a b.
a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
-> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token String
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MC.char Char
Token String
'd', Double -> Literal
AT.LFloat (Double -> Literal)
-> ParsecT ParseErrorCustom String (StateT ParserState IO) Char
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) (Double -> Literal)
forall a b.
a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
-> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token String
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MC.char Char
Token String
'f']
  case Maybe (Double -> Literal)
type' of
    Just Double -> Literal
t -> Literal -> Parser Literal
forall a.
a -> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Literal -> Parser Literal) -> Literal -> Parser Literal
forall a b. (a -> b) -> a -> b
$ Double -> Literal
t Double
decimal
    Maybe (Double -> Literal)
_ -> Literal -> Parser Literal
forall a.
a -> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Literal -> Parser Literal) -> Literal -> Parser Literal
forall a b. (a -> b) -> a -> b
$ Double -> Literal
AT.LDouble Double
decimal

-- | Parses a boolean literal (`true` or `false`).
-- Returns a `Literal` of type `LBool`.
parseBool :: PU.Parser AT.Literal
parseBool :: Parser Literal
parseBool = Bool -> Literal
AT.LBool (Bool -> Literal)
-> ParsecT ParseErrorCustom String (StateT ParserState IO) Bool
-> Parser Literal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ParseErrorCustom String (StateT ParserState IO) Bool
PU.parseBool

-- | Parses a character literal (e.g., 'a').
-- Returns a `Literal` of type `LChar`.
parseChar :: PU.Parser AT.Literal
parseChar :: Parser Literal
parseChar = Char -> Literal
AT.LChar (Char -> Literal)
-> ParsecT ParseErrorCustom String (StateT ParserState IO) Char
-> Parser Literal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ParseErrorCustom String (StateT ParserState IO) Char
-> ParsecT ParseErrorCustom String (StateT ParserState IO) Char
-> ParsecT ParseErrorCustom String (StateT ParserState IO) Char
-> ParsecT ParseErrorCustom String (StateT ParserState IO) Char
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
M.between (Token String
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MC.char Char
Token String
'\'') (Token String
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MC.char Char
Token String
'\'') ParsecT ParseErrorCustom String (StateT ParserState IO) Char
ParsecT
  ParseErrorCustom String (StateT ParserState IO) (Token String)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
M.anySingle

-- | Parses an array of literals.
-- Supports string literals as arrays of characters or standard arrays of literals.
-- Returns a `Literal` of type `LArray`.
parseArray :: PU.Parser AT.Literal
parseArray :: Parser Literal
parseArray =
  [Parser Literal] -> Parser Literal
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
M.choice
    [ Parser Literal
parseStringArray,
      Parser Literal
parseLiteralArray
    ]
  where
    parseStringArray :: Parser Literal
parseStringArray =
      [Literal] -> Literal
AT.LArray ([Literal] -> Literal)
-> (String -> [Literal]) -> String -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Literal) -> String -> [Literal]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Literal
AT.LChar
        (String -> Literal)
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> Parser Literal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ParseErrorCustom String (StateT ParserState IO) Char
-> ParsecT ParseErrorCustom String (StateT ParserState IO) Char
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
M.between (Token String
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MC.char Char
Token String
'\"') (Token String
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MC.char Char
Token String
'\"') (ParsecT ParseErrorCustom String (StateT ParserState IO) Char
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
M.many ParsecT ParseErrorCustom String (StateT ParserState IO) Char
PU.parseStringChar)

    parseLiteralArray :: Parser Literal
parseLiteralArray =
      [Literal] -> Literal
AT.LArray
        ([Literal] -> Literal)
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) [Literal]
-> Parser Literal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) [Literal]
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) [Literal]
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
M.between (String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
"[") (String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
"]") (Parser Literal
-> ParsecT ParseErrorCustom String (StateT ParserState IO) ()
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) [Literal]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
M.sepBy Parser Literal
parseLiteral ParsecT ParseErrorCustom String (StateT ParserState IO) ()
PU.sc)

-- | Parses a `null` literal.
-- Returns a `Literal` of type `LNull`.
parseNull :: PU.Parser AT.Literal
parseNull :: Parser Literal
parseNull = Literal
AT.LNull Literal
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> Parser Literal
forall a b.
a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
-> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
nullSymbol

-- | Parses a structure literal, which includes a name and fields.
-- Fields are key-value pairs where the key is a field name and the value is a literal.
-- Returns a `Literal` of type `LStruct`.
parseStruct :: PU.Parser AT.Literal
parseStruct :: Parser Literal
parseStruct = do
  String
name <- ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
forall a. Parser a -> Parser a
PU.lexeme ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.identifier
  [(String, Literal)]
fields <- ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) [(String, Literal)]
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) [(String, Literal)]
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
M.between (String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
"{") (String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
"}") (ParsecT
   ParseErrorCustom String (StateT ParserState IO) [(String, Literal)]
 -> ParsecT
      ParseErrorCustom
      String
      (StateT ParserState IO)
      [(String, Literal)])
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) [(String, Literal)]
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) [(String, Literal)]
forall a b. (a -> b) -> a -> b
$ ParsecT
  ParseErrorCustom String (StateT ParserState IO) (String, Literal)
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) [(String, Literal)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
M.some ParsecT
  ParseErrorCustom String (StateT ParserState IO) (String, Literal)
parseField
  ParserState
state <- ParsecT ParseErrorCustom String (StateT ParserState IO) ParserState
forall s (m :: * -> *). MonadState s m => m s
S.get
  case String -> ParserState -> Maybe Type
PS.lookupType String
name ParserState
state of
    (Just Type
_) -> Literal -> Parser Literal
forall a.
a -> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Literal -> Parser Literal) -> Literal -> Parser Literal
forall a b. (a -> b) -> a -> b
$ [(String, Literal)] -> Literal
AT.LStruct [(String, Literal)]
fields
    Maybe Type
_ -> ParseErrorCustom -> Parser Literal
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
M.customFailure (ParseErrorCustom -> Parser Literal)
-> ParseErrorCustom -> Parser Literal
forall a b. (a -> b) -> a -> b
$ String -> ParseErrorCustom
PU.UnknownType String
name
  where
    parseField :: ParsecT
  ParseErrorCustom String (StateT ParserState IO) (String, Literal)
parseField = (,) (String -> Literal -> (String, Literal))
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT
     ParseErrorCustom
     String
     (StateT ParserState IO)
     (Literal -> (String, Literal))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
forall a. Parser a -> Parser a
PU.lexeme ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.identifier ParsecT
  ParseErrorCustom
  String
  (StateT ParserState IO)
  (Literal -> (String, Literal))
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
-> ParsecT
     ParseErrorCustom
     String
     (StateT ParserState IO)
     (Literal -> (String, Literal))
forall a b.
ParsecT ParseErrorCustom String (StateT ParserState IO) a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
-> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) String
PU.symbol String
"=" ParsecT
  ParseErrorCustom
  String
  (StateT ParserState IO)
  (Literal -> (String, Literal))
-> Parser Literal
-> ParsecT
     ParseErrorCustom String (StateT ParserState IO) (String, Literal)
forall a b.
ParsecT ParseErrorCustom String (StateT ParserState IO) (a -> b)
-> ParsecT ParseErrorCustom String (StateT ParserState IO) a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Literal -> Parser Literal
forall a. Parser a -> Parser a
PU.lexeme Parser Literal
parseLiteral