import type { Parser } from "Parse"

import Dictionary from "Dictionary"
import { Left, Right } from "Either"
import List from "List"
import Parse from "Parse"
import PP from "PrettyPrint"
import String from "String"
import Terminal from "Terminal"
import Tuple from "Tuple"



type Value
  = Constructor(String, List Value)
  | Unit
  | Record(Dictionary String Value)
  | Integer(String)
  | Float(String)
  | Boolean(String)
  | Char(String)
  | Str(String)
  | DictionaryConstructor(Dictionary Value Value)
  | ListConstructor(List Value)
  | TupleConstructor(List Value)
  | Byte(String)
  | ByteArray(List Value)

derive Comparable Value


maybeMinus :: Parser (List Char)
maybeMinus = map(of, Parse.char('-')) <|> pure([])

// -------- Byte ------------------------------------------

BYTE_CHARS = ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F']

_byte = do {
  char1 <- Parse.oneOf(BYTE_CHARS)
  char2 <- Parse.oneOf(BYTE_CHARS)

  return of(Byte(String.fromList([char1, char2])))
}

byte :: Parser Value
byte = Parse.token(_byte)


// -------- Integer ---------------------------------------

integer :: Parser Value
integer = do {
  minus <- maybeMinus
  digits <- Parse.some(Parse.digit)

  return pipe(
    String.fromList,
    Integer,
    of,
  )([...minus, ...digits])
}


integerOrByte :: Parser Value
integerOrByte = do {
  minus <- maybeMinus
  digits <- Parse.some(Parse.oneOf(BYTE_CHARS))

  return pipe(
    String.fromList,
    Integer,
    of,
  )([...minus, ...digits])
}


// -------- Float -----------------------------------------

float :: Parser Value
float = do {
  minus <- maybeMinus
  before <- Parse.some(Parse.digit)
  dot <- Parse.char('.')
  after <- Parse.some(Parse.digit)

  return pipe(
    String.fromList,
    Float,
    of,
  )([...minus, ...before, dot, ...after])
}


// -------- Boolean ---------------------------------------

boolean :: Parser Value
boolean = pipe(
  alt(Parse.string("false")),
  map(Boolean),
)(Parse.string("true"))


escapedChar :: Parser String
escapedChar = do {
  backslash <- Parse.char('\\')
  escaped <- Parse.anyChar

  return pipe(
    String.fromList,
    of,
  )([backslash, escaped])
}


// -------- Char ------------------------------------------

char :: Parser Value
char = do {
  _ <- Parse.char('\'')
  c <- pipe(
    map((c) => show(c)),
    alt($, map((c) => `'${c}'`, escapedChar)),
  )(Parse.notOneOf(['\'', '\\']))

  _ <- Parse.char('\'')

  return pipe(
    Char,
    of,
  )(c)
}


// -------- String ----------------------------------------

string :: Parser Value
string = do {
  _ <- Parse.char('"')
  content <- pipe(
    map(String.singleton),
    alt($, escapedChar),
    Parse.many,
    map(List.reduce(mappend, "")),
    map((s) => `"${s}"`),
  )(Parse.notOneOf(['"', '\\']))
  _ <- Parse.char('"')

  return pipe(
    Str,
    of,
  )(content)
}


// -------- Unit ------------------------------------------

unit :: Parser Value
unit = map(() => Unit, Parse.symbol("{}"))



alphaNumericalName :: Parser String
alphaNumericalName = do {
  firstChar <- Parse.letter
  rest <- Parse.many(Parse.choice([Parse.letter, Parse.digit]))

  return pipe(
    String.fromList,
    of,
  )([firstChar, ...rest])
}

alphaNumericalNameWithUnderscores :: Parser String
alphaNumericalNameWithUnderscores = do {
  firstChar <- Parse.letter
  rest <- Parse.many(Parse.choice([Parse.letter, Parse.digit, Parse.char('_')]))

  return pipe(
    String.fromList,
    of,
  )([firstChar, ...rest])
}


