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

{-# LANGUAGE NoImplicitPrelude #-}

-- | Partially implements the interface provided by the @fmt@ package on top of
-- @prettyprinter@.
module Fmt.Buildable
  ( Buildable(..)
  , FromDoc(..)
  , FromSimpleDoc(..)
  , ReflowingDoc
    -- * Helpers
  , pretty
  , prettyText
    -- * Brackets
  , (+|)
  , (|+)
  , (|++)
  , (|++^)
  , (++|)
    -- * Formatters
  , unlinesF
  , unwordsF
  , nameF
  , indentF
  , blockMapF
  , blockMapF'
  , blockListF
  , blockListF'
  , mapF
  , mapF'
  , listF
  , listF'
  , whenF
  , unlessF
  , enumerateF
  , enumerateF'
  , whenNE
  , fillSepF
  , fillSepF'
  , reflowF
  , singleLineF
  , punctuateF
  , punctuateF'
  , quoteF
  , quoteF'
  , quoteOrIndentF
  , flatAltF
  , TupleF(..)
    -- ** hexF
  , FormatAsHex(..)
  , Hex(..)
    -- * Generics
  , GenericBuildable(..)
  , GBuildable(..)
  , GetFields(..)
  ) where

import Universum

import Data.ByteString.Builder qualified as BB
import Data.Foldable qualified as F
import Data.Text qualified as TS
import Data.Text.Lazy.Builder qualified as TLB
import Data.Text.Lazy.Builder.Int (hexadecimal)
import Data.Text.Lazy.Encoding qualified as TLE
import GHC.Exts (IsList, Item)
import GHC.Exts qualified as Exts
import GHC.Generics qualified as G
import Language.Haskell.TH (newName, reifyInstances)
import Language.Haskell.TH qualified as TH
import Language.Haskell.TH.Lib (appT, conT, listE, tupP, tupleT, varE, varP, varT)
import Prettyprinter qualified as WL hiding ((<+>))
import Prettyprinter.Internal qualified as WL (unsafeTextWithoutNewlines)
import Prettyprinter.Render.Text qualified as WL
import Prettyprinter.Util qualified as WL

import Fmt.Operators qualified as WL
import Fmt.Utils (Doc, isEmpty, renderOneLine)

{- $setup
>>> import Prelude hiding (show)
>>> import Debug (show)
>>> import Fmt
-}

----------------------------------------------------------------------------
-- FromDoc
----------------------------------------------------------------------------

{- | Helper intermediary class to define 'FromDoc'. The primary motivation for
its existence is being able to override the default layout engine.

>>> :{
layoutNarrow =
  Prettyprinter.layoutPretty Prettyprinter.LayoutOptions
    {Prettyprinter.layoutPageWidth = Prettyprinter.AvailablePerLine 20 1}
:}

>>> doc = reflowF "Lorem ipsum dolor sit amet, consectetur adipiscing elit."
>>> fmt doc
Lorem ipsum dolor sit amet, consectetur adipiscing elit.
>>> fmtSimple $ layoutNarrow doc
Lorem ipsum dolor
sit amet,
consectetur
adipiscing elit.
-}
class FromSimpleDoc a where
  fmtSimple :: WL.SimpleDocStream ann -> a

instance FromSimpleDoc TLB.Builder where
  fmtSimple :: forall ann. SimpleDocStream ann -> Builder
fmtSimple = LText -> Builder
TLB.fromLazyText (LText -> Builder)
-> (SimpleDocStream ann -> LText) -> SimpleDocStream ann -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleDocStream ann -> LText
forall ann. SimpleDocStream ann -> LText
WL.renderLazy

instance FromSimpleDoc BB.Builder where
  fmtSimple :: forall ann. SimpleDocStream ann -> Builder
fmtSimple = ByteString -> Builder
BB.lazyByteString (ByteString -> Builder)
-> (SimpleDocStream ann -> ByteString)
-> SimpleDocStream ann
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleDocStream ann -> ByteString
forall a ann. FromSimpleDoc a => SimpleDocStream ann -> a
fmtSimple

instance FromSimpleDoc LText where
  fmtSimple :: forall ann. SimpleDocStream ann -> LText
fmtSimple = SimpleDocStream ann -> LText
forall ann. SimpleDocStream ann -> LText
WL.renderLazy

instance FromSimpleDoc Text where
  fmtSimple :: forall ann. SimpleDocStream ann -> Text
fmtSimple = SimpleDocStream ann -> Text
forall ann. SimpleDocStream ann -> Text
WL.renderStrict

instance FromSimpleDoc String where
  fmtSimple :: forall ann. SimpleDocStream ann -> String
fmtSimple = forall a. ToString a => a -> String
toString @Text (Text -> String)
-> (SimpleDocStream ann -> Text) -> SimpleDocStream ann -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleDocStream ann -> Text
forall a ann. FromSimpleDoc a => SimpleDocStream ann -> a
fmtSimple

instance FromSimpleDoc LByteString where
  fmtSimple :: forall ann. SimpleDocStream ann -> ByteString
fmtSimple = LText -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 (LText -> ByteString)
-> (SimpleDocStream ann -> LText)
-> SimpleDocStream ann
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. FromSimpleDoc a => SimpleDocStream ann -> a
fmtSimple @LText

instance FromSimpleDoc ByteString where
  fmtSimple :: forall ann. SimpleDocStream ann -> ByteString
fmtSimple = LText -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 (LText -> ByteString)
-> (SimpleDocStream ann -> LText)
-> SimpleDocStream ann
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. FromSimpleDoc a => SimpleDocStream ann -> a
fmtSimple @LText

instance a ~ () => FromSimpleDoc (IO a) where
  fmtSimple :: forall ann. SimpleDocStream ann -> IO a
fmtSimple = Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putText (Text -> IO ())
-> (SimpleDocStream ann -> Text) -> SimpleDocStream ann -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleDocStream ann -> Text
forall a ann. FromSimpleDoc a => SimpleDocStream ann -> a
fmtSimple

-- | A class of things that can be produced from 'Doc' using the default layout
-- engine. Mostly various text types.
class FromDoc a where
  {- | Render a 'Doc' to another format.

  >>> doc = "foo" :: Doc
  >>> fmt doc :: Text
  "foo"
  >>> fmt doc :: LText
  "foo"
  >>> fmt doc :: String
  "foo"
  >>> fmt doc :: ByteString
  "foo"
  >>> fmt doc :: LByteString
  "foo"
  >>> fmt doc :: IO ()
  foo
  >>> fmt doc :: Data.Text.Lazy.Builder.Builder
  "foo"
  >>> Data.ByteString.Builder.toLazyByteString (fmt doc :: Data.ByteString.Builder.Builder)
  "foo"
  -}
  fmt :: Doc -> a

instance FromDoc Doc where
  fmt :: Doc -> Doc
fmt Doc
a = Doc
a

-- | Default layout engine. Uses 80 columns with ribbon width 1.
layout :: Doc -> WL.SimpleDocStream ()
layout :: Doc -> SimpleDocStream ()
layout = LayoutOptions -> Doc -> SimpleDocStream ()
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
WL.layoutSmart LayoutOptions :: PageWidth -> LayoutOptions
WL.LayoutOptions {layoutPageWidth :: PageWidth
WL.layoutPageWidth = Int -> Double -> PageWidth
WL.AvailablePerLine Int
80 Double
1}

do
  -- this isn't pretty, but it avoids an overlapping instance for FromDoc Doc
  varty <- varT =<< newName "a"
  reifyInstances ''FromSimpleDoc [varty] >>= mapM \case
    (TH.InstanceD _ con (TH.AppT _ ty) _) -> do
      inst <- appT (conT ''FromDoc) (pure ty)
      TH.InstanceD Nothing con inst <$> [d|$(varP 'fmt) = fmtSimple . layout|]
    _ -> error "impossible"

----------------------------------------------------------------------------
-- Buildable
----------------------------------------------------------------------------

-- | A thing that can be prettyprinted in human-readable (but not necessarily
-- machine-readable) format
class Buildable a where
  -- | Make a document with human-readable representation
  build :: a -> Doc
  default build :: (Generic a, GBuildable (G.Rep a)) => a -> Doc
  build = GenericBuildable a -> Doc
forall a. Buildable a => a -> Doc
build (GenericBuildable a -> Doc)
-> (a -> GenericBuildable a) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> GenericBuildable a
forall a. a -> GenericBuildable a
GenericBuildable

  -- | Used to avoid overlapping instances with 'String', cf. 'Prelude.showList'.
  buildList :: [a] -> Doc
  buildList = Doc -> Doc
forall ann. Doc ann -> Doc ann
WL.align (Doc -> Doc) -> ([a] -> Doc) -> [a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
forall ann. [Doc ann] -> Doc ann
WL.list ([Doc] -> Doc) -> ([a] -> [Doc]) -> [a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc) -> [a] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map a -> Doc
forall a. Buildable a => a -> Doc
build

-- | Newtype wrapper for @DerivingVia@, that uses the corresponding instance of
-- 'WL.Pretty' to derive 'Buildable'
newtype ViaPretty a = ViaPretty {forall a. ViaPretty a -> a
unViaPretty :: a}

instance WL.Pretty a => Buildable (ViaPretty a) where
  build :: ViaPretty a -> Doc
build = a -> Doc
forall a ann. Pretty a => a -> Doc ann
WL.pretty (a -> Doc) -> (ViaPretty a -> a) -> ViaPretty a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ViaPretty a -> a
forall a. ViaPretty a -> a
unViaPretty
  buildList :: [ViaPretty a] -> Doc
buildList = [a] -> Doc
forall a ann. Pretty a => [a] -> Doc ann
WL.prettyList ([a] -> Doc) -> ([ViaPretty a] -> [a]) -> [ViaPretty a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ViaPretty a -> a) -> [ViaPretty a] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ViaPretty a -> a
forall a. ViaPretty a -> a
unViaPretty

instance Buildable Doc where
  build :: Doc -> Doc
build Doc
x = Doc
x

-- NB: see below for more instances (because TH staging)

{- | Differs from the corresponding 'WL.Pretty' instance in one important
aspect. It converts newlines to hard lines. Thus,

>>> str = "Hello,\nWorld!" :: String
>>> Prettyprinter.group @() $ Prettyprinter.pretty str
Hello, World!
>>> Prettyprinter.group $ build str
Hello,
World!
-}
instance Buildable Char where
  build :: Char -> Doc
build Char
'\n' = Doc
forall ann. Doc ann
WL.hardline
  build Char
c = Char -> Doc
forall a ann. Pretty a => a -> Doc ann
WL.pretty Char
c
  buildList :: String -> Doc
buildList = Text -> Doc
forall a. Buildable a => a -> Doc
build (Text -> Doc) -> (String -> Text) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. ToText a => a -> Text
toText

{- | Differs from the corresponding 'WL.Pretty' instance in one important
aspect. It converts newlines to hard lines.

>>> txt = "Hello,\nWorld!" :: Text
>>> Prettyprinter.group @() $ Prettyprinter.pretty txt
Hello, World!
>>> Prettyprinter.group $ build txt
Hello,
World!
-}
instance Buildable Text where
  build :: Text -> Doc
build = [Doc] -> Doc
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Doc
unlinesF ([Doc] -> Doc) -> (Text -> [Doc]) -> Text -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Doc) -> [Text] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (forall ann. Text -> Doc ann
WL.unsafeTextWithoutNewlines @()) ([Text] -> [Doc]) -> (Text -> [Text]) -> Text -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
TS.splitOn Text
"\n"

{- | Differs from the corresponding 'WL.Pretty' instance in one important
aspect. It converts newlines to hard lines.

>>> txt = "Hello,\nWorld!" :: LText
>>> Prettyprinter.group @() $ Prettyprinter.pretty txt
Hello, World!
>>> Prettyprinter.group $ build txt
Hello,
World!
-}
instance Buildable LText where
  build :: LText -> Doc
build = Text -> Doc
forall a. Buildable a => a -> Doc
build (Text -> Doc) -> (LText -> Text) -> LText -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LText -> Text
toStrict

instance Buildable TLB.Builder where
  build :: Builder -> Doc
build = LText -> Doc
forall a. Buildable a => a -> Doc
build (LText -> Doc) -> (Builder -> LText) -> Builder -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> LText
TLB.toLazyText

instance Buildable a => Buildable [a] where build :: [a] -> Doc
build = [a] -> Doc
forall a. Buildable a => [a] -> Doc
buildList
instance Buildable a => Buildable (NonEmpty a) where build :: NonEmpty a -> Doc
build = [a] -> Doc
forall a. Buildable a => [a] -> Doc
buildList ([a] -> Doc) -> (NonEmpty a -> [a]) -> NonEmpty a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> [a]
forall t. Container t => t -> [Element t]
toList

{- | One important quirk of this instance is it skips over 'Nothing' values
entirely:

>>> build $ [Just 1, Nothing, Just 3]
[1, 3]
-}
instance Buildable a => Buildable (Maybe a) where
  build :: Maybe a -> Doc
build = Doc -> (a -> Doc) -> Maybe a -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
forall a. Monoid a => a
mempty a -> Doc
forall a. Buildable a => a -> Doc
build
  buildList :: [Maybe a] -> Doc
buildList = [a] -> Doc
forall a. Buildable a => [a] -> Doc
buildList ([a] -> Doc) -> ([Maybe a] -> [a]) -> [Maybe a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe a] -> [a]
forall a. [Maybe a] -> [a]
catMaybes
instance Buildable a => Buildable (Identity a) where
  build :: Identity a -> Doc
build = a -> Doc
forall a. Buildable a => a -> Doc
build (a -> Doc) -> (Identity a -> a) -> Identity a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity a -> a
forall a. Identity a -> a
runIdentity
instance Buildable a => Buildable (Const a b) where
  build :: Const a b -> Doc
build = a -> Doc
forall a. Buildable a => a -> Doc
build (a -> Doc) -> (Const a b -> a) -> Const a b -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const a b -> a
forall {k} a (b :: k). Const a b -> a
getConst

{- |

>>> pretty (Left "foo" :: Either String Int)
<Left: foo>
>>> pretty (Right 123 :: Either String Int)
<Right: 123>
-}
instance (Buildable a, Buildable b) => Buildable (Either a b) where
  build :: Either a b -> Doc
build (Left a
a) = Doc
"<Left: " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> a -> Doc
forall a. Buildable a => a -> Doc
build a
a Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
">"
  build (Right b
b) = Doc
"<Right: " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> b -> Doc
forall a. Buildable a => a -> Doc
build b
b Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
">"

{- |

>>> pretty (fromList [("foo", "bar"), ("baz", "quux")] :: Map Text Text)
{baz: quux, foo: bar}
-}
instance (Buildable k, Buildable v) => Buildable (Map k v) where
  build :: Map k v -> Doc
build = [(k, v)] -> Doc
forall k v f.
(Buildable k, Buildable v, IsList f, Item f ~ (k, v)) =>
f -> Doc
mapF ([(k, v)] -> Doc) -> (Map k v -> [(k, v)]) -> Map k v -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k v -> [(k, v)]
forall t. ToPairs t => t -> [(Key t, Val t)]
toPairs

{- |

>>> pretty (fromList ["foo", "bar", "baz", "quux"] :: Set Text)
[bar, baz, foo, quux]
-}
instance Buildable v => Buildable (Set v) where
  build :: Set v -> Doc
build = Set v -> Doc
forall a (f :: * -> *). (Buildable a, Foldable f) => f a -> Doc
listF

----------------------------------------------------------------------------
-- Helpers
----------------------------------------------------------------------------

-- | 'build' then 'fmt'. Convenience synonym for @fmt . build@.
pretty :: (Buildable a, FromDoc b) => a -> b
pretty :: forall a b. (Buildable a, FromDoc b) => a -> b
pretty = Doc -> b
forall a. FromDoc a => Doc -> a
fmt (Doc -> b) -> (a -> Doc) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc
forall a. Buildable a => a -> Doc
build

-- | A less polymorphic version of 'pretty' for convenience.
prettyText :: Buildable a => a -> Text
prettyText :: forall a. Buildable a => a -> Text
prettyText = a -> Text
forall a b. (Buildable a, FromDoc b) => a -> b
pretty

-- | When the second argument is empty, return 'mempty', otherwise, return the
-- first argument.
whenNE :: Monoid a => a -> Doc -> a
{-# SPECIALIZE whenNE :: Doc -> Doc -> Doc #-}
whenNE :: forall a. Monoid a => a -> Doc -> a
whenNE a
z Doc
y
  | Doc -> Bool
isEmpty Doc
y = a
forall a. Monoid a => a
mempty
  | Bool
otherwise = a
z

----------------------------------------------------------------------------
-- Brackets
----------------------------------------------------------------------------

infixr 1 +|, |+

{- | Left format bracket. Enclose the value to format in these for concise syntax:

>>> :{
data WorldType = Cruel | Wonderful
  deriving (Generic, Buildable)
:}

>>> sayHello worldType = "Hello, " +| worldType |+ " world!"
>>> sayHello Cruel
Hello, Cruel world!
>>> sayHello Wonderful
Hello, Wonderful world!
-}
(+|) :: FromDoc b => Doc -> Doc -> b
Doc
d1 +| :: forall b. FromDoc b => Doc -> Doc -> b
+| Doc
d2 = Doc -> b
forall a. FromDoc a => Doc -> a
fmt (Doc -> b) -> Doc -> b
forall a b. (a -> b) -> a -> b
$ Doc
d1 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
d2

-- | Right format bracket
(|+) :: (Buildable a, FromDoc b) => a -> Doc -> b
a
a |+ :: forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
d = Doc -> b
forall a. FromDoc a => Doc -> a
fmt (a -> Doc
forall a. Buildable a => a -> Doc
build a
a Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
d)

infixr 1 ++|, |++, |++^

-- | Opaque type for reflowing brackets @++|@ @|++@.
newtype ReflowingDoc = ReflowingDoc (Text -> Doc)

{- | Bracket versions of 'enumerateF'. Note that unlike with @|+@, both brackets
are required.

>>> let splice = "lorem posuere dapibus in ut lorem." :: Doc
>>> let long_splice = splice <> " " <> splice
>>> :{
"Lorem ipsum dolor sit amet, consectetur adipiscing elit." ++| splice
  |++ "Morbi aliquet accumsan libero." ++| long_splice
  |++ "Consectetur adipiscing elit."
:}
Lorem ipsum dolor sit amet, consectetur adipiscing elit.
lorem posuere dapibus in ut lorem. Morbi aliquet accumsan libero.
lorem posuere dapibus in ut lorem. lorem posuere dapibus in ut lorem.
Consectetur adipiscing elit.

>>> let splice = build "lorem\nposuere\ndapibus"
>>> :{
"Lorem ipsum dolor sit amet, consectetur adipiscing elit." ++| splice |++
  "Morbi aliquet accumsan libero."
:}
Lorem ipsum dolor sit amet, consectetur adipiscing elit.
lorem
posuere
dapibus
Morbi aliquet accumsan libero.
-}
(|++) :: Buildable a => a -> Doc -> ReflowingDoc
a
x |++ :: forall a. Buildable a => a -> Doc -> ReflowingDoc
|++ Doc
trail = (Text -> Doc) -> ReflowingDoc
ReflowingDoc ((Text -> Doc) -> ReflowingDoc) -> (Text -> Doc) -> ReflowingDoc
forall a b. (a -> b) -> a -> b
$ (Doc -> Doc) -> Doc -> a -> Text -> Doc
forall a. Buildable a => (Doc -> Doc) -> Doc -> a -> Text -> Doc
reflowDoc' Doc -> Doc
forall ann. Doc ann -> Doc ann
WL.group Doc
trail a
x

{- | A version of the reflowing bracket that always breaks after a splice if
there's a break before the splice.

Compare with the similar example for @|++@, notice the line break after
@splice@. It may be combined with 'quoteOrIndentF'.

>>> let splice = "lorem posuere dapibus in ut lorem." :: Doc
>>> let long_splice = splice <> " " <> splice
>>> :{
"Lorem ipsum dolor sit amet, consectetur adipiscing elit." ++| splice
  |++^ "Morbi aliquet accumsan libero." ++| long_splice
  |++^ "Consectetur adipiscing elit."
:}
Lorem ipsum dolor sit amet, consectetur adipiscing elit.
lorem posuere dapibus in ut lorem.
Morbi aliquet accumsan libero.
lorem posuere dapibus in ut lorem. lorem posuere dapibus in ut lorem.
Consectetur adipiscing elit.
-}
(|++^) :: Buildable a => a -> Doc -> ReflowingDoc
a
x |++^ :: forall a. Buildable a => a -> Doc -> ReflowingDoc
|++^ Doc
trail = (Text -> Doc) -> ReflowingDoc
ReflowingDoc ((Text -> Doc) -> ReflowingDoc) -> (Text -> Doc) -> ReflowingDoc
forall a b. (a -> b) -> a -> b
$ (Doc -> Doc) -> Doc -> a -> Text -> Doc
forall a. Buildable a => (Doc -> Doc) -> Doc -> a -> Text -> Doc
reflowDoc' Doc -> Doc
forall a. a -> a
id Doc
trail a
x

reflowDoc' :: Buildable a => (Doc -> Doc) -> Doc -> a -> Text -> Doc
reflowDoc' :: forall a. Buildable a => (Doc -> Doc) -> Doc -> a -> Text -> Doc
reflowDoc' Doc -> Doc
tailGroup Doc
trail a
x (Text -> Doc
forall ann. Text -> Doc ann
WL.reflow -> Doc
lead) =
  Doc
lead
  Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
forall ann. Doc ann -> Doc ann
WL.group (Doc -> Doc -> Doc
forall a. Monoid a => a -> Doc -> a
whenNE Doc
forall ann. Doc ann
WL.line Doc
lead
    Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
tailGroup (Doc -> Doc
forall ann. Doc ann -> Doc ann
WL.align (a -> Doc
forall a. Buildable a => a -> Doc
build a
x) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc -> Doc
forall a. Monoid a => a -> Doc -> a
whenNE Doc
forall ann. Doc ann
WL.line Doc
trail))
  Doc -> Doc -> Doc
WL.<//> Doc
trail

-- | Left formatting bracket.
(++|) :: FromDoc b => Text -> ReflowingDoc -> b
Text
lead ++| :: forall b. FromDoc b => Text -> ReflowingDoc -> b
++| (ReflowingDoc Text -> Doc
f) = Doc -> b
forall a. FromDoc a => Doc -> a
fmt (Doc -> b) -> Doc -> b
forall a b. (a -> b) -> a -> b
$ Text -> Doc
f Text
lead

----------------------------------------------------------------------------
-- Formatters
----------------------------------------------------------------------------

{-| Join a 'Foldable' with hardlines.

>>> Prettyprinter.group $ unlinesF ["foo", "bar", "baz"]
foo
bar
baz
-}
unlinesF :: (Foldable f, Buildable a) => f a -> Doc
unlinesF :: forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Doc
unlinesF = (Doc -> Doc -> Doc) -> [Doc] -> Doc
forall (t :: * -> *) ann.
Foldable t =>
(Doc ann -> Doc ann -> Doc ann) -> t (Doc ann) -> Doc ann
WL.concatWith (Doc -> Doc -> Doc -> Doc
forall ann. Doc ann -> Doc ann -> Doc ann -> Doc ann
WL.surround Doc
forall ann. Doc ann
WL.hardline) ([Doc] -> Doc) -> (f a -> [Doc]) -> f a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc) -> [a] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map a -> Doc
forall a. Buildable a => a -> Doc
build ([a] -> [Doc]) -> (f a -> [a]) -> f a -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList

{-| Join a 'Foldable' with spaces.

>>> unwordsF ["foo", "bar", "baz"]
foo bar baz
-}
unwordsF :: (Buildable a, Foldable f) => f a -> Doc
unwordsF :: forall a (f :: * -> *). (Buildable a, Foldable f) => f a -> Doc
unwordsF = [Doc] -> Doc
forall ann. [Doc ann] -> Doc ann
WL.fillSep ([Doc] -> Doc) -> (f a -> [Doc]) -> f a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc) -> [a] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map a -> Doc
forall a. Buildable a => a -> Doc
build ([a] -> [Doc]) -> (f a -> [a]) -> f a -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList


{- | If @name@ and @content@ fit into the page width and @content@ doesn't
contain hard line breaks, layout as single line with @: @ between. Otherwise,
make a multiline layout, appending @:@ to @name@, and nesting @content@ by 2
spaces.

>>> nameF "Test" "foo"
Test: foo
>>> nameF "Test" $ fillSepF $ replicate 27 "foo"
Test:
  foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo
  foo foo foo foo foo foo foo foo

If either name or content is empty, returns only the other one.

>>> nameF "" "foo"
foo
>>> nameF "Test" ""
Test
-}
nameF :: Buildable a => Doc -> a -> Doc
nameF :: forall a. Buildable a => Doc -> a -> Doc
nameF Doc
name (a -> Doc
forall a. Buildable a => a -> Doc
build -> Doc
content)
  | Doc -> Bool
isEmpty Doc
name = Doc
content
  | Doc -> Bool
isEmpty Doc
content = Doc
name
  | Bool
otherwise = Doc -> Doc
forall ann. Doc ann -> Doc ann
WL.group (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> Doc -> Doc
forall ann. Int -> Doc ann -> Doc ann
WL.nest Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
name Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
":" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
      Doc -> Doc -> Doc
forall ann. Doc ann -> Doc ann -> Doc ann
WL.flatAlt (Doc
forall ann. Doc ann
WL.hardline Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
content) (Doc
forall ann. Doc ann
WL.space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
content)

{-| Indent 'Doc' by a given number of spaces.

>>> indentF 4 "foo"
    foo
>>> indentF 4 "foo\nbar"
    foo
    bar
-}
indentF :: Int -> Doc -> Doc
indentF :: Int -> Doc -> Doc
indentF = Int -> Doc -> Doc
forall ann. Int -> Doc ann -> Doc ann
WL.indent

{-| Print a map-like thing in the style of a YAML map.

>>> blockMapF $ [("foo", "bar"), ("baz", "quux")]
foo: bar
baz: quux
>>> blockMapF ([] :: [(Text, Text)])
{}
-}
blockMapF :: (Buildable k, Buildable v, IsList f, Item f ~ (k, v)) => f -> Doc
blockMapF :: forall k v f.
(Buildable k, Buildable v, IsList f, Item f ~ (k, v)) =>
f -> Doc
blockMapF = (k -> Doc) -> (v -> Doc) -> f -> Doc
forall f k v.
(IsList f, Item f ~ (k, v)) =>
(k -> Doc) -> (v -> Doc) -> f -> Doc
blockMapF' k -> Doc
forall a. Buildable a => a -> Doc
build v -> Doc
forall a. Buildable a => a -> Doc
build

{- | Version of 'blockMapF' that allows explicitly passing functions to format
key and value.

>>> blockMapF' hexF build $ [(123, "foo"), (456, "bar")]
7b: foo
1c8: bar
-}
blockMapF' :: (IsList f, Item f ~ (k, v)) => (k -> Doc) -> (v -> Doc) -> f -> Doc
blockMapF' :: forall f k v.
(IsList f, Item f ~ (k, v)) =>
(k -> Doc) -> (v -> Doc) -> f -> Doc
blockMapF' k -> Doc
fbuild_k v -> Doc
fbuild_v f
xs
  | [Doc] -> Bool
forall t. Container t => t -> Bool
null [Doc]
items = Doc
"{}"
  | Bool
otherwise = [Doc] -> Doc
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Doc
unlinesF [Doc]
items
  where
    items :: [Doc]
items = (Doc -> Doc -> Doc) -> (Doc, Doc) -> Doc
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Doc -> Doc -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF ((Doc, Doc) -> Doc) -> ((k, v) -> (Doc, Doc)) -> (k, v) -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> Doc) -> (v -> Doc) -> (k, v) -> (Doc, Doc)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap k -> Doc
fbuild_k v -> Doc
fbuild_v ((k, v) -> Doc) -> [(k, v)] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f -> [Item f]
forall l. IsList l => l -> [Item l]
Exts.toList f
xs

{- | Render a list-like thing, YAML style.

>>> blockListF ["foo", "bar", "baz"]
- foo
- bar
- baz
>>> blockListF ([] :: [Text])
[]
-}
blockListF :: (Buildable a, Foldable f) => f a -> Doc
blockListF :: forall a (f :: * -> *). (Buildable a, Foldable f) => f a -> Doc
blockListF = Doc -> (a -> Doc) -> f a -> Doc
forall (f :: * -> *) a.
Foldable f =>
Doc -> (a -> Doc) -> f a -> Doc
blockListF' Doc
"-" a -> Doc
forall a. Buildable a => a -> Doc
build

{- | Version of 'blockListF' that allows explicitly passing a bullet style and
formatter for items

>>> blockListF' "*" hexF [1,11,21]
* 1
* b
* 15
-}
blockListF' :: (Foldable f) => Doc -> (a -> Doc) -> f a -> Doc
blockListF' :: forall (f :: * -> *) a.
Foldable f =>
Doc -> (a -> Doc) -> f a -> Doc
blockListF' Doc
bullet a -> Doc
fa f a
xs
  | f a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
F.null f a
xs = Doc
"[]"
  | Bool
otherwise = [Doc] -> Doc
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Doc
unlinesF ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (a -> Doc) -> [a] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Doc -> Doc
buildItem (Doc -> Doc) -> (a -> Doc) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc
fa) ([a] -> [Doc]) -> [a] -> [Doc]
forall a b. (a -> b) -> a -> b
$ f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList f a
xs
  where
    buildItem :: Doc -> Doc
buildItem Doc
x
      | Doc -> Bool
isEmpty Doc
x = Doc
bullet
      | Bool
otherwise = Doc
bullet Doc -> Doc -> Doc
WL.<+> Doc -> Doc
forall ann. Doc ann -> Doc ann
WL.align Doc
x

{-| Format a map-like thing, JSON-style.

>>> mapF [("foo", "bar"), ("baz", "quux")]
{foo: bar, baz: quux}
>>> mapF ([] :: [(Text, Text)])
{}
>>> mapF $ replicate 9 ("foo", "bar")
{ foo: bar
, foo: bar
...
, foo: bar }
>>> mapF $ [("foo", "bar\nquux"), ("baz", "corge")]
{ foo:
    bar
    quux
, baz: corge }
-}
mapF :: (Buildable k, Buildable v, IsList f, Item f ~ (k, v)) => f -> Doc
mapF :: forall k v f.
(Buildable k, Buildable v, IsList f, Item f ~ (k, v)) =>
f -> Doc
mapF = (k -> Doc) -> (v -> Doc) -> f -> Doc
forall f k v.
(IsList f, Item f ~ (k, v)) =>
(k -> Doc) -> (v -> Doc) -> f -> Doc
mapF' k -> Doc
forall a. Buildable a => a -> Doc
build v -> Doc
forall a. Buildable a => a -> Doc
build

{-| Version of 'mapF' allowing for custom formatters.

>>> mapF' hexF build [(128, "foo"), (512, "bar")]
{80: foo, 200: bar}
-}
mapF' :: (IsList f, Item f ~ (k, v)) => (k -> Doc) -> (v -> Doc) -> f -> Doc
mapF' :: forall f k v.
(IsList f, Item f ~ (k, v)) =>
(k -> Doc) -> (v -> Doc) -> f -> Doc
mapF' k -> Doc
fk v -> Doc
fv
  = Doc -> Doc
forall ann. Doc ann -> Doc ann
WL.group
  (Doc -> Doc) -> (f -> Doc) -> f -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc -> Doc -> [Doc] -> Doc
forall ann. Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
WL.encloseSep Doc
forall ann. Doc ann
lbrace Doc
forall ann. Doc ann
rbrace Doc
", "
  ([Doc] -> Doc) -> (f -> [Doc]) -> f -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, v) -> Doc) -> [(k, v)] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Doc -> Doc
