module Text.Show.Prettyprint.Internal (
shownP,
valueP,
identifierP,
numberP,
stringLitP,
charLitP,
argP,
unitP,
tupleP,
listP,
recordP,
) where
import Control.Applicative
import Data.Text.Prettyprint.Doc as Ppr
import Text.Trifecta as Tri
shownP :: Parser (Doc ann)
shownP = valueP <* eof
valueP :: Parser (Doc ann)
valueP = do
thing <- choice [identifierP, numberP, stringLitP, charLitP]
args <- many argP
pure (if null args
then thing
else thing <+> align (sep args) )
identifierP :: Parser (Doc ann)
identifierP = token (p <?> "identifier")
where
p = fmap Ppr.pretty (some (alphaNum <|> oneOf "'_"))
numberP :: Parser (Doc ann)
numberP = p <?> "number"
where
p = integerOrDouble >>= \case
Left i -> pure (pretty i)
Right d -> pure (pretty d)
stringLitP :: Parser (Doc ann)
stringLitP = token (p <?> "string literal")
where
p = fmap (dquotes . pretty) (stringLiteral :: Parser String)
charLitP :: Parser (Doc ann)
charLitP = token (p <?> "char literal")
where
p = fmap (squotes . pretty) Tri.charLiteral
argP :: Parser (Doc ann)
argP = (token . choice) [unitP, tupleP, listP, recordP, valueP]
unitP :: Parser (Doc ann)
unitP = p <?> "unit"
where
p = fmap pretty (Tri.string "()")
tupleP :: Parser (Doc ann)
tupleP = p <?> "tuple"
where
p = fmap (encloseSep lparen rparen Ppr.comma) (Tri.parens (do
x <- argP
xs <- many (Tri.comma *> argP)
pure (x:xs) ))
listP :: Parser (Doc ann)
listP = p <?> "list"
where
p = fmap (encloseSep lbracket rbracket Ppr.comma)
(Tri.brackets (sepBy argP Tri.comma))
recordP :: Parser (Doc ann)
recordP = p <?> "record"
where
p = fmap (encloseSep lbrace rbrace Ppr.comma) (Tri.braces (sepBy recordEntryP Tri.comma))
recordEntryP = do
lhs <- token identifierP
_ <- token (Tri.char '=')
rhs <- argP
pure (lhs <+> pretty "=" <+> rhs)