github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-11-24 08:54:07 +03:00
Code Issues Projects Releases Wiki Activity

Define Prec as a newtype.

Browse Source
This commit is contained in:
Rob Rix 2019-07-23 12:24:45 -04:00
parent 3da182dcec
commit 96127627f6
No known key found for this signature in database
GPG Key ID: F188A01508EA1CF7
1 changed files with 7 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
semantic-core/src/Data/Core/Pretty.hs
View File

@ -41,24 +41,25 @@ symbol = annotate (Pretty.color Pretty.Yellow)
strlit = annotate (Pretty.colorDull Pretty.Green)
primitive = keyword . mappend "#"
type Prec = Int
newtype Prec = Prec { unPrec :: Int }
deriving (Eq, Ord, Show)
data Style = Unicode | Ascii
name :: User -> AnsiDoc
name n = if needsQuotation n then enclose (symbol "#{") (symbol "}") (pretty n) else pretty n
with :: (Member (Reader Prec) sig, Carrier sig m) => Prec -> m a -> m a
with n = local (const n)
with :: (Member (Reader Prec) sig, Carrier sig m) => Int -> m a -> m a
with n = local (const (Prec n))
inParens :: (Member (Reader Prec) sig, Carrier sig m) => Prec -> m AnsiDoc -> m AnsiDoc
inParens :: (Member (Reader Prec) sig, Carrier sig m) => Int -> m AnsiDoc -> m AnsiDoc
inParens amount go = do
prec <- ask
body <- with amount go
pure (if prec > amount then parens body else body)
pure (if prec > Prec amount then parens body else body)
prettyCore :: Style -> Term Core User -> AnsiDoc
prettyCore style = run . runReader @Prec 0 . go . fmap name
prettyCore style = run . runReader (Prec 0) . go . fmap name
where go = \case
Var v -> pure v
Term t -> case t of