forall ann. Doc ann -> Doc ann
WL.align (Doc -> Doc) -> ((k, v) -> Doc) -> (k, v) -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc -> Doc -> Doc) -> (Doc, Doc) -> Doc
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Doc -> Doc -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF ((Doc, Doc) -> Doc) -> ((k, v) -> (Doc, Doc)) -> (k, v) -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> Doc) -> (v -> Doc) -> (k, v) -> (Doc, Doc)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap k -> Doc
fk v -> Doc
fv)
  ([(k, v)] -> [Doc]) -> (f -> [(k, v)]) -> f -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f -> [(k, v)]
forall l. IsList l => l -> [Item l]
Exts.toList
  where
    lbrace :: Doc ann
lbrace = Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
WL.flatAlt Doc ann
"{ " Doc ann
"{"
    rbrace :: Doc ann
rbrace = Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
WL.flatAlt Doc ann
" }" Doc ann
"}"

{-| Print a list, JSON-style.

>>> listF [1..3]
[1, 2, 3]
>>> listF [1..100]
[ 1
, 2
...
, 100 ]
>>> listF ["foo", "bar\nbaz"]
[ foo
, bar
  baz ]
-}
listF :: (Buildable a, Foldable f) => f a -> Doc
listF :: forall a (f :: * -> *). (Buildable a, Foldable f) => f a -> Doc
listF = (a -> Doc) -> f a -> Doc
forall (f :: * -> *) a. Foldable f => (a -> Doc) -> f a -> Doc
listF' a -> Doc
forall a. Buildable a => a -> Doc
build

