{- | The types in 'Generic.Diff' have derived 'Show' instances that don't help at all in
one of the goals for the library, which is readability. This module lets us render those types
in a friendly way.
-}
module Generics.Diff.Render
  ( -- * Rendering
    renderDiffResult
  , renderDiffResultWith

    -- * Printing
  , printDiffResult
  , printDiffResultWith

    -- * Options
  , RenderOpts
  , defaultRenderOpts
  , indentSize
  , numberedLevels

    -- * Helper rendering functions
  , renderDiffError
  , renderDiffErrorWith
  , renderDiffErrorNested
  , renderDiffErrorNestedWith

    -- * Intermediate representation
  , Doc (..)
  , diffErrorDoc
  , renderDoc
  , listDiffErrorDoc
  , diffErrorNestedDoc
  , showB
  , linesDoc
  , makeDoc
  )
where

import Data.List.NonEmpty (NonEmpty (..))
import Data.SOP.NS
import qualified Data.Text as T
import qualified Data.Text.Lazy.Builder as TB
import qualified Data.Text.Lazy.IO as TL
import Generics.Diff.Type
import Generics.SOP as SOP

-- | Sensible rendering defaults. No numbers, 2-space indentation.
defaultRenderOpts :: RenderOpts
defaultRenderOpts :: RenderOpts
defaultRenderOpts =
  RenderOpts
    { indentSize :: Natural
indentSize = Natural
2
    , numberedLevels :: Bool
numberedLevels = Bool
False
    }

-- | Print a 'DiffResult' to the terminal.
printDiffResult :: DiffResult a -> IO ()
printDiffResult :: forall a. DiffResult a -> IO ()
printDiffResult = RenderOpts -> DiffResult a -> IO ()
forall a. RenderOpts -> DiffResult a -> IO ()
printDiffResultWith RenderOpts
defaultRenderOpts

-- | Print a 'DiffResult' to the terminal, using custom 'RenderOpts'.
printDiffResultWith :: RenderOpts -> DiffResult a -> IO ()
printDiffResultWith :: forall a. RenderOpts -> DiffResult a -> IO ()
printDiffResultWith RenderOpts
opts =
  Text -> IO ()
TL.putStrLn (Text -> IO ()) -> (DiffResult a -> Text) -> DiffResult a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText (Builder -> Text)
-> (DiffResult a -> Builder) -> DiffResult a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RenderOpts -> DiffResult a -> Builder
forall a. RenderOpts -> DiffResult a -> Builder
renderDiffResultWith RenderOpts
opts

-- | Render a 'DiffResult' using a lazy 'TB.Builder'.
renderDiffResult :: DiffResult a -> TB.Builder
renderDiffResult :: forall a. DiffResult a -> Builder
renderDiffResult = RenderOpts -> DiffResult a -> Builder
forall a. RenderOpts -> DiffResult a -> Builder
renderDiffResultWith RenderOpts
defaultRenderOpts

-- | Render a 'DiffResult' using a lazy 'TB.Builder', using custom 'RenderOpts'.
renderDiffResultWith :: RenderOpts -> DiffResult a -> TB.Builder
renderDiffResultWith :: forall a. RenderOpts -> DiffResult a -> Builder
renderDiffResultWith RenderOpts
opts = RenderOpts -> Int -> Doc -> Builder
renderDoc RenderOpts
opts Int
0 (Doc -> Builder)
-> (DiffResult a -> Doc) -> DiffResult a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffResult a -> Doc
forall a. DiffResult a -> Doc
diffResultDoc

-- | Render a 'DiffError' using a lazy 'TB.Builder'.
renderDiffError :: DiffError a -> TB.Builder
renderDiffError :: forall a. DiffError a -> Builder
renderDiffError = RenderOpts -> DiffError a -> Builder
forall a. RenderOpts -> DiffError a -> Builder
renderDiffErrorWith RenderOpts
defaultRenderOpts

