66 lines
2.1 KiB
Idris
66 lines
2.1 KiB
Idris
-- 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
|
|
-- 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
|
|
|
|
import public Text.PrettyPrint.Bernardy.Core
|
|
import Data.DPair
|
|
import Data.String
|
|
import Derive.Prelude
|
|
|
|
%language ElabReflection
|
|
|
|
|
|
public export
|
|
record Highlight where
|
|
constructor MkHighlight
|
|
before, after : String
|
|
%name Highlight h
|
|
%runElab derive "Highlight" [Eq]
|
|
|
|
export
|
|
emptyHL : Highlight
|
|
emptyHL = MkHighlight "" ""
|
|
|
|
|
|
-- lifted from prettier-ansi
|
|
private
|
|
decorateImpl : Highlight ->
|
|
(ss : SnocList String) -> (0 _ : NonEmptySnoc ss) =>
|
|
Subset (SnocList String) NonEmptySnoc
|
|
decorateImpl h [< x] = Element [< h.before ++ x ++ h.after] %search
|
|
decorateImpl h (sx :< x) = Element (go [] sx :< (x ++ h.after)) %search
|
|
where
|
|
go : List String -> SnocList String -> SnocList String
|
|
go strs [< x] = [< h.before ++ x] <>< strs
|
|
go strs (sx :< x) = go (x :: strs) sx
|
|
go strs [<] = [<] <>< strs
|
|
|
|
||| Decorate a `Layout` with the given ANSI codes *without*
|
|
||| changing its stats like width or height.
|
|
export
|
|
decorateLayout : Highlight -> Layout -> Layout
|
|
decorateLayout h (MkLayout content stats) =
|
|
layout (decorateImpl h content) stats
|
|
|
|
||| Decorate a `Doc` with the given highlighting *without*
|
|
||| changing its stats like width or height.
|
|
export
|
|
decorate : {opts : LayoutOpts} -> Highlight -> Doc opts -> Doc opts
|
|
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
|
|
export
|
|
renderInfinite : Doc opts -> String
|
|
renderInfinite (MkDoc (MkLayout content _) _) = unwords content where
|
|
unwords : SnocList String -> String
|
|
unwords [<] = ""
|
|
unwords (xs :< x) = foldMap (++ " ") xs ++ x
|