{-| Version of 'listF' that allows explicitly specifying a formatter for items.

>>> listF' hexF [1,11,21]
[1, b, 15]
-}
listF' :: Foldable f => (a -> Doc) -> f a -> Doc
listF' :: forall (f :: * -> *) a. Foldable f => (a -> Doc) -> f a -> Doc
listF' a -> Doc
f = [Doc] -> Doc
forall ann. [Doc ann] -> Doc ann
WL.list ([Doc] -> Doc) -> (f a -> [Doc]) -> f a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc) -> [a] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Doc -> Doc
forall ann. Doc ann -> Doc ann
WL.align (Doc -> Doc) -> (a -> Doc) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc
f) ([a] -> [Doc]) -> (f a -> [a]) -> f a -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList

{-| Conditionally print something.

>>> whenF True "foo"
foo
>>> show $ whenF False "foo"
""
-}
whenF :: Bool -> Doc -> Doc
whenF :: Bool -> Doc -> Doc
whenF Bool
True Doc
x = Doc
x
whenF Bool
False Doc
_ = Doc
forall a. Monoid a => a
mempty

{-| Boolean inverse of 'whenF'

>>> unlessF False "foo"
foo
>>> show $ unlessF True "foo"
""
-}
unlessF :: Bool -> Doc -> Doc
unlessF :: Bool -> Doc -> Doc
unlessF = Bool -> Doc -> Doc
whenF (Bool -> Doc -> Doc) -> (Bool -> Bool) -> Bool -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not

