content: {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
  {-# LANGUAGE BangPatterns, EmptyDataDecls, FlexibleInstances, MagicHash, UnboxedTuples #-}
  module Data.Name
    ( Name
    --
    , toChars
    , toElmString
    , toBuilder
    --
    , fromPtr
    , fromChars
    --
    , getKernel
    , hasDot
    , splitDots
    , isKernel
    , isNumberType
    , isComparableType
    , isAppendableType
    , isCompappendType
    , fromVarIndex
    , fromWords
    , fromManyNames
    , fromTypeVariable
    , fromTypeVariableScheme
    , sepBy
    --
    , int, float, bool, char, string
    , maybe, result, list, array, dict, tuple, jsArray
    , task, router, cmd, sub, platform, virtualDom
    , shader, debug, debugger, bitwise, basics
    , utils, negate, true, false, value
    , node, program, _main, _Main, dollar, identity
    , replModule, replValueToPrint
    -- @LAMDERA
    , toText
    , fromText
    , bytes
    )
    where
  
  
  import Prelude hiding (length, maybe, negate)
  import Control.Exception (assert)
  import qualified Data.Binary as Binary
  import qualified Data.ByteString.Builder.Internal as B
  import qualified Data.Coerce as Coerce
  import qualified Data.List as List
  import qualified Data.String as Chars
  import qualified Data.Utf8 as Utf8
  import GHC.Exts
    ( Int(I#), Ptr
    , MutableByteArray#
    , isTrue#
    , newByteArray#
    , sizeofByteArray#
    , unsafeFreezeByteArray#
    )
  import GHC.ST (ST(ST), runST)
  import GHC.Prim
  import GHC.Word (Word8(W8#))
  
  import qualified Elm.String as ES
  
  
  -- @LAMDERA
  
  import qualified Data.Text
  
  toText = Data.Text.pack . toChars
  fromText = fromChars . Data.Text.unpack
  
  
  
  -- NAME
  
  
  type Name =
    Utf8.Utf8 ELM_NAME
  
  
  data ELM_NAME
  
  
  
  -- INSTANCES
  
  
  instance Chars.IsString (Utf8.Utf8 ELM_NAME) where
    fromString = Utf8.fromChars
  
  instance Binary.Binary (Utf8.Utf8 ELM_NAME) where
    get = Utf8.getUnder256
    put = Utf8.putUnder256
  
  
  
  -- TO
  
  
  toChars :: Name -> [Char]
  toChars =
    Utf8.toChars
  
  
  toElmString :: Name -> ES.String
  toElmString =
    Coerce.coerce
  
  
  {-# INLINE toBuilder #-}
  toBuilder :: Name -> B.Builder
  toBuilder =
    Utf8.toBuilder
  
  
  
  -- FROM
  
  
  fromPtr :: Ptr Word8 -> Ptr Word8 -> Name
  fromPtr =
    Utf8.fromPtr
  
  
  fromChars :: [Char] -> Name
  fromChars =
    Utf8.fromChars
  
  
  
  -- HAS DOT
  
  
  hasDot :: Name -> Bool
  hasDot name =
    Utf8.contains 0x2E {- . -} name
  
  
  splitDots :: Name -> [Name]
  splitDots name =
    Utf8.split 0x2E {- . -} name
  
  
  
  -- GET KERNEL
  
  
  getKernel :: Name -> Name
  getKernel name@(Utf8.Utf8 ba#) =
    assert (isKernel name)
    (
      runST
      (
        let
          !size# = sizeofByteArray# ba# -# 11#
        in
        ST $ \s ->
          case newByteArray# size# s of
            (# s, mba# #) ->
              case copyByteArray# ba# 11# mba# 0# size# s of
                s ->
                  case unsafeFreezeByteArray# mba# s of
                    (# s, ba# #) -> (# s, Utf8.Utf8 ba# #)
      )
    )
  
  
  
  -- STARTS WITH
  
  
  isKernel :: Name -> Bool
  isKernel = Utf8.startsWith prefix_kernel
  
  isNumberType :: Name -> Bool
  isNumberType = Utf8.startsWith prefix_number
  
  isComparableType :: Name -> Bool
  isComparableType = Utf8.startsWith prefix_comparable
  
  isAppendableType :: Name -> Bool
  isAppendableType = Utf8.startsWith prefix_appendable
  
  isCompappendType :: Name -> Bool
  isCompappendType = Utf8.startsWith prefix_compappend
  
  {-# NOINLINE prefix_kernel #-}
  prefix_kernel :: Name
  prefix_kernel = fromChars "Elm.Kernel."
  
  {-# NOINLINE prefix_number #-}
  prefix_number :: Name
  prefix_number = fromChars "number"
  
  {-# NOINLINE prefix_comparable #-}
  prefix_comparable :: Name
  prefix_comparable = fromChars "comparable"
  
  {-# NOINLINE prefix_appendable #-}
  prefix_appendable :: Name
  prefix_appendable = fromChars "appendable"
  
  {-# NOINLINE prefix_compappend #-}
  prefix_compappend :: Name
  prefix_compappend = fromChars "compappend"
  
  
  
  -- FROM VAR INDEX
  
  
  fromVarIndex :: Int -> Name
  fromVarIndex n =
    runST
    (
      do  let !size = 2 + getIndexSize n
          mba <- newByteArray size
          writeWord8 mba 0 0x5F {- _ -}
          writeWord8 mba 1 0x76 {- v -}
          writeDigitsAtEnd mba size n
          freeze mba
    )
  
  
  {-# INLINE getIndexSize #-}
  getIndexSize :: Int -> Int
  getIndexSize n
    | n < 10  = 1
    | n < 100 = 2
    | True    = ceiling (logBase 10 (fromIntegral n + 1) :: Float)
  
  
  
  writeDigitsAtEnd :: MBA s -> Int -> Int -> ST s ()
  writeDigitsAtEnd !mba !oldOffset !n =
    do  let (q,r) = quotRem n 10
        let !newOffset = oldOffset - 1
        writeWord8 mba newOffset (0x30 + fromIntegral r)
        if q <= 0
          then return ()
          else writeDigitsAtEnd mba newOffset q
  
  
  
  -- FROM TYPE VARIABLE
  
  
  fromTypeVariable :: Name -> Int -> Name
  fromTypeVariable name@(Utf8.Utf8 ba#) index =
    if index <= 0 then
      name
    else
      let
        len# = sizeofByteArray# ba#
        end# = word8ToWord# (indexWord8Array# ba# (len# -# 1#))
      in
      if isTrue# (leWord# 0x30## end#) && isTrue# (leWord# end# 0x39##) then
        runST
        (
          do  let !size = I# len# + 1 + getIndexSize index
              mba <- newByteArray size
              copyToMBA name mba
              writeWord8 mba (I# len#) 0x5F {- _ -}
              writeDigitsAtEnd mba size index
              freeze mba
        )
      else
        runST
        (
          do  let !size = I# len# + getIndexSize index
              mba <- newByteArray size
              copyToMBA name mba
              writeDigitsAtEnd mba size index
              freeze mba
        )
  
  
  
  -- FROM TYPE VARIABLE SCHEME
  
  
  fromTypeVariableScheme :: Int -> Name
  fromTypeVariableScheme scheme =
    runST
    (
      if scheme < 26 then
        do  mba <- newByteArray 1
            writeWord8 mba 0 (0x61 + fromIntegral scheme)
            freeze mba
      else
        do  let (extra, letter) = quotRem scheme 26
            let !size = 1 + getIndexSize extra
            mba <- newByteArray size
            writeWord8 mba 0 (0x61 + fromIntegral letter)
            writeDigitsAtEnd mba size extra
            freeze mba
    )
  
  
  
  -- FROM MANY NAMES
  --
  -- Creating a unique name by combining all the subnames can create names
  -- longer than 256 bytes relatively easily. So instead, the first given name
  -- (e.g. foo) is prefixed chars that are valid in JS but not Elm (e.g. _M$foo)
  --
  -- This should be a unique name since 0.19 disallows shadowing. It would not
  -- be possible for multiple top-level cycles to include values with the same
  -- name, so the important thing is to make the cycle name distinct from the
  -- normal name. Same logic for destructuring patterns like (x,y)
  
  
  fromManyNames :: [Name] -> Name
  fromManyNames names =
    case names of
      [] ->
        blank
        -- NOTE: this case is needed for (let _ = Debug.log "x" x in ...)
        -- but maybe unused patterns should be stripped out instead
  
      Utf8.Utf8 ba# : _ ->
        let
          len# = sizeofByteArray# ba#
        in
        runST
        (
          ST $ \s ->
            case newByteArray# (len# +# 3#) s of
              (# s, mba# #) ->
                case writeWord8Array# mba# 0# (wordToWord8# 0x5F##) {-_-} s of
                  s ->
                    case writeWord8Array# mba# 1# (wordToWord8# 0x4D##) {-M-} s of
                      s ->
                        case writeWord8Array# mba# 2# (wordToWord8# 0x24##) {-$-} s of
                          s ->
                            case copyByteArray# ba# 0# mba# 3# len# s of
                              s ->
                                case unsafeFreezeByteArray# mba# s of
                                  (# s, ba# #) -> (# s, Utf8.Utf8 ba# #)
        )
  
  
  {-# NOINLINE blank #-}
  blank :: Name
  blank =
    fromWords [0x5F,0x4D,0x24] {-_M$-}
  
  
  
  -- FROM WORDS
  
  
  fromWords :: [Word8] -> Name
  fromWords words =
    runST
    (
      do  mba <- newByteArray (List.length words)
          writeWords mba 0 words
          freeze mba
    )
  
  
  writeWords :: MBA s -> Int -> [Word8] -> ST s ()
  writeWords !mba !i words =
    case words of
      [] ->
        return ()
  
      w:ws ->
        do  writeWord8 mba i w
            writeWords mba (i+1) ws
  
  
  
  -- SEP BY
  
  
  sepBy :: Word8 -> Name -> Name -> Name
  sepBy (W8# sep#) (Utf8.Utf8 ba1#) (Utf8.Utf8 ba2#) =
    let
      !len1# = sizeofByteArray# ba1#
      !len2# = sizeofByteArray# ba2#
    in
    runST
    (
      ST $ \s ->
        case newByteArray# (len1# +# len2# +# 1#) s of
          (# s, mba# #) ->
            case copyByteArray# ba1# 0# mba# 0# len1# s of
              s ->
                case writeWord8Array# mba# len1# sep# s of
                  s ->
                    case copyByteArray# ba2# 0# mba# (len1# +# 1#) len2# s of
                      s ->
                        case unsafeFreezeByteArray# mba# s of
                          (# s, ba# #) -> (# s, Utf8.Utf8 ba# #)
    )
  
  
  
  -- PRIMITIVES
  
  
  data MBA s =
    MBA# (MutableByteArray# s)
  
  
  {-# INLINE newByteArray #-}
  newByteArray :: Int -> ST s (MBA s)
  newByteArray (I# len#) =
    ST $ \s ->
      case newByteArray# len# s of
        (# s, mba# #) -> (# s, MBA# mba# #)
  
  
  {-# INLINE freeze #-}
  freeze :: MBA s -> ST s Name
  freeze (MBA# mba#) =
    ST $ \s ->
      case unsafeFreezeByteArray# mba# s of
        (# s, ba# #) -> (# s, Utf8.Utf8 ba# #)
  
  
  {-# INLINE writeWord8 #-}
  writeWord8 :: MBA s -> Int -> Word8 -> ST s ()
  writeWord8 (MBA# mba#) (I# offset#) (W8# w#) =
    ST $ \s ->
      case writeWord8Array# mba# offset# w# s of
        s -> (# s, () #)
  
  
  {-# INLINE copyToMBA #-}
  copyToMBA :: Name -> MBA s -> ST s ()
  copyToMBA (Utf8.Utf8 ba#) (MBA# mba#) =
      ST $ \s ->
        case copyByteArray# ba# 0# mba# 0# (sizeofByteArray# ba#) s of
          s -> (# s, () #)
  
  
  
  -- COMMON NAMES
  
  
  {-# NOINLINE int #-}
  int :: Name
  int = fromChars "Int"
  
  
  {-# NOINLINE float #-}
  float :: Name
  float = fromChars "Float"
  
  
  {-# NOINLINE bool #-}
  bool :: Name
  bool = fromChars "Bool"
  
  
  {-# NOINLINE char #-}
  char :: Name
  char = fromChars "Char"
  
  
  {-# NOINLINE string #-}
  string :: Name
  string = fromChars "String"
  
  
  {-# NOINLINE maybe #-}
  maybe :: Name
  maybe = fromChars "Maybe"
  
  
  {-# NOINLINE result #-}
  result :: Name
  result = fromChars "Result"
  
  
  {-# NOINLINE list #-}
  list :: Name
  list = fromChars "List"
  
  
  {-# NOINLINE array #-}
  array :: Name
  array = fromChars "Array"
  
  
  {-# NOINLINE dict #-}
  dict :: Name
  dict = fromChars "Dict"
  
  
  {-# NOINLINE tuple #-}
  tuple :: Name
  tuple = fromChars "Tuple"
  
  
  {-# NOINLINE jsArray #-}
  jsArray :: Name
  jsArray = fromChars "JsArray"
  
  
  {-# NOINLINE task #-}
  task :: Name
  task = fromChars "Task"
  
  
  {-# NOINLINE router #-}
  router :: Name
  router = fromChars "Router"
  
  
  {-# NOINLINE cmd #-}
  cmd :: Name
  cmd = fromChars "Cmd"
  
  
  {-# NOINLINE sub #-}
  sub :: Name
  sub = fromChars "Sub"
  
  
  {-# NOINLINE platform #-}
  platform :: Name
  platform = fromChars "Platform"
  
  
  {-# NOINLINE virtualDom #-}
  virtualDom :: Name
  virtualDom = fromChars "VirtualDom"
  
  
  {-# NOINLINE shader #-}
  shader :: Name
  shader = fromChars "Shader"
  
  
  {-# NOINLINE debug #-}
  debug :: Name
  debug = fromChars "Debug"
  
  
  {-# NOINLINE debugger #-}
  debugger :: Name
  debugger = fromChars "Debugger"
  
  
  {-# NOINLINE bitwise #-}
  bitwise :: Name
  bitwise = fromChars "Bitwise"
  
  
  {-# NOINLINE basics #-}
  basics :: Name
  basics = fromChars "Basics"
  
  
  {-# NOINLINE utils #-}
  utils :: Name
  utils = fromChars "Utils"
  
  
  {-# NOINLINE negate #-}
  negate :: Name
  negate = fromChars "negate"
  
  
  {-# NOINLINE true #-}
  true :: Name
  true = fromChars "True"
  
  
  {-# NOINLINE false #-}
  false :: Name
  false = fromChars "False"
  
  
  {-# NOINLINE value #-}
  value :: Name
  value = fromChars "Value"
  
  
  {-# NOINLINE node #-}
  node :: Name
  node = fromChars "Node"
  
  
  {-# NOINLINE program #-}
  program :: Name
  program = fromChars "Program"
  
  
  {-# NOINLINE _main #-}
  _main :: Name
  _main = fromChars "main"
  
  
  {-# NOINLINE _Main #-}
  _Main :: Name
  _Main = fromChars "Main"
  
  
  {-# NOINLINE dollar #-}
  dollar :: Name
  dollar = fromChars "$"
  
  
  {-# NOINLINE identity #-}
  identity :: Name
  identity = fromChars "identity"
  
  
  {-# NOINLINE replModule #-}
  replModule :: Name
  replModule = fromChars "Elm_Repl"
  
  
  {-# NOINLINE replValueToPrint #-}
  replValueToPrint :: Name
  replValueToPrint = fromChars "repl_input_value_"
  
  
  -- @LAMDERA
  
  {-# NOINLINE bytes #-}
  bytes :: Name
  bytes = fromChars "Bytes"
  