git.iko.soy/elk
on f9de430 help sign in
elk/compiler/src/Json/String.hs
192 lines 3.9 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 0x5C {-\-} -> chompEscape 0x5C {-\-} pos end start revChunks
120 0x0D {-\r-} ->
121 let
122 !newPos = plusPtr pos 1
123 in
124 chompChunks newPos end newPos (addSlice start pos revChunks)
126 _ ->
127 let
128 !width = P.getCharWidth word
129 !newPos = plusPtr pos width
130 in
131 chompChunks newPos end start revChunks
134chompEscape :: Word8 -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> [Chunk] -> [Chunk]
135chompEscape escape pos end start revChunks =
136 let
137 !pos1 = plusPtr pos 1
138 in
139 chompChunks pos1 end pos1 (Escape escape : addSlice start pos revChunks)
142addSlice :: Ptr Word8 -> Ptr Word8 -> [Chunk] -> [Chunk]
143addSlice start end revChunks =
144 if start == end
145 then revChunks
146 else Slice start (minusPtr end start) : revChunks
150-- FROM CHUNKS
153data Chunk
154 = Slice (Ptr Word8) Int
155 | Escape Word8
158fromChunks :: [Chunk] -> String
159fromChunks chunks =
160 unsafeDupablePerformIO (stToIO (
161 do let !len = sum (map chunkToWidth chunks)
162 mba <- newByteArray len
163 writeChunks mba 0 chunks
164 freeze mba
165 ))
168chunkToWidth :: Chunk -> Int
169chunkToWidth chunk =
170 case chunk of
171 Slice _ len -> len
172 Escape _ -> 2
175writeChunks :: MBA RealWorld -> Int -> [Chunk] -> ST RealWorld ()
176writeChunks mba offset chunks =
177 case chunks of
178 [] ->
179 return ()
181 chunk : chunks ->
182 case chunk of
183 Slice ptr len ->
184 do copyFromPtr ptr mba offset len
185 let !newOffset = offset + len
186 writeChunks mba newOffset chunks
188 Escape word ->
189 do writeWord8 mba offset 0x5C {- \ -}
190 writeWord8 mba (offset + 1) word
191 let !newOffset = offset + 2
192 writeChunks mba newOffset chunks