{-| Class for formatting tuples

>>> tupleF ("foo", "bar", "baz")
(foo, bar, baz)
>>> tupleF ("foo","bar\nbaz")
( foo
, bar
  baz )
>>> :{
tupleF
  ( "foo", "foo", "foo", "foo", "foo"
  , "foo", "foo", "foo", "foo", "foo"
  , "foo", "foo", "foo", "foo", "foo"
  , "foo", "foo", "foo", "foo", "foo"
  )
:}
( foo
, foo
...
, foo )
-}
class TupleF a where
  tupleF :: a -> Doc

-- NB: see below for a bunch of TH-derived instances for tuples

instance Buildable a => TupleF [a] where
  tupleF :: [a] -> Doc
tupleF = [Doc] -> Doc
forall ann. [Doc ann] -> Doc ann
WL.tupled ([Doc] -> Doc) -> ([a] -> [Doc]) -> [a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc) -> [a] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Doc -> Doc
forall ann. Doc ann -> Doc ann
WL.align (Doc -> Doc) -> (a -> Doc) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc
forall a. Buildable a => a -> Doc
build)

class FormatAsHex a where
  {- | Format a number or bytestring as hex:

  >>> pretty $ hexF 3635
  e33
  >>> pretty $ hexF (-3635)
  -e33
  >>> pretty $ hexF ("\0\50\63\80" :: ByteString)
  00323f50
  >>> pretty $ hexF ("\0\50\63\80" :: LByteString)
  00323f50
  -}
  hexF :: a -> Doc

