git.iko.soy/elk
on 3973751 help sign in
elk/compiler/src/Json/String.hs
187 lines 3.9 kB history raw
1{-# OPTIONS_GHC -Wall -fno-warn-name-shadowing #-}
2{-# LANGUAGE BangPatterns, EmptyDataDecls #-}
3module Json.String
4 ( String
5 --
6 , fromPtr
7 , fromName
8 , fromChars
9 , fromSnippet
10 , fromComment
11 --
12 , toChars
13 , toBuilder
14 )
15 where
18import Prelude hiding (String)
19import qualified Data.ByteString.Builder as B
20import qualified Data.Coerce as Coerce
21import qualified Data.Name as Name
22import qualified Data.Utf8 as Utf8
23import Data.Utf8 (MBA, newByteArray, copyFromPtr, freeze, writeWord8)
24import Data.Word (Word8)
25import Foreign.Ptr (Ptr, plusPtr, minusPtr)
26import Foreign.ForeignPtr (withForeignPtr)
27import GHC.Exts (RealWorld)
28import GHC.IO (stToIO, unsafeDupablePerformIO, unsafePerformIO)
29import GHC.ST (ST)
31import qualified Parse.Primitives as P
35-- JSON STRINGS
38-- INVARIANT: any Json.String is appropriately escaped already
39-- TODO: is this the right representation for Json.String? Maybe ByteString instead?
40--
41type String =
42 Utf8.Utf8 JSON_STRING
45data JSON_STRING
49-- FROM
52fromPtr :: Ptr Word8 -> Ptr Word8 -> String
53fromPtr =
54 Utf8.fromPtr
57fromChars :: [Char] -> String
58fromChars =
59 Utf8.fromChars
62fromSnippet :: P.Snippet -> String
63fromSnippet =
64 Utf8.fromSnippet
67fromName :: Name.Name -> String
68fromName =
69 Coerce.coerce
73-- TO
76toChars :: String -> [Char]
77toChars =
78 Utf8.toChars
81{-# INLINE toBuilder #-}
82toBuilder :: String -> B.Builder
83toBuilder =
84 Utf8.toBuilder
88-- FROM COMMENT
91fromComment :: P.Snippet -> String
92fromComment (P.Snippet fptr off len _ _) =
93 unsafePerformIO $ withForeignPtr fptr $ \ptr ->
94 let
95 !pos = plusPtr ptr off
96 !end = plusPtr pos len
97 !str = fromChunks (chompChunks pos end pos [])
98 in
99 return str
102chompChunks :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> [Chunk] -> [Chunk]
103chompChunks pos end start revChunks =
104 if pos >= end then
105 reverse (addSlice start end revChunks)
106 else
107 let
108 !word = P.unsafeIndex pos
109 in
110 case word of
111 0x0A {-\n-} -> chompEscape 0x6E {-n-} pos end start revChunks
112 0x22 {-"-} -> chompEscape 0x22 {-"-} pos end start revChunks
113 0x27 {-'-} -> chompEscape 0x27 {-'-} pos end start revChunks
114 0x5C {-\-} -> chompEscape 0x5C {-\-} pos end start revChunks
115 0x0D {-\r-} ->
116 let
117 !newPos = plusPtr pos 1
118 in
119 chompChunks newPos end newPos (addSlice start pos revChunks)
121 _ ->
122 let
123 !width = P.getCharWidth pos end word
124 !newPos = plusPtr pos width
125 in
126 chompChunks newPos end start revChunks
129chompEscape :: Word8 -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> [Chunk] -> [Chunk]
130chompEscape escape pos end start revChunks =
131 let
132 !pos1 = plusPtr pos 1
133 in
134 chompChunks pos1 end pos1 (Escape escape : addSlice start pos revChunks)
137addSlice :: Ptr Word8 -> Ptr Word8 -> [Chunk] -> [Chunk]
138addSlice start end revChunks =
139 if start == end
140 then revChunks
141 else Slice start (minusPtr end start) : revChunks
145-- FROM CHUNKS
148data Chunk
149 = Slice (Ptr Word8) Int
150 | Escape Word8
153fromChunks :: [Chunk] -> String
154fromChunks chunks =
155 unsafeDupablePerformIO (stToIO (
156 do let !len = sum (map chunkToWidth chunks)
157 mba <- newByteArray len
158 writeChunks mba 0 chunks
159 freeze mba
160 ))
163chunkToWidth :: Chunk -> Int
164chunkToWidth chunk =
165 case chunk of
166 Slice _ len -> len
167 Escape _ -> 2
170writeChunks :: MBA RealWorld -> Int -> [Chunk] -> ST RealWorld ()
171writeChunks mba offset chunks =
172 case chunks of
173 [] ->
174 return ()
176 chunk : chunks ->
177 case chunk of
178 Slice ptr len ->
179 do copyFromPtr ptr mba offset len
180 let !newOffset = offset + len
181 writeChunks mba newOffset chunks
183 Escape word ->
184 do writeWord8 mba offset 0x5C {- \ -}
185 writeWord8 mba (offset + 1) word
186 let !newOffset = offset + 2
187 writeChunks mba newOffset chunks