content: {-# LANGUAGE OverloadedStrings #-}
  {-# OPTIONS_GHC -Wall #-}
  
  module Generate.JavaScript.Name
    ( Name,
      toBuilder,
      fromIndex,
      fromInt,
      fromLocal,
      fromLocalHumanReadable,
      fromGlobal,
      fromGlobalDirectFn,
      fromGlobalHumanReadable,
      fromCycle,
      fromKernel,
      makeF,
      makeA,
      makeLabel,
      makeTemp,
      dollar,
    )
  where
  
  import Data.ByteString.Builder qualified as B
  import Data.Index qualified as Index
  import Data.Map qualified as Map
  import Data.Name qualified as Name
  import Data.Set qualified as Set
  import Data.Utf8 qualified as Utf8
  import Data.Word (Word8)
  import Gren.ModuleName qualified as ModuleName
  import Gren.Package qualified as Pkg
  
  -- NAME
  
  newtype Name = Name {toBuilder :: B.Builder}
  
  -- CONSTRUCTORS
  
  fromIndex :: Index.ZeroBased -> Name
  fromIndex index =
    fromInt (Index.toMachine index)
  
  fromInt :: Int -> Name
  fromInt n =
    Name (Name.toBuilder (intToAscii n))
  
  fromLocal :: Name.Name -> Name
  fromLocal name =
    if Set.member name reservedNames
      then Name ("_" <> Name.toBuilder name)
      else Name (Name.toBuilder name)
  
  fromLocalHumanReadable :: Name.Name -> Name
  fromLocalHumanReadable name =
    Name (Name.toBuilder name)
  
  fromGlobal :: ModuleName.Canonical -> Name.Name -> Name
  fromGlobal home name =
    Name $ homeToBuilder home <> usd <> Name.toBuilder name
  
  fromGlobalDirectFn :: ModuleName.Canonical -> Name.Name -> Name
  fromGlobalDirectFn home name =
    Name $ homeToBuilder home <> usd <> Name.toBuilder name <> usd
  
  fromGlobalHumanReadable :: ModuleName.Canonical -> Name.Name -> Name
  fromGlobalHumanReadable (ModuleName.Canonical _ moduleName) name =
    Name $
      Utf8.toBuilder moduleName
        <> "."
        <> Name.toBuilder name
  
  fromCycle :: ModuleName.Canonical -> Name.Name -> Name
  fromCycle home name =
    Name $ homeToBuilder home <> "$cyclic$" <> Name.toBuilder name
  
  fromKernel :: Name.Name -> Name.Name -> Name
  fromKernel home name =
    Name ("_" <> Name.toBuilder home <> "_" <> Name.toBuilder name)
  
  homeToBuilder :: ModuleName.Canonical -> B.Builder
  homeToBuilder (ModuleName.Canonical (Pkg.Name author project) home) =
    usd
      <> Utf8.toEscapedBuilder 0x2D {- - -} 0x5F {- _ -} author
      <> usd
      <> Utf8.toEscapedBuilder 0x2D {- - -} 0x5F {- _ -} project
      <> usd
      <> Utf8.toEscapedBuilder 0x2E {- . -} 0x24 home
  
  -- TEMPORARY NAMES
  
  makeF :: Int -> Name
  makeF n =
    Name ("F" <> B.intDec n)
  
  makeA :: Int -> Name
  makeA n =
    Name ("A" <> B.intDec n)
  
  makeLabel :: Name.Name -> Int -> Name
  makeLabel name index =
    Name (Name.toBuilder name <> usd <> B.intDec index)
  
  makeTemp :: Name.Name -> Name
  makeTemp name =
    Name ("$temp$" <> Name.toBuilder name)
  
  dollar :: Name
  dollar =
    Name usd
  
  usd :: B.Builder
  usd =
    Name.toBuilder Name.dollar
  
  -- RESERVED NAMES
  
  reservedNames :: Set.Set Name.Name
  reservedNames =
    Set.union jsReservedWords grenReservedWords
  
  jsReservedWords :: Set.Set Name.Name
  jsReservedWords =
    Set.fromList
      [ "do",
        "if",
        "in",
        "NaN",
        "int",
        "for",
        "new",
        "try",
        "var",
        "let",
        "null",
        "true",
        "eval",
        "byte",
        "char",
        "goto",
        "long",
        "case",
        "else",
        "this",
        "void",
        "with",
        "enum",
        "false",
        "final",
        "float",
        "short",
        "break",
        "catch",
        "throw",
        "while",
        "class",
        "const",
        "super",
        "yield",
        "double",
        "native",
        "throws",
        "delete",
        "return",
        "switch",
        "typeof",
        "export",
        "import",
        "public",
        "static",
        "boolean",
        "default",
        "finally",
        "extends",
        "package",
        "private",
        "Infinity",
        "abstract",
        "volatile",
        "function",
        "continue",
        "debugger",
        "function",
        "undefined",
        "arguments",
        "transient",
        "interface",
        "protected",
        "instanceof",
        "implements",
        "synchronized"
      ]
  
  grenReservedWords :: Set.Set Name.Name
  grenReservedWords =
    Set.fromList
      [ "F2",
        "F3",
        "F4",
        "F5",
        "F6",
        "F7",
        "F8",
        "F9",
        "A2",
        "A3",
        "A4",
        "A5",
        "A6",
        "A7",
        "A8",
        "A9"
      ]
  
  -- INT TO ASCII
  
  intToAscii :: Int -> Name.Name
  intToAscii n =
    if n < 53 -- skip $ as a standalone name
      then Name.fromWords [toByte n]
      else intToAsciiHelp 2 (numStartBytes * numInnerBytes) allBadFields (n - 53)
  
  intToAsciiHelp :: Int -> Int -> [BadFields] -> Int -> Name.Name
  intToAsciiHelp width blockSize badFields n =
    case badFields of
      [] ->
        if n < blockSize
          then unsafeIntToAscii width [] n
          else intToAsciiHelp (width + 1) (blockSize * numInnerBytes) [] (n - blockSize)
      BadFields renamings : biggerBadFields ->
        let availableSize = blockSize - Map.size renamings
         in if n < availableSize
              then
                let name = unsafeIntToAscii width [] n
                 in Map.findWithDefault name name renamings
              else intToAsciiHelp (width + 1) (blockSize * numInnerBytes) biggerBadFields (n - availableSize)
  
  -- UNSAFE INT TO ASCII
  
  unsafeIntToAscii :: Int -> [Word8] -> Int -> Name.Name
  unsafeIntToAscii width bytes n =
    if width <= 1
      then Name.fromWords (toByte n : bytes)
      else
        let (quotient, remainder) =
              quotRem n numInnerBytes
         in unsafeIntToAscii (width - 1) (toByte remainder : bytes) quotient
  
  -- ASCII BYTES
  
  numStartBytes :: Int
  numStartBytes =
    54
  
  numInnerBytes :: Int
  numInnerBytes =
    64
  
  toByte :: Int -> Word8
  toByte n
    | n < 26 = fromIntegral (97 + n {- lower -})
    | n < 52 = fromIntegral (65 + n - 26 {- upper -})
    | n == 52 = 95 {- _ -}
    | n == 53 = 36
    | n < 64 = fromIntegral (48 + n - 54 {- digit -})
    | True = error $ "cannot convert int " ++ show n ++ " to ASCII"
  
  -- BAD FIELDS
  
  newtype BadFields = BadFields {_renamings :: Renamings}
  
  type Renamings =
    Map.Map Name.Name Name.Name
  
  allBadFields :: [BadFields]
  allBadFields =
    let add keyword dict =
          Map.alter (Just . addRenaming keyword) (Utf8.size keyword) dict
     in Map.elems $ Set.foldr add Map.empty jsReservedWords
  
  addRenaming :: Name.Name -> Maybe BadFields -> BadFields
  addRenaming keyword maybeBadFields =
    let width = Utf8.size keyword
        maxName = numStartBytes * numInnerBytes ^ (width - 1) - 1
     in case maybeBadFields of
          Nothing ->
            BadFields $ Map.singleton keyword (unsafeIntToAscii width [] maxName)
          Just (BadFields renamings) ->
            BadFields $ Map.insert keyword (unsafeIntToAscii width [] (maxName - Map.size renamings)) renamings
  
  -- INSTANCES
  
  instance Ord Name where
    compare (Name builder1) (Name builder2) =
      compare (B.toLazyByteString builder1) (B.toLazyByteString builder2)
  
  instance Eq Name where
    (==) (Name builder1) (Name builder2) =
      (==) (B.toLazyByteString builder1) (B.toLazyByteString builder2)
  