{-# LANGUAGE CPP                  #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE LambdaCase           #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TypeSynonymInstances #-}

module Language.Sexp.Encode (encode) where

import Data.Functor.Foldable (cata)
import Data.List (intersperse)
import Data.Scientific
import qualified Data.Text.Encoding as T (encodeUtf8)
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TL (encodeUtf8)
import Data.ByteString.Lazy.Char8 (ByteString)
import Data.ByteString.Lazy.Builder.ASCII

#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup
#endif

import Language.Sexp.Types
import Language.Sexp.Token (escape)

buildSexp :: Fix SexpF -> Builder
buildSexp :: Fix SexpF -> Builder
buildSexp = (Base (Fix SexpF) Builder -> Builder) -> Fix SexpF -> Builder
forall t a. Recursive t => (Base t a -> a) -> t -> a
cata Base (Fix SexpF) Builder -> Builder
SexpF Builder -> Builder
alg
  where
    hsep :: [Builder] -> Builder
    hsep :: [Builder] -> Builder
hsep = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> ([Builder] -> [Builder]) -> [Builder] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (Char -> Builder
char8 Char
' ')

    alg :: SexpF Builder -> Builder
    alg :: SexpF Builder -> Builder
alg = \case
      AtomF Atom
atom -> case Atom
atom of
        AtomNumber Scientific
a
          | Scientific -> Bool
isInteger Scientific
a -> String -> Builder
string8 (FPFormat -> Maybe Int -> Scientific -> String
formatScientific FPFormat
Fixed (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0) Scientific
a)
          | Bool
otherwise   -> String -> Builder
string8 (FPFormat -> Maybe Int -> Scientific -> String
formatScientific FPFormat
Fixed Maybe Int
forall a. Maybe a
Nothing Scientific
a)
        AtomString Text
a    -> Char -> Builder
char8 Char
'"' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
lazyByteString (Text -> ByteString
TL.encodeUtf8 (Text -> Text
escape (Text -> Text
TL.fromStrict Text
a))) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char8 Char
'"'
        AtomSymbol Text
a    -> ByteString -> Builder
byteString (Text -> ByteString
T.encodeUtf8 Text
a)
      ParenListF [Builder]
ss   -> Char -> Builder
char8 Char
'(' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
hsep [Builder]
ss Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char8 Char
')'
      BracketListF [Builder]
ss -> Char -> Builder
char8 Char
'[' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
hsep [Builder]
ss Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char8 Char
']'
      BraceListF [Builder]
ss   -> Char -> Builder
char8 Char
'{' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
hsep [Builder]
ss Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char8 Char
'}'
      ModifiedF Prefix
q Builder
a   -> case Prefix
q of
        Prefix
Quote    -> Char -> Builder
char8 Char
'\'' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
a
        Prefix
Backtick -> Char -> Builder
char8 Char
'`' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
a
        Prefix
Comma    -> Char -> Builder
char8 Char
',' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
a
        Prefix
CommaAt  -> Char -> Builder
char8 Char
',' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char8 Char
'@' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
a
        Prefix
Hash     -> Char -> Builder
char8 Char
'#' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
a

encode :: Fix SexpF -> ByteString
encode :: Fix SexpF -> ByteString
encode = Builder -> ByteString
toLazyByteString (Builder -> ByteString)
-> (Fix SexpF -> Builder) -> Fix SexpF -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fix SexpF -> Builder
buildSexp