instance FormatAsHex ByteString where
  hexF :: ByteString -> Doc
hexF = LText -> Doc
forall a. Buildable a => a -> Doc
build (LText -> Doc) -> (ByteString -> LText) -> ByteString -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> LText
TLE.decodeLatin1 (ByteString -> LText)
-> (ByteString -> ByteString) -> ByteString -> LText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString)
-> (ByteString -> Builder) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
BB.byteStringHex

instance FormatAsHex LByteString where
  hexF :: ByteString -> Doc
hexF = LText -> Doc
forall a. Buildable a => a -> Doc
build (LText -> Doc) -> (ByteString -> LText) -> ByteString -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> LText
TLE.decodeLatin1 (ByteString -> LText)
-> (ByteString -> ByteString) -> ByteString -> LText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString)
-> (ByteString -> Builder) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
BB.lazyByteStringHex

{- | Wrap an integral type with this if there's no 'FormatAsHex' instance for it
yet, or use it with @DerivingVia@.

>>> hexF $ Hex 128
80
-}
newtype Hex a = Hex a
instance Integral a => FormatAsHex (Hex a) where
  hexF :: Hex a -> Doc
hexF (Hex a
i) = Doc
sgn Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Builder -> Doc
forall a. Buildable a => a -> Doc
build (a -> Builder
forall a. Integral a => a -> Builder
hexadecimal (a -> Builder) -> a -> Builder
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. Num a => a -> a
abs a
i)
    where
      sgn :: Doc
sgn = if a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 then Doc
"-" else Doc
forall a. Monoid a => a
mempty

-- NB: see below for more TH-derived instances

