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

{-# OPTIONS_GHC -fno-warn-orphans #-}

module Language.Sexp.Pretty
  ( format
  ) where

import Data.ByteString.Lazy.Char8 (ByteString)
import Data.Functor.Foldable (para)
import Data.Scientific
import qualified Data.Text.Lazy as TL
import Data.Text.Lazy.Encoding (encodeUtf8)

#if MIN_VERSION_prettyprinter(1,7,0)
import Prettyprinter
import Prettyprinter.Internal (unsafeTextWithoutNewlines)
import qualified Prettyprinter.Render.Text as Render
#else
import Data.Text.Prettyprint.Doc
import Data.Text.Prettyprint.Doc.Internal (unsafeTextWithoutNewlines)
import qualified Data.Text.Prettyprint.Doc.Render.Text as Render
#endif

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

instance Pretty Atom where
  pretty = \case
    AtomNumber a
      | isInteger a -> pretty $ formatScientific Fixed (Just 0) a
      | otherwise   -> pretty $ formatScientific Fixed Nothing $ a
    AtomString a  -> dquotes (unsafeTextWithoutNewlines . TL.toStrict . escape . TL.fromStrict $ a)
    AtomSymbol a  -> pretty a

ppList :: [(Fix SexpF, Doc ann)] -> Doc ann
ppList ls = case ls of
  ((Fix (AtomF _),_) : _) ->
    group $ align $ nest 1 $ vsep $ map snd ls
  _other ->
    group $ align $ vsep $ map snd ls

ppSexp :: Fix SexpF -> Doc ann
ppSexp = para $ \case
  AtomF a          -> pretty a
  ParenListF ss    -> parens $ ppList ss
  BracketListF ss  -> brackets $ ppList ss
  BraceListF ss    -> braces $ ppList ss
  ModifiedF q a    ->
    case q of
      Quote    -> "'"  <> snd a
      Backtick -> "`"  <> snd a
      Comma    -> ","  <> snd a
      CommaAt  -> ",@" <> snd a
      Hash     -> "#"  <> snd a

instance Pretty (Fix SexpF) where
  pretty = ppSexp

-- | Serialize a 'Sexp' into a pretty-printed string
format :: Fix SexpF -> ByteString
format =
  encodeUtf8 .
    Render.renderLazy .
      layoutSmart (LayoutOptions (AvailablePerLine 79 0.75)) .
        ppSexp