-- | Render a 'DiffError' using a lazy 'TB.Builder', using custom 'RenderOpts'.
renderDiffErrorWith :: RenderOpts -> DiffError a -> TB.Builder
renderDiffErrorWith :: forall a. RenderOpts -> DiffError a -> Builder
renderDiffErrorWith RenderOpts
opts = RenderOpts -> Int -> Doc -> Builder
renderDoc RenderOpts
opts Int
0 (Doc -> Builder) -> (DiffError a -> Doc) -> DiffError a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffError a -> Doc
forall a. DiffError a -> Doc
diffErrorDoc

-- | Render a 'DiffErrorNested' using a lazy 'TB.Builder'.
renderDiffErrorNested :: DiffErrorNested xss -> TB.Builder
renderDiffErrorNested :: forall (xss :: [[*]]). DiffErrorNested xss -> Builder
renderDiffErrorNested = RenderOpts -> DiffErrorNested xss -> Builder
forall (xss :: [[*]]). RenderOpts -> DiffErrorNested xss -> Builder
renderDiffErrorNestedWith RenderOpts
defaultRenderOpts

-- | Render a 'DiffErrorNested' using a lazy 'TB.Builder', using custom 'RenderOpts'.
renderDiffErrorNestedWith :: RenderOpts -> DiffErrorNested xss -> TB.Builder
renderDiffErrorNestedWith :: forall (xss :: [[*]]). RenderOpts -> DiffErrorNested xss -> Builder
renderDiffErrorNestedWith RenderOpts
opts = RenderOpts -> Int -> Doc -> Builder
renderDoc RenderOpts
opts Int
0 (Doc -> Builder)
-> (DiffErrorNested xss -> Doc) -> DiffErrorNested xss -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffErrorNested xss -> Doc
forall (xss :: [[*]]). DiffErrorNested xss -> Doc
diffErrorNestedDoc

------------------------------------------------------------
-- Doc representation
-- Rendering a 'DiffResult' happens in two steps: converting our strict SOP types into a much simpler
-- intermediate representation, and then laying them out in a nice way.

-- | Create a 'Doc' with a non-empty list of lines and a nested error.
makeDoc :: NonEmpty TB.Builder -> DiffError a -> Doc
makeDoc :: forall a. NonEmpty Builder -> DiffError a -> Doc
makeDoc NonEmpty Builder
ls DiffError a
err = NonEmpty Builder -> Maybe Doc -> Doc
Doc NonEmpty Builder
ls (Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ DiffError a -> Doc
forall a. DiffError a -> Doc
diffErrorDoc DiffError a
err)

-- | Create a simple 'Doc' without a nested error.
linesDoc :: NonEmpty TB.Builder -> Doc
linesDoc :: NonEmpty Builder -> Doc
linesDoc NonEmpty Builder
ls = NonEmpty Builder -> Maybe Doc -> Doc
Doc NonEmpty Builder
ls Maybe Doc
forall a. Maybe a
Nothing

diffResultDoc :: DiffResult a -> Doc
diffResultDoc :: forall a. DiffResult a -> Doc
diffResultDoc = \case
  DiffResult a
Equal -> NonEmpty Builder -> Doc
linesDoc (Builder -> NonEmpty Builder
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Builder
"Equal")
  Error DiffError a
err -> DiffError a -> Doc
forall a. DiffError a -> Doc
diffErrorDoc DiffError a
err

-- | Convert a 'DiffError' to a 'Doc'.
diffErrorDoc :: forall a. DiffError a -> Doc
diffErrorDoc :: forall a. DiffError a -> Doc
diffErrorDoc = \case
  DiffError a
TopLevelNotEqual -> NonEmpty Builder -> Doc
linesDoc (Builder -> NonEmpty Builder
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Builder
"Not equal")
  Nested DiffErrorNested (Code a)
err -> DiffErrorNested (Code a) -> Doc
forall (xss :: [[*]]). DiffErrorNested xss -> Doc
diffErrorNestedDoc DiffErrorNested (Code a)
err
  DiffSpecial SpecialDiffError a
err -> forall a. SpecialDiff a => SpecialDiffError a -> Doc
renderSpecialDiffError @a SpecialDiffError a
err

