{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE InstanceSigs #-}
module Language.Json (Value(..), null, true, false, boolean, buildInteger, number, document, PrintableValue(..)) where
import Data.Text (Text)
import Data.Array.IArray (Array)
import Numeric.Natural (Natural)
import Data.Map.Strict (Map)
import Language.Json.Parser (Parser)
import qualified Language.Json.Parser as Parser

import Prelude hiding (exponent, null)
import Control.Applicative ((<|>), Alternative (many), some)
import qualified Data.Char as Char
import qualified Data.List as List
import Data.Functor (($>))
import Data.Ratio ((%))
import qualified Data.Maybe as Maybe
import qualified Data.Text as Text
import qualified Data.Text.Internal.Read as Text
import qualified Debug.Trace as Debug
import qualified Data.Array.IArray as Array
import qualified Data.Map.Strict as Map
import GHC.Generics ( Generic, Generically(..) )
import Pretty.Serialize (PrettySerialize)
import Test.QuickCheck (Arbitrary (arbitrary), Gen, UnicodeString (getUnicodeString), PrintableString (getPrintableString))
import qualified Test.QuickCheck.Gen as Gen
import Data.Array.Arbitrary (ArbitraryArray(getArbitraryArray))


data Value
  = Null
  | String Text
  | Boolean Bool
  | Number Rational
  | Array (Array Natural Value)
  | Object (Map Text Value)
  deriving (Show, Generic, Eq, Ord)
  deriving PrettySerialize via Generically Value

-- generaty arbitrary values, for testing
instance Arbitrary Value where
  arbitrary :: Gen Value
  arbitrary = Gen.oneof
    [ pure Null
    , String . Text.pack . getUnicodeString <$> arbitrary
    , Boolean <$> arbitrary
    , Number <$> arbitrary
    , Array . getArbitraryArray <$> Gen.scale (`div` 2) arbitrary
    , Object . Map.mapKeys (Text.pack . getUnicodeString) <$> Gen.scale (`div` 2) arbitrary
    ]

newtype PrintableValue = PrintableValue Value
  deriving stock Show

instance Arbitrary PrintableValue where
  arbitrary :: Gen PrintableValue
  arbitrary = PrintableValue <$> Gen.oneof
    [ pure Null
    , String . Text.pack . getPrintableString <$> arbitrary
    , Boolean <$> arbitrary
    , Number <$> arbitrary
    , Array . getArbitraryArray <$> Gen.scale (`div` 2) arbitrary
    , Object . Map.mapKeys (Text.pack . getPrintableString) <$> Gen.scale (`div` 2) arbitrary
    ]

null :: Parser Value
null = do
  Parser.exact "null"
  whitespace
  pure Null

true :: Parser Bool
true = do
  Parser.exact "true"
  pure True

false :: Parser Bool
false = do
  Parser.exact "false"
  pure False

boolean :: Parser Bool
boolean = (true <|> false) <* whitespace

digit :: Parser Int
digit = Char.digitToInt <$> Parser.oneOf (Parser.char <$> ['0'..'9'])

onenine :: Parser Int
onenine = Char.digitToInt <$> Parser.oneOf (Parser.char <$> ['1'..'9'])

multiDigitNumber :: Parser Natural
multiDigitNumber = do
  firstDigit <- onenine
  rest <- many digit
  let allDigits = firstDigit : rest
  pure $! buildInteger allDigits

buildInteger :: [Int] -> Natural
buildInteger = List.foldl (\ acc x -> acc * 10 + fromIntegral x) 0

fraction :: Parser (Maybe Natural)
fraction = Parser.optional (buildInteger <$> (Parser.char '.' *> some digit))

data Sign
  = Positive
  | Negative

applySign :: Integral a => Sign -> a -> a
applySign = \case
  Positive -> id
  Negative -> negate

sign :: Parser Sign
sign = Parser.oneOf
  [ Parser.char '+' $> Positive
  , Parser.char '-' $> Negative
  , pure Positive
  ]

exponent :: Parser (Maybe Integer)
exponent = Parser.optional $ do
  _ <- Parser.oneOf (Parser.char <$> ['e', 'E'])
  applySign <$> sign <*> (fromIntegral <$> multiDigitNumber)

number :: Parser Rational
number = do
  factor <- sign
  integerPart <- multiDigitNumber <|> fromIntegral <$> digit
  decimalPart <- fraction
  power <- exponent

  let concatRational = case decimalPart of
        Nothing -> fromIntegral integerPart
        Just part -> let
         decimalPartLength = length . show $ part
         in fromIntegral (integerPart * 10 ^ decimalPartLength + part) % 10 ^ decimalPartLength

  whitespace
  pure $ concatRational * fromIntegral @Integer (applySign factor (10 ^ Maybe.fromMaybe 0 power))

-- >>> import Language.Json.Parser
-- >>> runParser number "1"
-- Just ("",Number (1 % 1))
-- >>> runParser number "1.5"
-- Just ("",Number (3 % 5))
-- >>> runParser number "1.5e1"
-- Just ("",Number (6 % 1))

string :: Parser Text
string = do
  _ <- Parser.exact "\""
  str <- many stringChar
  _ <- Parser.exact "\""
  whitespace

  pure $ Text.pack str

stringChar :: Parser Char
stringChar = Parser.oneOf
  [ Parser.char '\\' *> Parser.oneOf
    [ Parser.char '"'
    , Parser.char '\\'
    , Parser.char '/'
    , Parser.char 'b' $> '\b'
    , Parser.char 'f' $> '\f'
    , Parser.char 'n' $> '\b'
    , Parser.char 'r' $> '\r'
    , Parser.char 't' $> '\t'
    , Parser.char 'u' *> hexChar
    ]
  , Parser.satisfies isAllowedCodepoint
  ]

-- >>> import Language.Json.Parser
-- >>> runParser string "\"\\u000A\""
-- Just ("",String "\n")

buildBase16 :: String -> Int
buildBase16 = List.foldl' (\ acc x -> acc * 16 + Text.hexDigitToInt x) 0

hexChar :: Parser Char
hexChar = do
  digits <- 4 `Parser.times` Parser.satisfies Char.isHexDigit
  let base16 = buildBase16 $ Debug.traceShowId digits
  pure . toEnum $ Debug.traceShowId base16

isAllowedCodepoint :: Char -> Bool
isAllowedCodepoint = \case
  '"' -> False
  '\\' -> False
  x -> not . Char.isControl $ x

-- >>> fromEnum 'A'
-- 65
-- >>> toEnum 10 :: Char
-- '\n'

value :: Parser Value
value = Parser.oneOf
  [ null
  , Array <$> array
  , Object <$> object
  , Number <$> number
  , String <$> string
  , Boolean <$> boolean
  ]

document :: Parser Value
document = whitespace *> value <* whitespace <* Parser.eof

comma :: Parser Char
comma = Parser.char ',' <* whitespace

keyValue :: Parser (Text, Value)
keyValue = do
  -- name
  name <- string

  -- separator
  Parser.char ':' *> whitespace

  -- value
  val <- value

  -- result
  whitespace
  pure (name, val)

object :: Parser (Map Text Value)
object = do
  _ <- Parser.char '{'
  whitespace

  members <- keyValue `Parser.sepBy` comma

  _ <- Parser.char '}'
  whitespace
  pure $ Map.fromList members

whitespace :: Parser ()
whitespace = many (Parser.satisfies Char.isSpace) $> ()

array :: Parser (Array Natural Value)
array = do
  _ <- Parser.char '['

  whitespace
  elements <- value `Parser.sepBy` comma

  _ <- Parser.char ']'
  whitespace
  pure $ case elements of
    [] -> Array.listArray (1, 0) elements
    _  -> Array.listArray (0, fromIntegral $ length elements - 1) elements