-- | This is just a simple token printer. It's not a full fledged formatter, but
-- it is used by the layout golden tests. Printing each token in the tree with
-- this printer will result in the exact input that was given to the lexer.

module Language.PureScript.CST.Print
  ( printToken
  , printTokens
  , printModule
  , printLeadingComment
  , printTrailingComment
  ) where

import Prelude

import qualified Data.DList as DList
import Data.Text (Text)
import qualified Data.Text as Text
import Language.PureScript.CST.Types
import Language.PureScript.CST.Flatten (flattenModule)

printToken :: Token -> Text
printToken :: Token -> Text
printToken = Bool -> Token -> Text
printToken' Bool
True

-- | Prints a given Token. The bool controls whether or not layout
-- tokens should be printed.
printToken' :: Bool -> Token -> Text
printToken' :: Bool -> Token -> Text
printToken' Bool
showLayout = \case
  Token
TokLeftParen             -> Text
"("
  Token
TokRightParen            -> Text
")"
  Token
TokLeftBrace             -> Text
"{"
  Token
TokRightBrace            -> Text
"}"
  Token
TokLeftSquare            -> Text
"["
  Token
TokRightSquare           -> Text
"]"
  TokLeftArrow SourceStyle
ASCII       -> Text
"<-"
  TokLeftArrow SourceStyle
Unicode     -> Text
"←"
  TokRightArrow SourceStyle
ASCII      -> Text
"->"
  TokRightArrow SourceStyle
Unicode    -> Text
"→"
  TokRightFatArrow SourceStyle
ASCII   -> Text
"=>"
  TokRightFatArrow SourceStyle
Unicode -> Text
"⇒"
  TokDoubleColon SourceStyle
ASCII     -> Text
"::"
  TokDoubleColon SourceStyle
Unicode   -> Text
"∷"
  TokForall SourceStyle
ASCII          -> Text
"forall"
  TokForall SourceStyle
Unicode        -> Text
"∀"
  Token
TokEquals                -> Text
"="
  Token
TokPipe                  -> Text
"|"
  Token
TokTick                  -> Text
"`"
  Token
TokDot                   -> Text
"."
  Token
TokComma                 -> Text
","
  Token
TokUnderscore            -> Text
"_"
  Token
TokBackslash             -> Text
"\\"
  TokLowerName [Text]
qual Text
name   -> [Text] -> Text
printQual [Text]
qual forall a. Semigroup a => a -> a -> a
<> Text
name
  TokUpperName [Text]
qual Text
name   -> [Text] -> Text
printQual [Text]
qual forall a. Semigroup a => a -> a -> a
<> Text
name
  TokOperator [Text]
qual Text
sym     -> [Text] -> Text
printQual [Text]
qual forall a. Semigroup a => a -> a -> a
<> Text
sym
  TokSymbolName [Text]
qual Text
sym   -> [Text] -> Text
printQual [Text]
qual forall a. Semigroup a => a -> a -> a
<> Text
"(" forall a. Semigroup a => a -> a -> a
<> Text
sym forall a. Semigroup a => a -> a -> a
<> Text
")"
  TokSymbolArr SourceStyle
Unicode     -> Text
"(→)"
  TokSymbolArr SourceStyle
ASCII       -> Text
"(->)"
  TokHole Text
hole             -> Text
"?" forall a. Semigroup a => a -> a -> a
<> Text
hole
  TokChar Text
raw Char
_            -> Text
"'" forall a. Semigroup a => a -> a -> a
<> Text
raw forall a. Semigroup a => a -> a -> a
<> Text
"'"
  TokString Text
raw PSString
_          -> Text
"\"" forall a. Semigroup a => a -> a -> a
<> Text
raw forall a. Semigroup a => a -> a -> a
<> Text
"\""
  TokRawString Text
raw         -> Text
"\"\"\"" forall a. Semigroup a => a -> a -> a
<> Text
raw forall a. Semigroup a => a -> a -> a
<> Text
"\"\"\""
  TokInt Text
raw Integer
_             -> Text
raw
  TokNumber Text
raw Double
_          -> Text
raw
  Token
TokLayoutStart           -> if Bool
showLayout then Text
"{" else Text
""
  Token
TokLayoutSep             -> if Bool
showLayout then Text
";" else Text
""
  Token
TokLayoutEnd             -> if Bool
showLayout then Text
"}" else Text
""
  Token
TokEof                   -> if Bool
showLayout then Text
"<eof>" else Text
""

printQual :: [Text] -> Text
printQual :: [Text] -> Text
printQual = [Text] -> Text
Text.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. Semigroup a => a -> a -> a
<> Text
".")

printTokens :: [SourceToken] -> Text
printTokens :: [SourceToken] -> Text
printTokens = Bool -> [SourceToken] -> Text
printTokens' Bool
True

printTokens' :: Bool -> [SourceToken] -> Text
printTokens' :: Bool -> [SourceToken] -> Text
printTokens' Bool
showLayout [SourceToken]
toks = [Text] -> Text
Text.concat (forall a b. (a -> b) -> [a] -> [b]
map SourceToken -> Text
pp [SourceToken]
toks)
  where
  pp :: SourceToken -> Text
pp (SourceToken (TokenAnn SourceRange
_ [Comment LineFeed]
leading [Comment Void]
trailing) Token
tok) =
    [Text] -> Text
Text.concat (forall a b. (a -> b) -> [a] -> [b]
map Comment LineFeed -> Text
printLeadingComment [Comment LineFeed]
leading)
      forall a. Semigroup a => a -> a -> a
<> Bool -> Token -> Text
printToken' Bool
showLayout Token
tok
      forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
Text.concat (forall a b. (a -> b) -> [a] -> [b]
map forall void. Comment void -> Text
printTrailingComment [Comment Void]
trailing)

printModule :: Module a -> Text
printModule :: forall a. Module a -> Text
printModule = Bool -> [SourceToken] -> Text
printTokens' Bool
False forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. DList a -> [a]
DList.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Module a -> DList SourceToken
flattenModule

printLeadingComment :: Comment LineFeed -> Text
printLeadingComment :: Comment LineFeed -> Text
printLeadingComment = \case
  Comment Text
raw -> Text
raw
  Space Int
n -> Int -> Text -> Text
Text.replicate Int
n Text
" "
  Line LineFeed
LF -> Text
"\n"
  Line LineFeed
CRLF -> Text
"\r\n"

printTrailingComment :: Comment void -> Text
printTrailingComment :: forall void. Comment void -> Text
printTrailingComment = \case
  Comment Text
raw -> Text
raw
  Space Int
n -> Int -> Text -> Text
Text.replicate Int
n Text
" "
  Line void
_ -> Text
""