move BannerOpts to PrettyOpts

This commit is contained in:
rhiannon morris 2022-04-11 21:58:33 +02:00
parent 9088ec02a0
commit 2446655b08
2 changed files with 30 additions and 25 deletions

View file

@ -12,17 +12,8 @@ import Data.Vect
import Control.ANSI
public export
record BannerOpts where
constructor MakeBannerOpts
unicode, color : Bool
public export
defBannerOpts : BannerOpts
defBannerOpts = MakeBannerOpts {unicode = True, color = True}
private
text : BannerOpts -> List String
text : PrettyOpts -> List String
text _ =
["",
#" ___ ___ _____ __ __"#,
@ -32,7 +23,7 @@ text _ =
""]
private
qtuwu : BannerOpts -> List String
qtuwu : PrettyOpts -> List String
qtuwu opts =
if opts.unicode then
[#" ___,-´⎠ "#,
@ -50,7 +41,7 @@ qtuwu opts =
#" (---) | "#]
private
join1 : BannerOpts -> String -> String -> String
join1 : PrettyOpts -> String -> String -> String
join1 opts l r =
if opts.color then
" " <+> show (colored Green l) <+> " " <+> show (colored Magenta r)
@ -58,7 +49,7 @@ join1 opts l r =
" " <+> l <+> " " <+> r
export
banner : BannerOpts -> String
banner : PrettyOpts -> String
banner opts = unlines $ zipWith (join1 opts) (qtuwu opts) (text opts)
export
@ -70,6 +61,6 @@ tm =
main : IO Unit
main = do
putStrLn $ banner defBannerOpts
prettyTerm tm
prettyTerm $ pushSubstsT tm
putStrLn $ banner defPrettyOpts
prettyTermDef tm
prettyTermDef $ pushSubstsT tm

View file

@ -14,6 +14,16 @@ import public Control.Monad.Reader
%default total
public export
record PrettyOpts where
constructor MakePrettyOpts
unicode, color : Bool
public export
defPrettyOpts : PrettyOpts
defPrettyOpts = MakePrettyOpts {unicode = True, color = True}
public export
data HL
= Delim
@ -160,8 +170,8 @@ pretty0M : (PrettyHL a, HasEnv m) => a -> m (Doc HL)
pretty0M = local {prec := Outer} . prettyM
export %inline
pretty0 : PrettyHL a => {default True unicode : Bool} -> a -> Doc HL
pretty0 x {unicode} =
pretty0 : PrettyHL a => (unicode : Bool) -> a -> Doc HL
pretty0 unicode x =
let env = MakePrettyEnv {dnames = [], tnames = [], unicode, prec = Outer} in
runReader env $ prettyM x
@ -180,10 +190,10 @@ export PrettyHL Name where prettyM = pure . pretty . toDots
export %inline
prettyStr : PrettyHL a => {default True unicode : Bool} -> a -> String
prettyStr {unicode} =
prettyStr : PrettyHL a => (unicode : Bool) -> a -> String
prettyStr unicode =
let layout = layoutSmart (MkLayoutOptions (AvailablePerLine 80 0.8)) in
renderString . layout . pretty0 {unicode}
renderString . layout . pretty0 unicode
export
@ -199,10 +209,14 @@ termHL Free = color BrightWhite
termHL Syntax = color BrightCyan
export %inline
prettyTerm : {default True color, unicode : Bool} -> PrettyHL a => a -> IO Unit
prettyTerm x {color, unicode} =
let reann = if color then map termHL else unAnnotate in
Terminal.putDoc $ reann $ pretty0 x {unicode}
prettyTerm : PrettyOpts -> PrettyHL a => a -> IO Unit
prettyTerm opts x =
let reann = if opts.color then map termHL else unAnnotate in
Terminal.putDoc $ reann $ pretty0 opts.unicode x
export %inline
prettyTermDef : PrettyHL a => a -> IO Unit
prettyTermDef = prettyTerm defPrettyOpts
infixr 6 <//>