move BannerOpts to PrettyOpts
This commit is contained in:
parent
9088ec02a0
commit
2446655b08
2 changed files with 30 additions and 25 deletions
23
src/Quox.idr
23
src/Quox.idr
|
@ -12,17 +12,8 @@ import Data.Vect
|
||||||
import Control.ANSI
|
import Control.ANSI
|
||||||
|
|
||||||
|
|
||||||
public export
|
|
||||||
record BannerOpts where
|
|
||||||
constructor MakeBannerOpts
|
|
||||||
unicode, color : Bool
|
|
||||||
|
|
||||||
public export
|
|
||||||
defBannerOpts : BannerOpts
|
|
||||||
defBannerOpts = MakeBannerOpts {unicode = True, color = True}
|
|
||||||
|
|
||||||
private
|
private
|
||||||
text : BannerOpts -> List String
|
text : PrettyOpts -> List String
|
||||||
text _ =
|
text _ =
|
||||||
["",
|
["",
|
||||||
#" ___ ___ _____ __ __"#,
|
#" ___ ___ _____ __ __"#,
|
||||||
|
@ -32,7 +23,7 @@ text _ =
|
||||||
""]
|
""]
|
||||||
|
|
||||||
private
|
private
|
||||||
qtuwu : BannerOpts -> List String
|
qtuwu : PrettyOpts -> List String
|
||||||
qtuwu opts =
|
qtuwu opts =
|
||||||
if opts.unicode then
|
if opts.unicode then
|
||||||
[#" ___,-´⎠ "#,
|
[#" ___,-´⎠ "#,
|
||||||
|
@ -50,7 +41,7 @@ qtuwu opts =
|
||||||
#" (---) | "#]
|
#" (---) | "#]
|
||||||
|
|
||||||
private
|
private
|
||||||
join1 : BannerOpts -> String -> String -> String
|
join1 : PrettyOpts -> String -> String -> String
|
||||||
join1 opts l r =
|
join1 opts l r =
|
||||||
if opts.color then
|
if opts.color then
|
||||||
" " <+> show (colored Green l) <+> " " <+> show (colored Magenta r)
|
" " <+> show (colored Green l) <+> " " <+> show (colored Magenta r)
|
||||||
|
@ -58,7 +49,7 @@ join1 opts l r =
|
||||||
" " <+> l <+> " " <+> r
|
" " <+> l <+> " " <+> r
|
||||||
|
|
||||||
export
|
export
|
||||||
banner : BannerOpts -> String
|
banner : PrettyOpts -> String
|
||||||
banner opts = unlines $ zipWith (join1 opts) (qtuwu opts) (text opts)
|
banner opts = unlines $ zipWith (join1 opts) (qtuwu opts) (text opts)
|
||||||
|
|
||||||
export
|
export
|
||||||
|
@ -70,6 +61,6 @@ tm =
|
||||||
|
|
||||||
main : IO Unit
|
main : IO Unit
|
||||||
main = do
|
main = do
|
||||||
putStrLn $ banner defBannerOpts
|
putStrLn $ banner defPrettyOpts
|
||||||
prettyTerm tm
|
prettyTermDef tm
|
||||||
prettyTerm $ pushSubstsT tm
|
prettyTermDef $ pushSubstsT tm
|
||||||
|
|
|
@ -14,6 +14,16 @@ import public Control.Monad.Reader
|
||||||
%default total
|
%default total
|
||||||
|
|
||||||
|
|
||||||
|
public export
|
||||||
|
record PrettyOpts where
|
||||||
|
constructor MakePrettyOpts
|
||||||
|
unicode, color : Bool
|
||||||
|
|
||||||
|
public export
|
||||||
|
defPrettyOpts : PrettyOpts
|
||||||
|
defPrettyOpts = MakePrettyOpts {unicode = True, color = True}
|
||||||
|
|
||||||
|
|
||||||
public export
|
public export
|
||||||
data HL
|
data HL
|
||||||
= Delim
|
= Delim
|
||||||
|
@ -160,8 +170,8 @@ pretty0M : (PrettyHL a, HasEnv m) => a -> m (Doc HL)
|
||||||
pretty0M = local {prec := Outer} . prettyM
|
pretty0M = local {prec := Outer} . prettyM
|
||||||
|
|
||||||
export %inline
|
export %inline
|
||||||
pretty0 : PrettyHL a => {default True unicode : Bool} -> a -> Doc HL
|
pretty0 : PrettyHL a => (unicode : Bool) -> a -> Doc HL
|
||||||
pretty0 x {unicode} =
|
pretty0 unicode x =
|
||||||
let env = MakePrettyEnv {dnames = [], tnames = [], unicode, prec = Outer} in
|
let env = MakePrettyEnv {dnames = [], tnames = [], unicode, prec = Outer} in
|
||||||
runReader env $ prettyM x
|
runReader env $ prettyM x
|
||||||
|
|
||||||
|
@ -180,10 +190,10 @@ export PrettyHL Name where prettyM = pure . pretty . toDots
|
||||||
|
|
||||||
|
|
||||||
export %inline
|
export %inline
|
||||||
prettyStr : PrettyHL a => {default True unicode : Bool} -> a -> String
|
prettyStr : PrettyHL a => (unicode : Bool) -> a -> String
|
||||||
prettyStr {unicode} =
|
prettyStr unicode =
|
||||||
let layout = layoutSmart (MkLayoutOptions (AvailablePerLine 80 0.8)) in
|
let layout = layoutSmart (MkLayoutOptions (AvailablePerLine 80 0.8)) in
|
||||||
renderString . layout . pretty0 {unicode}
|
renderString . layout . pretty0 unicode
|
||||||
|
|
||||||
|
|
||||||
export
|
export
|
||||||
|
@ -199,10 +209,14 @@ termHL Free = color BrightWhite
|
||||||
termHL Syntax = color BrightCyan
|
termHL Syntax = color BrightCyan
|
||||||
|
|
||||||
export %inline
|
export %inline
|
||||||
prettyTerm : {default True color, unicode : Bool} -> PrettyHL a => a -> IO Unit
|
prettyTerm : PrettyOpts -> PrettyHL a => a -> IO Unit
|
||||||
prettyTerm x {color, unicode} =
|
prettyTerm opts x =
|
||||||
let reann = if color then map termHL else unAnnotate in
|
let reann = if opts.color then map termHL else unAnnotate in
|
||||||
Terminal.putDoc $ reann $ pretty0 x {unicode}
|
Terminal.putDoc $ reann $ pretty0 opts.unicode x
|
||||||
|
|
||||||
|
export %inline
|
||||||
|
prettyTermDef : PrettyHL a => a -> IO Unit
|
||||||
|
prettyTermDef = prettyTerm defPrettyOpts
|
||||||
|
|
||||||
|
|
||||||
infixr 6 <//>
|
infixr 6 <//>
|
||||||
|
|
Loading…
Reference in a new issue