|
|
- {-# OPTIONS_GHC -Wno-orphans #-}
- {-# LANGUAGE ViewPatterns #-}
- module Syntax.Pretty where
-
- import Control.Arrow (Arrow(first))
-
- import qualified Data.Text.Lazy as L
- import qualified Data.Text as T
- import Data.Text (Text)
-
- import Presyntax.Presyntax (Plicity(..))
-
- import Prettyprinter.Render.Terminal
- import Prettyprinter
-
- import Syntax
-
- instance Pretty Name where
- pretty (Bound x) = pretty x
- pretty (Defined x) = pretty x
-
- prettyTm :: Term -> Doc AnsiStyle
- prettyTm (Ref v) = pretty v
-
- prettyTm (App Im f x) = parenFun f <+> braces (prettyTm x)
- prettyTm (App Ex f x) = parenFun f <+> parenArg x
-
- prettyTm (Pair x y) = parens $ prettyTm x <> operator comma <+> prettyTm y
- prettyTm (Proj1 x) = prettyTm x <> operator (pretty ".1")
- prettyTm (Proj2 x) = prettyTm x <> operator (pretty ".2")
-
- prettyTm l@(Lam _ _ _) = pretty '\\' <> hsep (map prettyArgList al) <+> pretty "->" <+> prettyTm bod where
- unwindLam (Lam p x y) = first ((p, x):) (unwindLam y)
- unwindLam t = ([], t)
-
- (al, bod) = unwindLam l
-
- prettyArgList (Ex, v) = pretty v
- prettyArgList (Im, v) = braces (pretty v)
-
- prettyTm (Meta x) = keyword $ pretty '?' <> pretty (mvName x)
- prettyTm Type{} = keyword $ pretty "Type"
- prettyTm Typeω{} = keyword $ pretty "Typeω"
- prettyTm I{} = keyword $ pretty "I"
- prettyTm I0{} = keyword $ pretty "i0"
- prettyTm I1{} = keyword $ pretty "i1"
-
- prettyTm (Pi Ex (T.unpack -> "_") d r) = prettyDom d <+> pretty "->" <+> prettyTm r
- prettyTm (Pi Im v d r) = braces (pretty v <+> colon <+> prettyTm d) <+> pretty "->" <+> prettyTm r
- prettyTm (Pi Ex v d r) = parens (pretty v <+> colon <+> prettyTm d) <+> pretty "->" <+> prettyTm r
-
- prettyTm (Sigma (T.unpack -> "_") d r) = prettyDom d <+> pretty "*" <+> prettyTm r
- prettyTm (Sigma v d r) = parens (pretty v <+> colon <+> prettyTm d) <+> pretty "*" <+> prettyTm r
-
- prettyTm (IAnd x y) = prettyTm x <+> operator (pretty "&&") <+> prettyTm y
- prettyTm (IOr x y) = prettyTm x <+> operator (pretty "||") <+> prettyTm y
- prettyTm (INot x) = operator (pretty '~') <> prettyTm x
-
- prettyTm (PathP l x y) = keyword (pretty "PathP") <+> parenArg l <+> parenArg x <+> parenArg y
- prettyTm (IElim _ _ _ f i) = prettyTm (App Ex f i)
- prettyTm (PathIntro _ f) = prettyTm f
-
- keyword :: Doc AnsiStyle -> Doc AnsiStyle
- keyword = annotate (color Magenta)
-
- operator :: Doc AnsiStyle -> Doc AnsiStyle
- operator = annotate (color Yellow)
-
- parenArg :: Term -> Doc AnsiStyle
- parenArg x@App{} = parens (prettyTm x)
- parenArg x@IElim{} = parens (prettyTm x)
- parenArg x = prettyDom x
-
- prettyDom :: Term -> Doc AnsiStyle
- prettyDom x@Pi{} = parens (prettyTm x)
- prettyDom x@Sigma{} = parens (prettyTm x)
- prettyDom x = parenFun x
-
- parenFun :: Term -> Doc AnsiStyle
- parenFun x@Lam{} = parens $ prettyTm x
- parenFun x@PathIntro{} = parens $ prettyTm x
- parenFun x = prettyTm x
-
- render :: Doc AnsiStyle -> Text
- render = L.toStrict . renderLazy . layoutPretty defaultLayoutOptions
-
- showValue :: Value -> String
- showValue = L.unpack . renderLazy . layoutPretty defaultLayoutOptions . prettyTm . quote
|