module Dialog.EncodeJSON (
strJSON,
paragraphsToJSON,
formattedTextToJSON,
pictureSourceToJSON,
listStyleToJSON,
cellStyleToJSON,
colorToJSON
) where
import Data.Monoid ((<>))
import Dialog.Internal
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TLB
strJSON :: String -> TL.Text
strJSON string =
TLB.toLazyText ("\"" <> helper (TLB.fromString "") string <> "\"")
where
helper builder [] = builder
helper builder (x:xs) =
helper (builder <> repr x) xs
where
repr '\"' = "\\\""
repr '\b' = "\\b"
repr '\f' = "\\f"
repr '\n' = "\\n"
repr '\r' = "\\r"
repr '\t' = "\\t"
repr char = TLB.singleton char
arr :: [TL.Text] -> TL.Text
arr list = "[" <> (TL.intercalate ", " list) <> "]"
obj :: [(TL.Text, TL.Text)] -> TL.Text
obj props =
"{" <> (TL.intercalate ", " (map makeProperty props)) <> "}"
where
makeProperty (key, value) = strJSON (TL.unpack key) <> ": " <> value
typedObj :: TL.Text -> [(TL.Text, TL.Text)] -> TL.Text
typedObj objType props = obj (("type", strJSON (TL.unpack objType)):props)
showTL :: Show a => a -> TL.Text
showTL value = TL.pack (show value)
paragraphsToJSON :: [Paragraph] -> TL.Text
paragraphsToJSON paragraphs = arr (map paragraphToJSON paragraphs)
paragraphToJSON :: Paragraph -> TL.Text
paragraphToJSON = \case
TextParagraph formattedText ->
typedObj "text" [("text", formattedTextToJSON formattedText)]
Picture source ->
typedObj "picture" [("source", pictureSourceToJSON source)]
List style items ->
typedObj "list" [
("style", listStyleToJSON style),
("items", arr (map itemToJSON items))]
where
itemToJSON (ListItem paragraphs) = paragraphsToJSON paragraphs
Table rows ->
typedObj "table" [("rows", arr (map handleRow rows))]
where
handleRow (TableRow cells) = arr (map handleCell cells)
handleCell (TableCell style paragraphs) =
typedObj "cell" [
("style", cellStyleToJSON style),
("paragraphs", paragraphsToJSON paragraphs)]
formattedTextToJSON :: FormattedText -> TL.Text
formattedTextToJSON = \case
Plain string ->
typedObj "plain" [("text", strJSON string)]
Colored color text ->
typedObj "colored" [
("color", colorToJSON color),
("text", formattedTextToJSON text)]
Bold text ->
typedObj "bold" [("text", formattedTextToJSON text)]
Italic text ->
typedObj "italic" [("text", formattedTextToJSON text)]
Underline text ->
typedObj "underline" [("text", formattedTextToJSON text)]
Size size text ->
typedObj "size" [
("size", showTL size),
("text", formattedTextToJSON text)]
Link url text ->
typedObj "link" [
("url", strJSON url),
("text", formattedTextToJSON text)]
CompositeText parts ->
typedObj "composite" [
("parts", arr (map formattedTextToJSON parts))]
pictureSourceToJSON :: PictureSource -> TL.Text
pictureSourceToJSON = \case
PictureFromURL url -> typedObj "url" [("url", strJSON url)]
listStyleToJSON :: ListStyle -> TL.Text
listStyleToJSON = \case
NumberedList -> "\"numbered\""
BulletList -> "\"bullet\""
cellStyleToJSON :: CellStyle -> TL.Text
cellStyleToJSON = \case
NormalCell -> "\"normal\""
HeaderCell -> "\"header\""
colorToJSON :: Color -> TL.Text
colorToJSON (Color r g b) =
typedObj "rgb" [("r", showTL r), ("g", showTL g), ("b", showTL b)]