{- | Convert a 'ListDiffError' to a 'Doc'.

The first argument gives us a name for the type of list, for clearer output.
For example:

@
ghci> 'TL.putStrLn' . 'TB.toLazyText' . 'renderDoc' 'defaultRenderOpts' 0 . 'listDiffErrorDoc' "list" $ 'DiffAtIndex' 3 'TopLevelNotEqual'
Diff at list index 3 (0-indexed)
  Not equal

ghci> TL.putStrLn . TB.toLazyText . renderDoc defaultRenderOpts 0 . listDiffErrorDoc "non-empty list" $ WrongLengths 3 5
non-empty lists are wrong lengths
Length of left list: 3
Length of right list: 5
@
-}
listDiffErrorDoc :: TB.Builder -> ListDiffError a -> Doc
listDiffErrorDoc :: forall a. Builder -> ListDiffError a -> Doc
listDiffErrorDoc Builder
lst = \case
  DiffAtIndex Int
idx DiffError a
err ->
    let lns :: NonEmpty Builder
lns = Builder -> NonEmpty Builder
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> NonEmpty Builder) -> Builder -> NonEmpty Builder
forall a b. (a -> b) -> a -> b
$ Builder
"Diff at " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
lst Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" index " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
forall a. Show a => a -> Builder
showB Int
idx Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" (0-indexed)"
    in  NonEmpty Builder -> DiffError a -> Doc
forall a. NonEmpty Builder -> DiffError a -> Doc
makeDoc NonEmpty Builder
lns DiffError a
err
  WrongLengths Int
l Int
r ->
    NonEmpty Builder -> Doc
linesDoc (NonEmpty Builder -> Doc) -> NonEmpty Builder -> Doc
forall a b. (a -> b) -> a -> b
$
      (Builder
lst Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"s are wrong lengths")
        Builder -> [Builder] -> NonEmpty Builder
forall a. a -> [a] -> NonEmpty a
:| [ Builder
"Length of left list: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
forall a. Show a => a -> Builder
showB Int
l
           , Builder
"Length of right list: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
forall a. Show a => a -> Builder
showB Int
r
           ]

{- | Convert a 'DiffErrorNested' to a 'Doc'.

This is exported in the case that we want to implement an instance of 'Generics.Diff.Diff' for an existing type (e.g.
from a 3rd-party library) that does not have a 'SOP.Generic' instance.
-}
diffErrorNestedDoc :: DiffErrorNested xss -> Doc
diffErrorNestedDoc :: forall (xss :: [[*]]). DiffErrorNested xss -> Doc
diffErrorNestedDoc = \case
  WrongConstructor NS ConstructorInfo xss
l NS ConstructorInfo xss
r ->
    let cName :: NS ConstructorInfo xs -> Builder
cName = NS (K Builder) xs -> Builder
forall {k} a (xs :: [k]). NS (K a) xs -> a
collapse_NS (NS (K Builder) xs -> Builder)
-> (NS ConstructorInfo xs -> NS (K Builder) xs)
-> NS ConstructorInfo xs
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (a :: [*]). ConstructorInfo a -> K Builder a)
-> NS ConstructorInfo xs -> NS (K Builder) xs
forall {k} (f :: k -> *) (g :: k -> *) (xs :: [k]).
(forall (a :: k). f a -> g a) -> NS f xs -> NS g xs
liftANS (Builder -> K Builder a
forall k a (b :: k). a -> K a b
K (Builder -> K Builder a)
-> (ConstructorInfo a -> Builder)
-> ConstructorInfo a
-> K Builder a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstructorInfo a -> Builder
forall (xs :: [*]). ConstructorInfo xs -> Builder
constructorNameR)
        lCons :: Builder
lCons = NS ConstructorInfo xss -> Builder
forall {xs :: [[*]]}. NS ConstructorInfo xs -> Builder
cName NS ConstructorInfo xss
l
        rCons :: Builder
rCons = NS ConstructorInfo xss -> Builder
forall {xs :: [[*]]}. NS ConstructorInfo xs -> Builder
cName NS ConstructorInfo xss
r
    in  NonEmpty Builder -> Doc
