morley-prelude-0.5.3: src/Fmt/Utils.hs

-- SPDX-FileCopyrightText: 2023 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

{-# LANGUAGE NoImplicitPrelude #-}

-- | Compatibility layer between @prettyprinter@ and @wl-pprint-text@
module Fmt.Utils
  ( Doc
  , SimpleDoc
  , renderOneLine
  , isEmpty
  , linebreak
  , softbreak
  , mkLayoutOptions
  ) where

import Universum (Bool(..), Double, Int, flip, mempty, ($), (+), (...))

import Prettyprinter qualified as PP
import Prettyprinter.Internal qualified as PP (Doc(..))

-- | Document without annotations
type Doc = PP.Doc ()

-- | Simple document without annotations
type SimpleDoc = PP.SimpleDocStream ()

{- | Check if 'Doc' is 'mempty'. Note that empty strings are also considered
empty.

>>> isEmpty mempty
True
>>> isEmpty ""
True
>>> isEmpty "foo"
False
-}
isEmpty :: Doc -> Bool
isEmpty PP.Empty = True
isEmpty _ = False

-- | Rendered as newline, when undone by @group@, is @mempty@.
linebreak :: Doc
linebreak = PP.flatAlt PP.line mempty

-- | Like @mempty@ if the output fits the page, otherwise like @line@.
softbreak :: Doc
softbreak = PP.group linebreak

renderOneLine :: Doc -> SimpleDoc
renderOneLine dc = scan 0 [dc]
  where
    scan _ [] = PP.SEmpty
    scan !k (d:ds) = case d of
      PP.Fail            -> PP.SFail
      PP.Empty           -> scan k ds
      PP.Char c          -> PP.SChar c $ scan (k + 1) ds
      PP.Text l s        -> PP.SText l s $ scan (k + l) ds
      PP.Line            -> scan k ds
      PP.Cat x y         -> scan k (x : y : ds)
      PP.Nest _ x        -> scan k (x : ds)
      PP.Union x _       -> scan k (x : ds)
      PP.Column f        -> scan k (f k : ds)
      PP.Nesting f       -> scan k (f 0 : ds)
      PP.FlatAlt _ y     -> scan k (y : ds)
      PP.WithPageWidth f -> scan k (f PP.Unbounded : ds)
      PP.Annotated _ x   -> scan k (x : ds)

mkLayoutOptions :: Double -> Int -> PP.LayoutOptions
mkLayoutOptions = PP.LayoutOptions ... flip PP.AvailablePerLine