adnot/Data/Adnot/Emit.hs

{-# LANGUAGE OverloadedStrings #-}

module Data.Adnot.Emit where

import           Control.Monad (sequence)
import           Data.ByteString.Lazy (ByteString)
import           Data.ByteString.Builder
import           Data.List (intersperse)
import qualified Data.Map.Strict as M
import           Data.Monoid ((<>))
import           Data.Text (Text)
import qualified Data.Text as T
import           Data.Text.Encoding (encodeUtf8Builder)
import qualified Data.Vector as V

import Data.Adnot.Type

encodeValue :: Value -> ByteString
encodeValue = toLazyByteString . buildValue

buildValue :: Value -> Builder
buildValue (Sum n vs)
  | V.null vs = char7 '(' <> buildString n <> char7 ')'
  | otherwise =
    char7 '(' <> buildString n <> char7 ' ' <> spaceSepArr vs <> char7 ')'
buildValue (Product ps) =
  char7 '{' <> buildPairs ps <> char7 '}'
buildValue (List vs) =
  char7 '[' <> spaceSepArr vs <> char7 ']'
buildValue (Integer i) = integerDec i
buildValue (Double d) = doubleDec d
buildValue (String t) = buildString t

buildString t
  | isValidSymbol t = encodeUtf8Builder t
  | otherwise       = char7 '"' <> escape t <> char7 '"'

escape :: T.Text -> Builder
escape = T.foldr go mempty
  where go '"'  r = byteString "\\\"" <> r
        go '\n' r = byteString "\\n" <> r
        go '\\' r = byteString "\\\\" <> r
        go c    r = char7 c <> r

spaceSep :: [Builder] -> Builder
spaceSep = mconcat . intersperse (char7 ' ')

spaceSepArr :: Array -> Builder
spaceSepArr = spaceSep . map buildValue . V.toList

buildPairs :: Product -> Builder
buildPairs ps = spaceSep [ go k v | (k, v) <- M.toList ps ]
  where go k v = buildString k <> char7 ' ' <> buildValue v