linesDoc (NonEmpty Builder -> Doc) -> NonEmpty Builder -> Doc
forall a b. (a -> b) -> a -> b
$
          Builder
"Wrong constructor"
            Builder -> [Builder] -> NonEmpty Builder
forall a. a -> [a] -> NonEmpty a
:| [ Builder
"Constructor of left value: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
lCons
               , Builder
"Constructor of right value: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
rCons
               ]
  FieldMismatch (DiffAtField NS (ConstructorInfo :*: NS DiffError) xss
ns) ->
    let (Builder
cName, RField
fieldLoc, Doc
err) =
          NS (K (Builder, RField, Doc)) xss -> (Builder, RField, Doc)
forall {k} a (xs :: [k]). NS (K a) xs -> a
collapse_NS (NS (K (Builder, RField, Doc)) xss -> (Builder, RField, Doc))
-> NS (K (Builder, RField, Doc)) xss -> (Builder, RField, Doc)
forall a b. (a -> b) -> a -> b
$
            (forall (a :: [*]).
 (:*:) ConstructorInfo (NS DiffError) a
 -> K (Builder, RField, Doc) a)
-> NS (ConstructorInfo :*: NS DiffError) xss
-> NS (K (Builder, RField, Doc)) xss
forall {k} (f :: k -> *) (g :: k -> *) (xs :: [k]).
(forall (a :: k). f a -> g a) -> NS f xs -> NS g xs
liftANS (\(ConstructorInfo a
cInfo :*: NS DiffError a
nsErr) -> (Builder, RField, Doc) -> K (Builder, RField, Doc) a
forall k a (b :: k). a -> K a b
K (ConstructorInfo a -> NS DiffError a -> (Builder, RField, Doc)
forall (xs :: [*]).
ConstructorInfo xs -> NS DiffError xs -> (Builder, RField, Doc)
unpackAtLocErr ConstructorInfo a
cInfo NS DiffError a
nsErr)) NS (ConstructorInfo :*: NS DiffError) xss
ns
        lns :: NonEmpty Builder
lns =
          (Builder
"Both values use constructor " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
cName Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" but fields don't match")
            Builder -> [Builder] -> NonEmpty Builder
forall a. a -> [a] -> NonEmpty a
:| [RField -> Builder
renderRField RField
fieldLoc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
":"]
    in  NonEmpty Builder -> Maybe Doc -> Doc
Doc NonEmpty Builder
lns (Doc -> Maybe Doc
forall a. a -> Maybe a
Just Doc
err)

{- | Render a 'Doc' as a text 'TB.Builder'. This should be the only way we escape a 'Doc'.

The output can be configured using 'RenderOpts'.
-}
renderDoc :: RenderOpts -> Int -> Doc -> TB.Builder
renderDoc :: RenderOpts -> Int -> Doc -> Builder
renderDoc RenderOpts
opts Int
ind = [Builder] -> Builder
unlinesB ([Builder] -> Builder) -> (Doc -> [Builder]) -> Doc -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc -> [Builder]
go Int
ind
  where
    go :: Int -> Doc -> [Builder]
go Int
n Doc {Maybe Doc
NonEmpty Builder
docLines :: NonEmpty Builder
docSubDoc :: Maybe Doc
docLines :: Doc -> NonEmpty Builder
docSubDoc :: Doc -> Maybe Doc
..} =
      let otherIndent :: Builder
otherIndent = RenderOpts -> Bool -> Int -> Builder
mkIndent RenderOpts
opts Bool
False Int
n
          firstIndent :: Builder
firstIndent = RenderOpts -> Bool -> Int -> Builder
mkIndent RenderOpts
opts Bool
True Int
n
          Builder
l :| [Builder]
ls = NonEmpty Builder
docLines
          firstLine :: Builder
firstLine = Builder
firstIndent Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
l
          otherLines :: [Builder]
otherLines = [Builder
otherIndent Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
line | Builder
line <- [Builder]
ls]
          allLines :: [Builder]