{- | Enumerate pairs of text and 'Doc', reflowing the content to best-fit line
width. This will line-wrap text on whitespace. If 'Doc' is rendered single-line,
this will try to fit it inline. Otherwise, it's surrounded by newlines.

>>> :{
long_text = "Lorem ipsum dolor sit amet, consectetur adipiscing elit. \
  \ Donec eget diam ac lorem posuere dapibus in ut lorem. Morbi \
  \ aliquet accumsan libero, a tempor nunc egestas ac."
:}

>>> enumerateF [(long_text, mempty)]
Lorem ipsum dolor sit amet, consectetur adipiscing elit. Donec eget diam ac
lorem posuere dapibus in ut lorem. Morbi aliquet accumsan libero, a tempor nunc
egestas ac.

>>> let splice = "SPLICE SPLICE SPLICE" :: Doc
>>> :{
enumerateF
  [ (long_text, splice)
  , (long_text, mempty)
  ]
:}
Lorem ipsum dolor sit amet, consectetur adipiscing elit. Donec eget diam ac
lorem posuere dapibus in ut lorem. Morbi aliquet accumsan libero, a tempor nunc
egestas ac. SPLICE SPLICE SPLICE Lorem ipsum dolor sit amet, consectetur
adipiscing elit. Donec eget diam ac lorem posuere dapibus in ut lorem. Morbi
aliquet accumsan libero, a tempor nunc egestas ac.

>>> let splice = build "SPLICE\nSPLICE\nSPLICE"
>>> :{
enumerateF
  [ (long_text, splice)
  , ("Short text", mempty)
  ]
:}
Lorem ipsum dolor sit amet, consectetur adipiscing elit. Donec eget diam ac
lorem posuere dapibus in ut lorem. Morbi aliquet accumsan libero, a tempor nunc
egestas ac.
SPLICE
SPLICE
SPLICE
Short text

-}
enumerateF :: [(Text, Doc)] -> Doc
enumerateF :: [(Text, Doc)] -> Doc
enumerateF = Doc -> [(Text, Doc)] -> Doc
enumerateF' Doc
forall a. Monoid a => a
mempty

{- | Version of 'enumerateF' that allows specifying separator between items.

>>> enumerateF' "," [("Foo", build 1), ("bar", build 2), ("baz", build 3)]
Foo 1, bar 2, baz 3
-}
enumerateF' :: Doc -> [(Text, Doc)] -> Doc
enumerateF' :: Doc -> [(Text, Doc)] -> Doc
enumerateF' Doc
sep = (Element [(Text, Doc)] -> Doc -> Doc)
-> Doc -> [(Text, Doc)] -> Doc
forall t b. Container t => (Element t -> b -> b) -> b -> t -> b
foldr (Text, Doc) -> Doc -> Doc
Element [(Text, Doc)] -> Doc -> Doc
merge Doc
forall a. Monoid a => a
mempty
  where
    merge :: (Text, Doc) -> Doc -> Doc
merge (Text
lead, Doc
x) Doc
trail = Text
lead Text -> ReflowingDoc -> Doc
forall b. FromDoc b => Text -> ReflowingDoc -> b
++| (Doc
x Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc -> Doc
forall a. Monoid a => a -> Doc -> a
whenNE Doc
sep Doc
trail) Doc -> Doc -> ReflowingDoc
forall a. Buildable a => a -> Doc -> ReflowingDoc
|++ Doc
trail

{- | Surround a 'Buildable' with quotes (or anything else really).

@quoteF' l r x@ is equivalent to @l <> build x <> r@, but it may be more
convenient in some cases.

>>> quoteF' "\"" "\"" "Foo"
"Foo"
-}
quoteF' :: Buildable a => Doc -> Doc -> a -> Doc
quoteF' :: forall a. Buildable a => Doc -> Doc -> a -> Doc
quoteF' Doc
l Doc
r = Doc -> Doc -> Doc -> Doc
forall ann. Doc ann -> Doc ann -> Doc ann -> Doc ann
WL.enclose Doc
l Doc
r (Doc -> Doc) -> (a -> Doc) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc
forall a. Buildable a => a -> Doc
build

{- | Surround a 'Buildable' with the same 'Doc' on both sides.

>>> quoteF "\"" "Foo"
"Foo"
-}
quoteF :: Buildable a => Doc -> a -> Doc
quoteF :: forall a. Buildable a => Doc -> a -> Doc
quoteF Doc
q = Doc -> Doc -> a -> Doc
forall a. Buildable a => Doc -> Doc -> a -> Doc
quoteF' Doc
q Doc
q

{- | If buildable fits into the line, wrap it in single quotes. Otherwise,
indent it by 2 spaces. This is convenient with 'enumerateF' or reflowing
brackets to format a splice that can be long and multiline or short and
singleline with about equal probability.

This is a particularly useful specialization of 'flatAltF'.

>>> let splice = "lorem posuere dapibus" :: Doc
>>> let long_splice = unwordsF $ replicate 3 splice
>>> let very_long_splice = unwordsF $ replicate 4 splice

>>> "Foobar" ++| quoteOrIndentF splice |++ "bazbar."
Foobar 'lorem posuere dapibus' bazbar.

>>> "Foobarbazquux" ++| quoteOrIndentF long_splice |++ "bazbar."
Foobarbazquux
'lorem posuere dapibus lorem posuere dapibus lorem posuere dapibus' bazbar.

>>> "Foobarbazquux" ++| quoteOrIndentF long_splice |++^ "bazbar."
Foobarbazquux
  lorem posuere dapibus lorem posuere dapibus lorem posuere dapibus
bazbar.

>>> "Foobar" ++| quoteOrIndentF very_long_splice |++ "bazbar."
Foobar
  lorem posuere dapibus lorem posuere dapibus lorem posuere dapibus
  lorem posuere dapibus
bazbar.

>>> "Foobar" ++| quoteOrIndentF very_long_splice |++^ "bazbar."
Foobar
  lorem posuere dapibus lorem posuere dapibus lorem posuere dapibus
  lorem posuere dapibus
bazbar.
-}
quoteOrIndentF :: Buildable a => a -> Doc
quoteOrIndentF :: forall a. Buildable a => a -> Doc
quoteOrIndentF = (a -> Doc) -> (a -> Doc) -> a -> Doc
forall a. (a -> Doc) -> (a -> Doc) -> a -> Doc
flatAltF (Int -> Doc -> Doc
indentF Int
2 (Doc -> Doc) -> (a -> Doc) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc
forall a. Buildable a => a -> Doc
build) (Doc -> Doc -> Doc
forall a. Buildable a => Doc -> a -> Doc
quoteF Doc
"'" (Doc -> Doc) -> (a -> Doc) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc
forall a. Buildable a => a -> Doc
build)

{- | Use different formatters depending on whether the pretty-printed
representation fits on the current line or not. The exact meaning of "fits" is
determined by the surrounding context. In precise terms, whether multiline or
single-line format is chosen is determined by whether the enclosing @group@ is
broken or not, respectively. Useful with reflowing brackets, 'nameF', etc to
specify alternate format for short and/or single-line and long and/or multiline
text.

>>> let short = "bar baz" :: Text
>>> let long = unwordsF $ replicate 10 short

>>> nameF "Foo" $ flatAltF (quoteF "\"") (quoteF "'") short
Foo: 'bar baz'

>>> nameF "Foo" $ flatAltF (quoteF "\"") (quoteF "'") long
Foo:
  "bar baz bar baz bar baz bar baz bar baz bar baz bar baz bar baz bar baz
  bar baz"
-}
flatAltF
  :: (a -> Doc) -- ^ Multiline formatter
  -> (a -> Doc) -- ^ Single-line formatter
  -> (a -> Doc)
flatAltF :: forall a. (a -> Doc) -> (a -> Doc) -> a -> Doc
flatAltF a -> Doc
nonFlat a -> Doc
flat a
res = Doc -> Doc -> Doc
forall ann. Doc ann -> Doc ann -> Doc ann
WL.flatAlt (a -> Doc
nonFlat a
res) (a -> Doc
flat a
res)

-- | Like 'WL.fillSep', but skips over empty elements.
fillSepF :: (Foldable t, Buildable a) => t a -> Doc
fillSepF :: forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Doc
fillSepF = (a -> Doc -> Doc) -> Doc -> t a -> Doc
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr (\a
x Doc
acc -> a -> Doc
forall a. Buildable a => a -> Doc
build a
x Doc -> Doc -> Doc
WL.</> Doc
acc) Doc
forall a. Monoid a => a
mempty

-- | Version of 'fillSepF' with punctuation.
fillSepF' :: (Foldable t, Buildable a) => Doc -> t a -> Doc
fillSepF' :: forall (t :: * -> *) a.
(Foldable t, Buildable a) =>
Doc -> t a -> Doc
fillSepF' Doc
sep = [Doc] -> Doc
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Doc
fillSepF ([Doc] -> Doc) -> (t a -> [Doc]) -> t a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
WL.punctuate Doc
sep ([Doc] -> [Doc]) -> (t a -> [Doc]) -> t a -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc) -> [a] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map a -> Doc
forall a. Buildable a => a -> Doc
build ([a] -> [Doc]) -> (t a -> [a]) -> t a -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList

