{-# LANGUAGE NoImplicitPrelude #-}
module Fmt.Buildable
( Buildable(..)
, FromDoc(..)
, FromSimpleDoc(..)
, ReflowingDoc
, pretty
, prettyText
, (+|)
, (|+)
, (|++)
, (|++^)
, (++|)
, 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(..)
, FormatAsHex(..)
, Hex(..)
, 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)
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
class FromDoc a where
fmt :: Doc -> a
instance FromDoc Doc where
fmt :: Doc -> Doc
fmt Doc
a = Doc
a
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
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"
class Buildable a where
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
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 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
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
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"
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
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
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
">"
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
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
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
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
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
infixr 1 +|, |+
(+|) :: 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
(|+) :: (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 ++|, |++, |++^
newtype ReflowingDoc = ReflowingDoc (Text -> Doc)
(|++) :: 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
(|++^) :: 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
(++|) :: 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
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
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
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)
indentF :: Int -> Doc -> Doc
indentF :: Int -> Doc -> Doc
indentF = Int -> Doc -> Doc
forall ann. Int -> Doc ann -> Doc ann
WL.indent
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
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
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
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
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
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
"}"
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
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
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
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 TupleF a where
tupleF :: a -> Doc
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
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
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
enumerateF :: [(Text, Doc)] -> Doc
enumerateF :: [(Text, Doc)] -> Doc
enumerateF = Doc -> [(Text, Doc)] -> Doc
enumerateF' Doc
forall a. Monoid a => a
mempty
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
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
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
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)
flatAltF
:: (a -> Doc)
-> (a -> Doc)
-> (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)
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
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
reflowF :: Text -> Doc
reflowF :: Text -> Doc
reflowF = Text -> Doc
forall ann. Text -> Doc ann
WL.reflow
punctuateF
:: (Foldable t, Buildable a)
=> Doc
-> Doc
-> t a
-> [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)
punctuateF'
:: (Foldable t, Buildable a)
=> Doc
-> Doc
-> Doc
-> 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
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
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
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
, [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
class GetFields f where
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
_ = []
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
]