git.iko.soy/elk
on efb63ca help sign in
elk/compiler/src/Json/String.hs
193 lines 4.0 kB history raw
1{-# OPTIONS_GHC -Wall -fno-warn-name-shadowing #-}
2{-# LANGUAGE BangPatterns, EmptyDataDecls #-}
3module Json.String
4 ( String
5 , isEmpty
6 --
7 , fromPtr
8 , fromName
9 , fromChars
10 , fromSnippet
11 , fromComment
12 --
13 , toChars
14 , toBuilder
15 )
16 where
19import Prelude hiding (String)
20import qualified Data.ByteString.Builder as B
21import qualified Data.Coerce as Coerce
22import qualified Data.Name as Name
23import qualified Data.Utf8 as Utf8
24import Data.Utf8 (MBA, newByteArray, copyFromPtr, freeze, writeWord8)
25import Data.Word (Word8)
26import Foreign.Ptr (Ptr, plusPtr, minusPtr)
27import Foreign.ForeignPtr (withForeignPtr)
28import GHC.Exts (RealWorld)
29import GHC.IO (stToIO, unsafeDupablePerformIO, unsafePerformIO)
30import GHC.ST (ST)
32import qualified Parse.Primitives as P
36-- JSON STRINGS
39-- INVARIANT: any Json.String is appropriately escaped already
40-- PERF: is this the right representation for Json.String? Maybe ByteString instead?
41--
42type String =
43 Utf8.Utf8 JSON_STRING
46data JSON_STRING
49isEmpty :: String -> Bool
50isEmpty =
51 Utf8.isEmpty
55-- FROM
58fromPtr :: Ptr Word8 -> Ptr Word8 -> String
59fromPtr =
60 Utf8.fromPtr
63fromChars :: [Char] -> String
64fromChars =
65 Utf8.fromChars
68fromSnippet :: P.Snippet -> String
69fromSnippet =
70 Utf8.fromSnippet
73fromName :: Name.Name -> String
74fromName =
75 Coerce.coerce
79-- TO
82toChars :: String -> [Char]
83toChars =
84 Utf8.toChars
87{-# INLINE toBuilder #-}
88toBuilder :: String -> B.Builder
89toBuilder =
90 Utf8.toBuilder
94-- FROM COMMENT
97fromComment :: P.Snippet -> String
98fromComment (P.Snippet fptr off len _ _) =
99 unsafePerformIO $ withForeignPtr fptr $ \ptr ->
100 let
101 !pos = plusPtr ptr off
102 !end = plusPtr pos len
103 !str = fromChunks (chompChunks pos end pos [])
104 in
105 return str
108chompChunks :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> [Chunk] -> [Chunk]
109chompChunks pos end start revChunks =
110 if pos >= end then
111 reverse (addSlice start end revChunks)
112 else
113 let
114 !word = P.unsafeIndex pos
115 in
116 case word of
117 0x0A {-\n-} -> chompEscape 0x6E {-n-} pos end start revChunks
118 0x22 {-"-} -> chompEscape 0x22 {-"-} pos end start revChunks
119 0x27 {-'-} -> chompEscape 0x27 {-'-} pos end start revChunks
120 0x5C {-\-} -> chompEscape 0x5C {-\-} pos end start revChunks
121 0x0D {-\r-} ->
122 let
123 !newPos = plusPtr pos 1
124 in
125 chompChunks newPos end newPos (addSlice start pos revChunks)
127 _ ->
128 let
129 !width = P.getCharWidth word
130 !newPos = plusPtr pos width
131 in
132 chompChunks newPos end start revChunks
135chompEscape :: Word8 -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> [Chunk] -> [Chunk]
136chompEscape escape pos end start revChunks =
137 let
138 !pos1 = plusPtr pos 1
139 in
140 chompChunks pos1 end pos1 (Escape escape : addSlice start pos revChunks)
143addSlice :: Ptr Word8 -> Ptr Word8 -> [Chunk] -> [Chunk]
144addSlice start end revChunks =
145 if start == end
146 then revChunks
147 else Slice start (minusPtr end start) : revChunks
151-- FROM CHUNKS
154data Chunk
155 = Slice (Ptr Word8) Int
156 | Escape Word8
159fromChunks :: [Chunk] -> String
160fromChunks chunks =
161 unsafeDupablePerformIO (stToIO (
162 do let !len = sum (map chunkToWidth chunks)
163 mba <- newByteArray len
164 writeChunks mba 0 chunks
165 freeze mba
166 ))
169chunkToWidth :: Chunk -> Int
170chunkToWidth chunk =
171 case chunk of
172 Slice _ len -> len
173 Escape _ -> 2
176writeChunks :: MBA RealWorld -> Int -> [Chunk] -> ST RealWorld ()
177writeChunks mba offset chunks =
178 case chunks of
179 [] ->
180 return ()
182 chunk : chunks ->
183 case chunk of
184 Slice ptr len ->
185 do copyFromPtr ptr mba offset len
186 let !newOffset = offset + len
187 writeChunks mba newOffset chunks
189 Escape word ->
190 do writeWord8 mba offset 0x5C {- \ -}
191 writeWord8 mba (offset + 1) word
192 let !newOffset = offset + 2
193 writeChunks mba newOffset chunks