allLines = Builder
firstLine Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: [Builder]
otherLines
      in  case Maybe Doc
docSubDoc of
            Maybe Doc
Nothing -> [Builder]
allLines
            Just Doc
err -> [Builder]
allLines [Builder] -> [Builder] -> [Builder]
forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> [Builder]
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Doc
err

type RConstructorName = TB.Builder

type RFieldName = TB.Builder

data InfixSide = ILeft | IRight

data RField
  = IdxField Int
  | InfixField InfixSide
  | RecordField RFieldName

constructorNameR :: ConstructorInfo xs -> RConstructorName
constructorNameR :: forall (xs :: [*]). ConstructorInfo xs -> Builder
constructorNameR = \case
  Constructor ConstructorName
name -> ConstructorName -> Builder
TB.fromString ConstructorName
name
  Infix ConstructorName
name Associativity
_ Int
_ -> Builder
"(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ConstructorName -> Builder
TB.fromString ConstructorName
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
")"
  Record ConstructorName
name NP FieldInfo xs
_ -> ConstructorName -> Builder
TB.fromString ConstructorName
name

unpackAtLocErr :: forall xs. ConstructorInfo xs -> NS DiffError xs -> (RConstructorName, RField, Doc)
unpackAtLocErr :: forall (xs :: [*]).
ConstructorInfo xs -> NS DiffError xs -> (Builder, RField, Doc)
unpackAtLocErr ConstructorInfo xs
cInfo NS DiffError xs
nsErr =
  let err :: Doc
err = NS (K Doc) xs -> Doc
forall {k} a (xs :: [k]). NS (K a) xs -> a
collapse_NS (NS (K Doc) xs -> Doc) -> NS (K Doc) xs -> Doc
forall a b. (a -> b) -> a -> b
$ (forall a. DiffError a -> K Doc a)
-> NS DiffError xs -> NS (K Doc) xs
forall {k} (f :: k -> *) (g :: k -> *) (xs :: [k]).
(forall (a :: k). f a -> g a) -> NS f xs -> NS g xs
liftANS (Doc -> K Doc a
forall k a (b :: k). a -> K a b
K (Doc -> K Doc a) -> (DiffError a -> Doc) -> DiffError a -> K Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffError a -> Doc
forall a. DiffError a -> Doc
diffErrorDoc) NS DiffError xs
nsErr
  in  case ConstructorInfo xs
cInfo of
        Constructor ConstructorName
name -> (ConstructorName -> Builder
TB.fromString ConstructorName
name, Int -> RField
IdxField (Int -> RField) -> Int -> RField
forall a b. (a -> b) -> a -> b
$ NS DiffError xs -> Int
forall {k} (f :: k -> *) (xs :: [k]). NS f xs -> Int
index_NS NS DiffError xs
nsErr, Doc
err)
        Infix ConstructorName
name Associativity
_ Int
_ ->
          let side :: InfixSide
side = case NS DiffError xs
nsErr of
                Z DiffError x
_ -> InfixSide
ILeft
                S NS DiffError xs
_ -> InfixSide
IRight
          in  (Builder
"(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ConstructorName -> Builder
TB.fromString ConstructorName
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
")", InfixSide -> RField
InfixField InfixSide
side, Doc
err)
        Record ConstructorName
name NP FieldInfo xs
fields ->
          let fName :: Builder