-- | Reflow text, line-wrapping on white-space. Any leading and trailing
-- whitespace is stripped.
reflowF :: Text -> Doc
reflowF :: Text -> Doc
reflowF = Text -> Doc
forall ann. Text -> Doc ann
WL.reflow

{- | Punctuate a foldable with a distinct separator for the last two elements.
Useful for enumerations. Does the oxford comma by concatenating first and second
arguments. Note that when using a word, a leading space is expected on the pair
separator.

>>> fillSepF $ punctuateF "," " and" ([] :: [Doc])
<BLANKLINE>
>>> fillSepF $ punctuateF "," " and" ["foo"]
foo
>>> fillSepF $ punctuateF "," " and" ["bar", "baz"]
bar and baz
>>> fillSepF $ punctuateF "," " and" ["foo", "bar", "baz"]
foo, bar, and baz
-}
punctuateF
  :: (Foldable t, Buildable a)
  => Doc -- ^ Default separator, usually comma
  -> Doc -- ^ Pair separator, usually @" and"@ or @" or"@
  -> t a -- ^ Foldable to punctuate
  -> [Doc]
punctuateF :: forall (t :: * -> *) a.
(Foldable t, Buildable a) =>
Doc -> Doc -> t a -> [Doc]
punctuateF Doc
sep Doc
sep2 = Doc -> Doc -> Doc -> t a -> [Doc]
forall (t :: * -> *) a.
(Foldable t, Buildable a) =>
Doc -> Doc -> Doc -> t a -> [Doc]
punctuateF' Doc
sep Doc
sep2 (Doc
sep Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
sep2)

{- | Version of 'punctuateF' with explicit distinct separators for penultimate
element and just two elements.

>>> fillSepF $ punctuateF' "," " and" ", and" ([] :: [Doc])
<BLANKLINE>
>>> fillSepF $ punctuateF' "," " and" ", and" ["foo"]
foo
>>> fillSepF $ punctuateF' "," " and" ", and" ["bar", "baz"]
bar and baz
>>> fillSepF $ punctuateF' "," " and" ", and" ["foo", "bar", "baz"]
foo, bar, and baz
-}
punctuateF'
  :: (Foldable t, Buildable a)
  => Doc -- ^ Default separator
  -> Doc -- ^ Pair separator
  -> Doc -- ^ Penultimate element separator
  -> t a
  -> [Doc]
punctuateF' :: forall (t :: * -> *) a.
(Foldable t, Buildable a) =>
Doc -> Doc -> Doc -> t a -> [Doc]
punctuateF' Doc
sep Doc
sep2 Doc
sepOxford = Bool -> [a] -> [Doc]
go Bool
False ([a] -> [Doc]) -> (t a -> [a]) -> t a -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList
  where
    go :: Bool -> [a] -> [Doc]
go Bool
oxfordComma = \case
      [] -> []
      [a
x] -> [a -> Doc
forall a. Buildable a => a -> Doc
build a
x]
      [a
x, a
y] -> [a -> Doc
forall a. Buildable a => a -> Doc
build a
x Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> if Bool
oxfordComma then Doc
sepOxford else Doc
sep2, a -> Doc
forall a. Buildable a => a -> Doc
build a
y]
      (a
x:[a]
xs) -> a -> Doc
forall a. Buildable a => a -> Doc
build a
x Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
sep Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Bool -> [a] -> [Doc]
go Bool
True [a]
xs

{- | Force the 'Doc' to be rendered on a single line, regardless of anything,
including hard line breaks. Will lead to horrible terrible formatting if
overused. In all likelihood, this is not the function you're looking for.

Note that hard line breaks will be removed entirely, not replaced with spaces.

>>> singleLineF ("foo\nbar\nbaz" :: Text)
foobarbaz
-}
singleLineF :: Buildable a => a -> Doc
singleLineF :: forall a. Buildable a => a -> Doc
singleLineF = Text -> Doc
forall ann. Text -> Doc ann
WL.unsafeTextWithoutNewlines (Text -> Doc) -> (a -> Text) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleDocStream () -> Text
forall a ann. FromSimpleDoc a => SimpleDocStream ann -> a
fmtSimple (SimpleDocStream () -> Text)
-> (a -> SimpleDocStream ()) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> SimpleDocStream ()
renderOneLine (Doc -> SimpleDocStream ())
-> (a -> Doc) -> a -> SimpleDocStream ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc
forall a. Buildable a => a -> Doc
build

----------------------------------------------------------------------------
-- Generic stuff
----------------------------------------------------------------------------

{- | Newtype for use with @DerivingVia@, e.g.

>>> :{
data Foo = Bar | Baz
  deriving (Generic, Buildable)
:}

>>> build Bar
Bar

Handles infix constructors properly:

>>> data Inf = Text :-> Text deriving (Generic, Buildable)
>>> build $ "foo" :-> "bar"
foo :-> bar
>>> data Inf2 = Text `Con` Text deriving (Generic, Buildable)
>>> build $ Con "foo" "bar"
foo `Con` bar

>>> :{
data LargeTy = LargeTy
  Text Text Text Text Text
  Text Text Text Text Text
  Text Text Text Text Text
  Text Text Text Text Text
  deriving (Generic, Buildable)
:}

>>> :{
build $ LargeTy
  "foo" "foo" "foo" "foo" "foo"
  "foo" "foo" "foo" "foo" "foo"
  "foo" "foo" "foo" "foo" "foo"
  "foo" "foo" "foo" "foo" "foo"
:}
LargeTy;
  foo,  foo,  foo,  foo,  foo,  foo,  foo,  foo,  foo,  foo,  foo,  foo,  foo,
  foo,  foo,  foo,  foo,  foo,  foo,  foo


There is a special case for tuples:

>>> :{
newtype Tup = Tup (Int, Int, Text)
  deriving stock Generic
  deriving anyclass Buildable
:}

>>> build $ Tup (1, 2, "many")
Tup; (1, 2, many)
>>> build $ Tup (1, 2, "many\nlines")
Tup;
  ( 1
  , 2
  , many
    lines )

Renders records as maps

>>> :{
data Rec = Rec
  { foo :: Text
  , bar :: Text
  , baz :: Text
  } deriving (Generic, Buildable)
:}

>>> build $ Rec "quux" "waldo" "corge"
Rec:
  foo: quux
  bar: waldo
  baz: corge
-}
newtype GenericBuildable a = GenericBuildable a

instance (GBuildable (G.Rep a), Generic a) => Buildable (GenericBuildable a) where
  build :: GenericBuildable a -> Doc
build (GenericBuildable a
a) = Rep a Any -> Doc
forall {k} (f :: k -> *) (a :: k). GBuildable f => f a -> Doc
gbuild (Rep a Any -> Doc) -> Rep a Any -> Doc
forall a b. (a -> b) -> a -> b
$ a -> Rep a Any
forall a x. Generic a => a -> Rep a x
G.from a
a

class GBuildable f where
  gbuild :: f a -> Doc

instance Buildable c => GBuildable (G.Rec0 c) where
  gbuild :: forall (a :: k). Rec0 c a -> Doc
gbuild (G.K1 c
a) = c -> Doc
forall a. Buildable a => a -> Doc
build c
a

instance (GBuildable a, GBuildable b) => GBuildable (a G.:+: b) where
  gbuild :: forall (a :: k). (:+:) a b a -> Doc
gbuild (G.L1 a a
x) = a a -> Doc
forall {k} (f :: k -> *) (a :: k). GBuildable f => f a -> Doc
gbuild a a
x
  gbuild (G.R1 b a
x) = b a -> Doc
forall {k} (f :: k -> *) (a :: k). GBuildable f => f a -> Doc
gbuild b a
x

