tweak the pretty printer stuff slightly
This commit is contained in:
parent
52e54dcc3c
commit
d6985cad55
1 changed files with 18 additions and 8 deletions
|
@ -1,24 +1,32 @@
|
||||||
-- this module has to be called this because a module A.B's private elements are
|
-- this module has to be called this because a module A.B's private elements are
|
||||||
-- still visible to A.B.C, even if they're in different packages. which i don't
|
-- still visible to A.B.C, even if they're in different packages. which i don't
|
||||||
-- think is a good idea but i also don't want to fork prettier over it
|
-- think is a good idea but i also don't want to fork prettier over it
|
||||||
|
--
|
||||||
|
-- also i adapted this code from stefan höck's prettier-ansi package
|
||||||
|
-- (https://github.com/idris-community/idris2-ansi)
|
||||||
module Text.PrettyPrint.Bernardy.Core.Decorate
|
module Text.PrettyPrint.Bernardy.Core.Decorate
|
||||||
|
|
||||||
import public Text.PrettyPrint.Bernardy.Core
|
import public Text.PrettyPrint.Bernardy.Core
|
||||||
import Data.DPair
|
import Data.DPair
|
||||||
import Data.String
|
import Data.String
|
||||||
|
import Derive.Prelude
|
||||||
|
|
||||||
|
%language ElabReflection
|
||||||
|
|
||||||
|
|
||||||
public export
|
public export
|
||||||
record Highlight where
|
record Highlight where
|
||||||
constructor MkHighlight
|
constructor MkHighlight
|
||||||
before, after : String
|
before, after : String
|
||||||
|
%name Highlight h
|
||||||
|
%runElab derive "Highlight" [Eq]
|
||||||
|
|
||||||
export
|
export
|
||||||
emptyHL : Highlight -> Bool
|
emptyHL : Highlight
|
||||||
emptyHL (MkHighlight before after) = before == "" && after == ""
|
emptyHL = MkHighlight "" ""
|
||||||
|
|
||||||
|
|
||||||
-- taken from prettier-ansi
|
-- lifted from prettier-ansi
|
||||||
private
|
private
|
||||||
decorateImpl : Highlight ->
|
decorateImpl : Highlight ->
|
||||||
(ss : SnocList String) -> (0 _ : NonEmptySnoc ss) =>
|
(ss : SnocList String) -> (0 _ : NonEmptySnoc ss) =>
|
||||||
|
@ -35,17 +43,19 @@ decorateImpl h (sx :< x) = Element (go [] sx :< (x ++ h.after)) %search
|
||||||
||| changing its stats like width or height.
|
||| changing its stats like width or height.
|
||||||
export
|
export
|
||||||
decorateLayout : Highlight -> Layout -> Layout
|
decorateLayout : Highlight -> Layout -> Layout
|
||||||
decorateLayout h l@(MkLayout content stats) =
|
decorateLayout h (MkLayout content stats) =
|
||||||
if emptyHL h then l else
|
|
||||||
layout (decorateImpl h content) stats
|
layout (decorateImpl h content) stats
|
||||||
|
|
||||||
||| Decorate a `Doc` with the given highlighting *without*
|
||| Decorate a `Doc` with the given highlighting *without*
|
||||||
||| changing its stats like width or height.
|
||| changing its stats like width or height.
|
||||||
export
|
export
|
||||||
decorate : {opts : _} -> Highlight -> Doc opts -> Doc opts
|
decorate : {opts : LayoutOpts} -> Highlight -> Doc opts -> Doc opts
|
||||||
decorate h doc = doc >>= \l => pure (decorateLayout h l)
|
decorate h doc =
|
||||||
|
if h == emptyHL then doc else doc >>= pure . decorateLayout h
|
||||||
|
|
||||||
|
|
||||||
|
-- this function has nothing to do with highlighting but it's here because it
|
||||||
|
-- _also_ needs access to the private stuff
|
||||||
||| render a doc with no line breaks at all
|
||| render a doc with no line breaks at all
|
||||||
export
|
export
|
||||||
renderInfinite : Doc opts -> String
|
renderInfinite : Doc opts -> String
|
||||||
|
|
Loading…
Reference in a new issue