{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies      #-}

module Data.Morpheus.Parsing.Internal.Value
  ( parseValue
  , enumValue
  , parseDefaultValue
  )
where

import           Data.Functor                   ( ($>) )
import           Data.Text                      ( pack )
import           Text.Megaparsec                ( anySingleBut
                                                , between
                                                , choice
                                                , label
                                                , many
                                                , optional
                                                , sepBy
                                                , (<|>)
                                                )
import           Text.Megaparsec.Char           ( char
                                                , string
                                                )
import           Text.Megaparsec.Char.Lexer     ( scientific )

--
-- MORPHEUS
import           Data.Morpheus.Parsing.Internal.Internal
                                                ( Parser )
import           Data.Morpheus.Parsing.Internal.Terms
                                                ( litEquals
                                                , parseAssignment
                                                , setOf
                                                , spaceAndComments
                                                , token
                                                )
import           Data.Morpheus.Types.Internal.AST
                                                ( ScalarValue(..)
                                                , Value(..)
                                                , decodeScientific
                                                )

parseDefaultValue :: Parser (Maybe Value)
parseDefaultValue = optional $ do
  litEquals
  parseValue

parseValue :: Parser Value
parseValue = label "value" $ do
  value <-
    valueNull
    <|> booleanValue
    <|> valueNumber
    <|> enumValue
    <|> stringValue
    <|> objectValue
    <|> listValue
  spaceAndComments
  return value

valueNull :: Parser Value
valueNull = string "null" $> Null

booleanValue :: Parser Value
booleanValue = boolTrue <|> boolFalse
 where
  boolTrue  = string "true" $> Scalar (Boolean True)
  boolFalse = string "false" $> Scalar (Boolean False)

valueNumber :: Parser Value
valueNumber = Scalar . decodeScientific <$> scientific

enumValue :: Parser Value
enumValue = do
  enum <- Enum <$> token
  spaceAndComments
  return enum

escaped :: Parser Char
escaped = label "escaped" $ do
  x <- anySingleBut '\"'
  if x == '\\' then choice (zipWith escapeChar codes replacements) else pure x
 where
  replacements = ['\b', '\n', '\f', '\r', '\t', '\\', '\"', '/']
  codes        = ['b', 'n', 'f', 'r', 't', '\\', '\"', '/']
  escapeChar code replacement = char code >> return replacement

stringValue :: Parser Value
stringValue = label "stringValue" $ Scalar . String . pack <$> between
  (char '"')
  (char '"')
  (many escaped)

listValue :: Parser Value
listValue = label "listValue" $ List <$> between
  (char '[' *> spaceAndComments)
  (char ']' *> spaceAndComments)
  (parseValue `sepBy` (char ',' *> spaceAndComments))

objectValue :: Parser Value
objectValue = label "objectValue" $ Object <$> setOf entry
  where entry = parseAssignment token parseValue