instance GBuildable a => GBuildable (G.D1 d a) where
  gbuild :: forall (a :: k). D1 d a a -> Doc
gbuild (G.M1 a a
x) = a a -> Doc
forall {k} (f :: k -> *) (a :: k). GBuildable f => f a -> Doc
gbuild a a
x

instance (GetFields a, G.Constructor c) => GBuildable (G.C1 c a) where
  -- A note on fixity:
  --   * Ordinarily e.g. "Foo" is prefix and e.g. ":|" is infix
  --   * However, "Foo" can be infix when defined as "a `Foo` b"
  --   * And ":|" can be prefix when defined as "(:|) a b"
  gbuild :: forall (a :: k). C1 c a a -> Doc
gbuild c :: C1 c a a
c@(G.M1 a a
x)
    | G.Infix{} <- C1 c a a -> Fixity
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> Fixity
G.conFixity C1 c a a
c
    -- There will always be two fields in this case.
    , [Doc
a, Doc
b] <- [Doc]
fields = Doc
a Doc -> Doc -> Doc
WL.<+> Doc
infixName Doc -> Doc -> Doc
WL.<+> Doc
b
    | Bool
isTuple = [Doc] -> Doc
forall ann. [Doc ann] -> Doc ann
WL.tupled [Doc]
fields
    | C1 c a a -> Bool
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> Bool
G.conIsRecord C1 c a a
c = Doc -> Doc -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF Doc
prefixName (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [(String, Doc)] -> Doc
forall k v f.
(Buildable k, Buildable v, IsList f, Item f ~ (k, v)) =>
f -> Doc
blockMapF [(String, Doc)]
fieldsWithNames
    | [Doc] -> Bool
forall t. Container t => t -> Bool
null [Doc]
fields = Doc
prefixName
    | Bool
otherwise = Int -> Doc -> Doc
forall ann. Int -> Doc ann -> Doc ann
WL.nest Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc
forall ann. Doc ann -> Doc ann
WL.group (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc -> Doc -> Doc
forall ann. Doc ann -> Doc ann -> Doc ann -> Doc ann
WL.surround (Doc
";" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
forall ann. Doc ann
WL.line) Doc
prefixName (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
        [Doc] -> Doc
forall ann. [Doc ann] -> Doc ann
WL.fillSep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
WL.punctuate Doc
", " [Doc]
fields
    where
      fieldsWithNames :: [(String, Doc)]
fieldsWithNames = a a -> [(String, Doc)]
forall {k} (f :: k -> *) (a :: k).
GetFields f =>
f a -> [(String, Doc)]
getFields a a
x
      fields :: [Doc]
fields = (String, Doc) -> Doc
forall a b. (a, b) -> b
snd ((String, Doc) -> Doc) -> [(String, Doc)] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, Doc)]
fieldsWithNames
      (Doc
prefixName, Doc
infixName)
        | Char
':':String
_ <- C1 c a a -> String
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
G.conName C1 c a a
c = (Doc -> Doc -> Doc -> Doc
forall ann. Doc ann -> Doc ann -> Doc ann -> Doc ann
WL.enclose Doc
"(" Doc
")" Doc
cn, Doc
cn)
        | Bool
otherwise = (Doc
cn, Doc -> Doc -> Doc -> Doc
forall ann. Doc ann -> Doc ann -> Doc ann -> Doc ann
WL.enclose Doc
"`" Doc
"`" Doc
cn)
        where cn :: Doc
cn = String -> Doc
forall a. Buildable a => a -> Doc
build (C1 c a a -> String
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
G.conName C1 c a a
c)
      isTuple :: Bool
isTuple
        | Char
'(':Char
',':String
_ <- C1 c a a -> String
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
G.conName C1 c a a
c = Bool
True
        | Bool
otherwise = Bool
False

-- | Helper class for 'GBuildable'.
class GetFields f where
  -- | Get fields, together with their names if available
  getFields :: f a -> [(String, Doc)]

instance (GetFields a, GetFields b) => GetFields (a G.:*: b) where
  getFields :: forall (a :: k). (:*:) a b a -> [(String, Doc)]
getFields (a a
a G.:*: b a
b) = a a -> [(String, Doc)]
forall {k} (f :: k -> *) (a :: k).
GetFields f =>
f a -> [(String, Doc)]
getFields a a
a [(String, Doc)] -> [(String, Doc)] -> [(String, Doc)]
forall a. Semigroup a => a -> a -> a
<> b a -> [(String, Doc)]
forall {k} (f :: k -> *) (a :: k).
GetFields f =>
f a -> [(String, Doc)]
getFields b a
b

instance (GBuildable a, G.Selector c) => GetFields (G.S1 c a) where
  getFields :: forall (a :: k). S1 c a a -> [(String, Doc)]
getFields s :: S1 c a a
s@(G.M1 a a
a) = [(S1 c a a -> String
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
G.selName S1 c a a
s, Doc -> Doc
forall ann. Doc ann -> Doc ann
WL.align (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ a a -> Doc
forall {k} (f :: k -> *) (a :: k). GBuildable f => f a -> Doc
gbuild a a
a)]

instance GetFields G.U1 where
  getFields :: forall (a :: k). U1 a -> [(String, Doc)]
getFields U1 a
_ = []

----------------------------------------------------------------------------
-- TH-derived instances and those that depend on it
----------------------------------------------------------------------------

concatMapM
  (\(conT -> ty) -> [d|deriving via ViaPretty $ty instance Buildable $ty|])
  [ ''Int, ''Int8, ''Int16, ''Int32, ''Int64, ''Integer
  , ''Word, ''Word8, ''Word16, ''Word32, ''Word64, ''Natural
  , ''(), ''Void
  , ''Bool, ''Double, ''Float
  ]

concatMapM
  (\(conT -> ty) -> [d|deriving via Hex $ty instance FormatAsHex $ty|])
  [ ''Int, ''Int8, ''Int16, ''Int32, ''Int64, ''Integer
  , ''Word, ''Word8, ''Word16, ''Word32, ''Word64, ''Natural
  ]

concatForM [2..30] \n -> do
  names <- replicateM n $ newName "a"
  let constr = tupT $ tys <&> \ty -> [t|Buildable $ty|]
      tup = tupT tys
      tupT = foldl' appT (tupleT n)
      tys = varT <$> names
      pat = tupP $ varP <$> names
      list = listE $ names <&> \name -> [|WL.align $ build $(varE name)|]
  [d|
    instance $constr => TupleF $tup where
      tupleF $pat = WL.tupled $list
    instance $constr => Buildable $tup where
      build = tupleF
    |]

instance Buildable a => Buildable (Ratio a) where
  {-# SPECIALIZE instance Buildable (Ratio Integer) #-}
  build :: Ratio a -> Doc
build Ratio a
a = a -> Doc
forall a. Buildable a => a -> Doc
build (Ratio a -> a
forall a. Ratio a -> a
numerator Ratio a
a) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"/" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> a -> Doc
forall a. Buildable a => a -> Doc
build (Ratio a -> a
forall a. Ratio a -> a
denominator Ratio a
a)

{- |

>>> pretty (fromList [(100, "bar"), (500, "quux")] :: IntMap Text)
{100: bar, 500: quux}
-}
instance Buildable v => Buildable (IntMap v) where
  build :: IntMap v -> Doc
build = IntMap v -> Doc
forall k v f.
(Buildable k, Buildable v, IsList f, Item f ~ (k, v)) =>
f -> Doc
mapF

{- |

>>> pretty (fromList [100, 500] :: IntSet)
[100, 500]
-}
instance Buildable IntSet where
  build :: IntSet -> Doc
build = [Int] -> Doc
forall a (f :: * -> *). (Buildable a, Foldable f) => f a -> Doc
listF ([Int] -> Doc) -> (IntSet -> [Int]) -> IntSet -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [Int]
forall t. Container t => t -> [Element t]
toList