content: {-# OPTIONS_GHC -Wall -fno-warn-name-shadowing #-}
  {-# LANGUAGE BangPatterns, EmptyDataDecls #-}
  module Json.String
    ( String
    , isEmpty
    --
    , fromPtr
    , fromName
    , fromChars
    , fromSnippet
    , fromComment
    --
    , toChars
    , toBuilder
    )
    where
  
  
  import Prelude hiding (String)
  import qualified Data.ByteString.Builder as B
  import qualified Data.Coerce as Coerce
  import qualified Data.Name as Name
  import qualified Data.Utf8 as Utf8
  import Data.Utf8 (MBA, newByteArray, copyFromPtr, freeze, writeWord8)
  import Data.Word (Word8)
  import Foreign.Ptr (Ptr, plusPtr, minusPtr)
  import Foreign.ForeignPtr (withForeignPtr)
  import GHC.Exts (RealWorld)
  import GHC.IO (stToIO, unsafeDupablePerformIO, unsafePerformIO)
  import GHC.ST (ST)
  
  import qualified Parse.Primitives as P
  
  
  
  -- JSON STRINGS
  
  
  -- INVARIANT: any Json.String is appropriately escaped already
  -- PERF: is this the right representation for Json.String? Maybe ByteString instead?
  --
  type String =
    Utf8.Utf8 JSON_STRING
  
  
  data JSON_STRING
  
  
  isEmpty :: String -> Bool
  isEmpty =
    Utf8.isEmpty
  
  
  
  -- FROM
  
  
  fromPtr :: Ptr Word8 -> Ptr Word8 -> String
  fromPtr =
    Utf8.fromPtr
  
  
  fromChars :: [Char] -> String
  fromChars =
    Utf8.fromChars
  
  
  fromSnippet :: P.Snippet -> String
  fromSnippet =
    Utf8.fromSnippet
  
  
  fromName :: Name.Name -> String
  fromName =
    Coerce.coerce
  
  
  
  -- TO
  
  
  toChars :: String -> [Char]
  toChars =
    Utf8.toChars
  
  
  {-# INLINE toBuilder #-}
  toBuilder :: String -> B.Builder
  toBuilder =
    Utf8.toBuilder
  
  
  
  -- FROM COMMENT
  
  
  fromComment :: P.Snippet -> String
  fromComment (P.Snippet fptr off len _ _) =
    unsafePerformIO $ withForeignPtr fptr $ \ptr ->
      let
        !pos = plusPtr ptr off
        !end = plusPtr pos len
        !str = fromChunks (chompChunks pos end pos [])
      in
      return str
  
  
  chompChunks :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> [Chunk] -> [Chunk]
  chompChunks pos end start revChunks =
    if pos >= end then
      reverse (addSlice start end revChunks)
    else
      let
        !word = P.unsafeIndex pos
      in
      case word of
        0x0A {-\n-} -> chompEscape 0x6E {-n-} pos end start revChunks
        0x22 {-"-}  -> chompEscape 0x22 {-"-} pos end start revChunks
        0x5C {-\-}  -> chompEscape 0x5C {-\-} pos end start revChunks
        0x0D {-\r-} ->
          let
            !newPos = plusPtr pos 1
          in
          chompChunks newPos end newPos (addSlice start pos revChunks)
  
        _ ->
          let
            !width = P.getCharWidth word
            !newPos = plusPtr pos width
          in
          chompChunks newPos end start revChunks
  
  
  chompEscape :: Word8 -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> [Chunk] -> [Chunk]
  chompEscape escape pos end start revChunks =
    let
      !pos1 = plusPtr pos 1
    in
    chompChunks pos1 end pos1 (Escape escape : addSlice start pos revChunks)
  
  
  addSlice :: Ptr Word8 -> Ptr Word8 -> [Chunk] -> [Chunk]
  addSlice start end revChunks =
    if start == end
      then revChunks
      else Slice start (minusPtr end start) : revChunks
  
  
  
  -- FROM CHUNKS
  
  
  data Chunk
    = Slice (Ptr Word8) Int
    | Escape Word8
  
  
  fromChunks :: [Chunk] -> String
  fromChunks chunks =
    unsafeDupablePerformIO (stToIO (
      do  let !len = sum (map chunkToWidth chunks)
          mba <- newByteArray len
          writeChunks mba 0 chunks
          freeze mba
    ))
  
  
  chunkToWidth :: Chunk -> Int
  chunkToWidth chunk =
    case chunk of
      Slice _ len -> len
      Escape _    -> 2
  
  
  writeChunks :: MBA RealWorld -> Int -> [Chunk] -> ST RealWorld ()
  writeChunks mba offset chunks =
    case chunks of
      [] ->
        return ()
  
      chunk : chunks ->
        case chunk of
          Slice ptr len ->
            do  copyFromPtr ptr mba offset len
                let !newOffset = offset + len
                writeChunks mba newOffset chunks
  
          Escape word ->
            do  writeWord8 mba offset 0x5C {- \ -}
                writeWord8 mba (offset + 1) word
                let !newOffset = offset + 2
                writeChunks mba newOffset chunks
  