-- 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
module Text.PrettyPrint.Bernardy.Core.Decorate

import public Text.PrettyPrint.Bernardy.Core
import Data.DPair


public export
record Highlight where
  constructor MkHighlight
  before, after : String

export
emptyHL : Highlight -> Bool
emptyHL (MkHighlight before after) = before == "" && after == ""


-- taken 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 l@(MkLayout content stats) =
  if emptyHL h then l else
  layout (decorateImpl h content) stats

||| Decorate a `Doc` with the given highlighting *without*
||| changing its stats like width or height.
export
decorate : {opts : _} -> Highlight -> Doc opts -> Doc opts
decorate h doc = doc >>= \l => pure (decorateLayout h l)