{-# LANGUAGE ViewPatterns #-}
module Language.Egison.Pretty.Pattern.External
( name
, varName
, valueExpr
)
where
import Data.Text ( Text
, unpack
)
import Language.Egison.Pretty.Pattern.Prim
( Doc
, text
, parens
)
import Language.Egison.Pretty.Pattern.Print
( Print
, askMode
)
import Language.Egison.Pretty.Pattern.PrintMode
( PrintMode(..) )
surroundedBy :: (Char, Char) -> String -> Bool
surroundedBy (begin, end) (h : (reverse -> (l : body)))
| h == begin && l == end = foldr go 0 body == 0
where
go :: Char -> Int -> Int
go c | c == begin = (+) 1
| c == end = (-) 1
| otherwise = id
surroundedBy _ _ = False
lexicalChunk :: Text -> Doc
lexicalChunk txt
| containsDelimiter str && not (checkSurrounding str) = parens $ text txt
| otherwise = text txt
where
containsDelimiter x = elem ' ' x || elem ',' x || elem ')' x || elem ']' x
checkSurrounding x = surroundedBy ('(', ')') x || surroundedBy ('[', ']') x
str = unpack txt
varName :: v -> Print n v e Doc
varName v = do
PrintMode { varNamePrinter } <- askMode
pure . lexicalChunk $ varNamePrinter v
name :: n -> Print n v e Doc
name n = do
PrintMode { namePrinter } <- askMode
pure . lexicalChunk $ namePrinter n
valueExpr :: e -> Print n v e Doc
valueExpr e = do
PrintMode { valueExprPrinter } <- askMode
pure . lexicalChunk $ valueExprPrinter e