// -------- Constructor -----------------------------------

constructor :: Parser Value
constructor = do {
  nary = do {
    name <- alphaNumericalName
    _ <- Parse.symbol("(")
    args <- Parse.maybeSepBy(value, Parse.symbol(","))
    _ <- Parse.symbol(")")

    return of(Constructor(name, args))
  }

  nullary = do {
    name <- alphaNumericalName
    return of(Constructor(name, []))
  }

  return nary <|> nullary
}


// -------- ByteArray -------------------------------------

byteArray :: Parser Value
byteArray = do {
  name <- Parse.string("ByteArray")
  _ <- Parse.symbol("(")
  args <- Parse.many(Parse.token(byte))
  _ <- Parse.symbol(")")

  return of(ByteArray(args))
}


// -------- Record ----------------------------------------

recordField :: Parser #[String, Value]
recordField = do {
  fieldName <- Parse.token(alphaNumericalNameWithUnderscores)
  _ <- Parse.symbol(":")
  fieldValue <- Parse.token(value)

  return of(#[fieldName, fieldValue])
}


record :: Parser Value
record = do {
  _ <- Parse.symbol("{")
  fields <- Parse.sepBy(recordField, Parse.symbol(","))
  _ <- Parse.symbol(",") <|> pure("")
  _ <- Parse.symbol("}")

  return pipe(
    Dictionary.fromList,
    Record,
    of,
  )(fields)
}


// -------- Dictionary ------------------------------------

dictionaryField :: Parser #[Value, Value]
dictionaryField = do {
  fieldKey <- Parse.token(Parse.lazy(() => value))
  _ <- Parse.symbol(":")
  fieldValue <- Parse.token(value)

  return of(#[fieldKey, fieldValue])
}

dictionary :: Parser Value
dictionary = do {
  _ <- Parse.symbol("{{")
  fields <- Parse.maybeSepBy(dictionaryField, Parse.symbol(","))
  _ <- Parse.symbol(",") <|> pure("")
  _ <- Parse.symbol("}}")

  return pipe(
    Dictionary.fromList,
    DictionaryConstructor,
    of,
  )(fields)
}


// -------- List ------------------------------------------

list :: Parser Value
list = do {
  _ <- Parse.symbol("[")
  items <- Parse.maybeSepBy(value, Parse.symbol(","))
  _ <- Parse.symbol("]")
  return pipe(
    ListConstructor,
    of,
  )(items)
}


// -------- Tuple -----------------------------------------

tuple :: Parser Value
tuple = do {
  _ <- Parse.symbol("#[")
  items <- Parse.maybeSepBy(value, Parse.symbol(","))
  _ <- Parse.symbol("]")
  return pipe(
    TupleConstructor,
    of,
  )(items)
}


// -------- Value -----------------------------------------

value :: Parser Value
value = Parse.choice([
  unit,
  boolean,
  char,
  string,
  byteArray,
  constructor,
  float,
  integerOrByte,
  integer,
  byte,
  tuple,
  list,
  dictionary,
  record,
])


valueToDoc :: Boolean -> Value -> PP.Doc
valueToDoc = (colored, v) => where(v) {
  Unit =>
    PP.text("{}")

  Integer(i) =>
    colored ? PP.textWithLength(String.length(i), Terminal.text.brightYellow(i)) : PP.text(i)

  Float(f) =>
    colored ? PP.textWithLength(String.length(f), Terminal.text.brightYellow(f)) : PP.text(f)

  Byte(b) =>
    colored ? PP.textWithLength(2, Terminal.text.brightYellow(b)) : PP.text(b)

  Boolean(b) =>
    colored ? PP.textWithLength(String.length(b), Terminal.text.brightYellow(b)) : PP.text(b)

  Char(c) =>
    colored ? PP.textWithLength(String.length(c), Terminal.text.brightCyan(c)) : PP.text(c)

  Str(s) =>
    colored ? PP.textWithLength(String.length(s), Terminal.text.brightCyan(s)) : PP.text(s)

  Constructor(n, args) =>
    if (List.isEmpty(args)) {
      PP.text(n)
    } else {
      PP.group(
        PP.hcat([
          PP.text(n),
          PP.text("("),
          PP.nest(
            2,
            PP.hcat([
              PP.linebreak,
              PP.sepBy(PP.hcat([PP.comma, PP.line]), map(valueToDoc(colored), args)),
            ]),
          ),
          PP.linebreak,
          PP.text(")"),
        ]),
      )
    }

  ByteArray(bytes) =>
    do {
      groupBytes :: List Value -> List PP.Doc -> List PP.Doc
      groupBytes = (bs, result) => if (List.isEmpty(bs)) {
        result
      } else do {
        currentGroup = pipe(
          List.take(8),
          map(valueToDoc(colored)),
          PP.hcat,
        )(bs)

        return List.isEmpty(result)
          ? groupBytes(List.drop(8, bs), [currentGroup])
          : groupBytes(List.drop(8, bs), [...result, currentGroup])
      }

      return PP.group(
        PP.hcat([
          PP.text("ByteArray"),
          PP.text("("),
          PP.nest(2, PP.hcat([PP.linebreak, PP.sepBy(PP.softline, groupBytes(bytes, []))])),
          PP.linebreak,
          PP.text(")"),
        ]),
      )
    }

  ListConstructor(items) =>
    PP.group(
      PP.hcat([
        PP.lbracket,
        PP.nest(
          2,
          PP.hcat([
            PP.linebreak,
            PP.sepBy(PP.hcat([PP.comma, PP.line]), map(valueToDoc(colored), items)),
          ]),
        ),
        PP.linebreak,
        PP.rbracket,
      ]),
    )

  TupleConstructor(items) =>
    PP.group(
      PP.hcat([
        PP.text("#"),
        PP.lbracket,
        PP.nest(
          2,
          PP.hcat([
            PP.linebreak,
            PP.sepBy(PP.hcat([PP.comma, PP.line]), map(valueToDoc(colored), items)),
          ]),
        ),
        PP.linebreak,
        PP.rbracket,
      ]),
    )

  Record(fields) =>
    PP.group(
      PP.hcat([
        PP.lbrace,
        PP.nest(
          2,
          PP.hcat([
            PP.line,
            PP.sepBy(
              PP.hcat([PP.comma, PP.line]),
              map(
                (f) => PP.hcat([
                  PP.text(Tuple.fst(f)),
                  PP.colon,
                  PP.space,
                  valueToDoc(colored, Tuple.snd(f)),
                ]),
                Dictionary.toList(fields),
              ),
            ),
          ]),
        ),
        PP.line,
        PP.rbrace,
      ]),
    )

  DictionaryConstructor(fields) =>
    PP.group(
      PP.hcat([
        PP.text("{{"),
        PP.nest(
          2,
          PP.hcat([
            PP.line,
            PP.sepBy(
              PP.hcat([PP.comma, PP.line]),
              map(
                (f) => PP.hcat([
                  valueToDoc(colored, Tuple.fst(f)),
                  PP.colon,
                  PP.space,
                  valueToDoc(colored, Tuple.snd(f)),
                ]),
                Dictionary.toList(fields),
              ),
            ),
          ]),
        ),
        PP.line,
        PP.text("}}"),
      ]),
    )
}


printMadlibValue :: Integer -> Boolean -> String -> String
printMadlibValue = (width, colored, madlibValue) => pipe(
  Parse.runParser(value),
  where {
    Left(r) =>
      "Parsing error: " ++ show(r)

    Right(parsed) =>
      pipe(
        valueToDoc(colored),
        PP.prettyPrint(width),
      )(parsed)
  },
)(madlibValue)


pShow :: Show a => a -> String
export pShow = (a) => pipe(
  show,
  printMadlibValue(80, false),
)(a)


cShow :: Show a => a -> String
export cShow = (a) => pipe(
  show,
  printMadlibValue(80, true),
)(a)