fName = NS (K Builder) xs -> Builder
forall {k} a (xs :: [k]). NS (K a) xs -> a
collapse_NS (NS (K Builder) xs -> Builder) -> NS (K Builder) xs -> Builder
forall a b. (a -> b) -> a -> b
$ (forall a. FieldInfo a -> K Builder a)
-> NS FieldInfo xs -> NS (K Builder) xs
forall {k} (f :: k -> *) (g :: k -> *) (xs :: [k]).
(forall (a :: k). f a -> g a) -> NS f xs -> NS g xs
liftANS (Builder -> K Builder a
forall k a (b :: k). a -> K a b
K (Builder -> K Builder a)
-> (FieldInfo a -> Builder) -> FieldInfo a -> K Builder a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstructorName -> Builder
TB.fromString (ConstructorName -> Builder)
-> (FieldInfo a -> ConstructorName) -> FieldInfo a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldInfo a -> ConstructorName
forall a. FieldInfo a -> ConstructorName
fieldName) (NS FieldInfo xs -> NS (K Builder) xs)
-> NS FieldInfo xs -> NS (K Builder) xs
forall a b. (a -> b) -> a -> b
$ NP FieldInfo xs -> NS DiffError xs -> NS FieldInfo xs
forall {k} (f :: k -> *) (xs :: [k]) (g :: k -> *).
NP f xs -> NS g xs -> NS f xs
pickOut NP FieldInfo xs
fields NS DiffError xs
nsErr
          in  (ConstructorName -> Builder
TB.fromString ConstructorName
name, Builder -> RField
RecordField Builder
fName, Doc
err)

renderRField :: RField -> TB.Builder
renderRField :: RField -> Builder
renderRField = \case
  IdxField Int
n -> Builder
"In field " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
forall a. Show a => a -> Builder
showB Int
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" (0-indexed)"
  InfixField InfixSide
side -> case InfixSide
side of
    InfixSide
ILeft -> Builder
"In the left-hand field"
    InfixSide
IRight -> Builder
"In the right-hand field"
  RecordField Builder
fName -> Builder
"In field " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
fName

------------------------------------------------------------
-- Util

unlinesB :: [TB.Builder] -> TB.Builder
unlinesB :: [Builder] -> Builder
unlinesB (Builder
b : [Builder]
bs) = Builder
b Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
TB.singleton Char
'\n' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
unlinesB [Builder]
bs
unlinesB [] = Builder
forall a. Monoid a => a
mempty

-- | 'show' a value as a 'TB.Builder'.
showB :: (Show a) => a -> TB.Builder
showB :: forall a. Show a => a -> Builder
showB = ConstructorName -> Builder
TB.fromString (ConstructorName -> Builder)
-> (a -> ConstructorName) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ConstructorName
forall a. Show a => a -> ConstructorName
show
{-# INLINE showB #-}

liftANS :: forall f g xs. (forall a. f a -> g a) -> NS f xs -> NS g xs
liftANS :: forall {k} (f :: k -> *) (g :: k -> *) (xs :: [k]).
(forall (a :: k). f a -> g a) -> NS f xs -> NS g xs
liftANS forall (a :: k). f a -> g a
f = NS f xs -> NS g xs
forall (ys :: [k]). NS f ys -> NS g ys
go
  where
    go :: forall ys. NS f ys -> NS g ys
    go :: forall (ys :: [k]). NS f ys -> NS g ys
go = \case
      Z f x
z -> g x -> NS g (x : xs)
forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (f x -> g x
forall (a :: k). f a -> g a
f f x
z)
      S NS f xs
s -> NS g xs -> NS g (x : xs)
forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (NS f xs -> NS g xs
forall (ys :: [k]). NS f ys -> NS g ys
go NS f xs
s)

mkIndent :: RenderOpts -> Bool -> Int -> TB.Builder
mkIndent :: RenderOpts -> Bool -> Int -> Builder
mkIndent RenderOpts {Bool
Natural
indentSize :: RenderOpts -> Natural
numberedLevels :: RenderOpts -> Bool
indentSize :: Natural
numberedLevels :: Bool
..} Bool
isFirst Int
ind =
  let spaces :: Builder
spaces = Text -> Builder
TB.fromText (Int -> Text -> Text
T.replicate (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
* Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
indentSize) Text
" ")
      number :: Builder
number = Int -> Builder
forall a. Show a => a -> Builder
showB (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
". "
      noNumber :: Builder
noNumber = Builder
"   "

      withNumber :: Builder
withNumber = Builder
spaces Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
number
      withoutNumber :: Builder
withoutNumber = Builder
spaces Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
noNumber
  in  if Bool
numberedLevels
        then if Bool
isFirst then Builder
withNumber else Builder
withoutNumber
        else Builder
spaces