content: {-# LANGUAGE CPP #-}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE TypeFamilies #-}
  {-# LANGUAGE NoImplicitPrelude #-}
  
  module Data.Morpheus.Parsing.Internal.Value
    ( enumValue,
      parseDefaultValue,
      Parse (..),
    )
  where
  
  import Data.Morpheus.Parsing.Internal.Internal
    ( Parser,
    )
  import Data.Morpheus.Parsing.Internal.Terms
    ( brackets,
      colon,
      equal,
      ignoredTokens,
      parseName,
      parseString,
      parseTypeName,
      setOf,
      symbol,
      variable,
    )
  import Data.Morpheus.Types.Internal.AST
    ( CONST,
      FieldName,
      ObjectEntry (..),
      OrdMap,
      RAW,
      ScalarValue (..),
      Value (..),
      decodeScientific,
    )
  import Relude
  import Text.Megaparsec
    ( label,
      sepBy,
    )
  import Text.Megaparsec.Byte
    ( string,
    )
  import Text.Megaparsec.Byte.Lexer (scientific)
  
  -- '-'
  #define MINUS 45
  
  valueNull :: Parser (Value a)
  valueNull = string "null" $> Null
  {-# INLINE valueNull #-}
  
  booleanValue :: Parser (Value a)
  booleanValue =
    Scalar
      . Boolean
      <$> ( string "true"
              $> True
              <|> string "false"
              $> False
          )
  {-# INLINE booleanValue #-}
  
  valueNumber :: Parser (Value a)
  valueNumber = Scalar . decodeScientific <$> ((*) <$> negation <*> scientific)
    where
      negation = (symbol MINUS $> (-1) <* ignoredTokens) <|> pure 1
      {-# INLINE negation #-}
  {-# INLINE valueNumber #-}
  
  enumValue :: Parser (Value a)
  enumValue = Enum <$> parseTypeName <* ignoredTokens
  {-# INLINE enumValue #-}
  
  stringValue :: Parser (Value a)
  stringValue = Scalar . String <$> parseString
  {-# INLINE stringValue #-}
  
  listValue :: Parser a -> Parser [a]
  listValue parser = label "List" $ brackets (parser `sepBy` ignoredTokens)
  {-# INLINE listValue #-}
  
  objectEntry :: Parser (Value a) -> Parser (ObjectEntry a)
  objectEntry parser = ObjectEntry <$> (parseName <* colon) <*> parser
  {-# INLINE objectEntry #-}
  
  objectValue :: Parser (Value a) -> Parser (OrdMap FieldName (ObjectEntry a))
  objectValue = label "ObjectValue" . setOf . objectEntry
  {-# INLINE objectValue #-}
  
  parsePrimitives :: Parser (Value a)
  parsePrimitives =
    valueNull
      <|> booleanValue
      <|> valueNumber
      <|> enumValue
      <|> stringValue
  {-# INLINE parsePrimitives #-}
  
  parseDefaultValue :: Parser (Value s)
  parseDefaultValue = equal *> parseV
    where
      parseV :: Parser (Value s)
      parseV = compoundValue parseV
  
  class Parse a where
    parse :: Parser a
  
  instance Parse (Value RAW) where
    parse = (VariableValue <$> variable) <|> compoundValue parse
  
  instance Parse (Value CONST) where
    parse = compoundValue parse
  
  compoundValue :: Parser (Value a) -> Parser (Value a)
  compoundValue parser =
    label "Value"
      $ ( parsePrimitives
            <|> (Object <$> objectValue parser)
            <|> (List <$> listValue parser)
        )
      <* ignoredTokens
  