{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies      #-}

-- | This module contains custom @Format@s for use with the `formatting` library
--
--   @Format@s allow a type-safe version of string formatting. For example we
--   might have:
--
--   > myFormat :: Format r (Text -> Int -> r)
--   > myFormat = "Person's name is " . text . ", age is " . hex
--
--   The type parameter @r@ is the polymorphic return type. `formatting`
--   provides a number of functions to run the format. For example, we could use
--   @sformat :: Format Text a -> a@ to run @myFormat@, which would give:
--
--   > sformat myFormat :: Text -> Int -> Text
--
--   This is now a simple function, which will return a formatted strict @Text@.
--
--   `formatting` also provides a @Buildable a@ type-class for values that can
--   be turned into a @Text@ @Builder@. It provides @build :: a -> Builder@.
--   There is then a formatter @build :: Buildable a => Format r (a -> r)@.
--   So, to get a @Text@ from any @Buildable@ value we can simply call
--   @sformat build value@, and we can compose this @build@ in larger @Format@s.

module Cardano.Prelude.Formatting
  ( base16Builder
  , base16F
  , pairF
  , pairBuilder
  , listJson
  , listJsonIndent
  , mapJson
  )
where

import Cardano.Prelude.Base

import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString.Char8 as BS
import qualified Data.Text.Lazy as LT
import Data.Text.Lazy.Builder (Builder, fromLazyText, fromString)
import Formatting (Format, bprint, later)
import qualified Formatting as F (build)
import Formatting.Buildable (Buildable(build))
import qualified GHC.Exts as Exts


--------------------------------------------------------------------------------
-- Base16
--------------------------------------------------------------------------------

-- | A @Builder@ for a @ByteString@ that performs base 16 encoding
base16Builder :: ByteString -> Builder
base16Builder :: ByteString -> Builder
base16Builder = String -> Builder
fromString (String -> Builder)
-> (ByteString -> String) -> ByteString -> Builder
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> String
BS.unpack (ByteString -> String)
-> (ByteString -> ByteString) -> ByteString -> String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> ByteString
B16.encode

-- | A @Format@ for a @ByteString@ that performs base 16 encoding
base16F :: Format r (ByteString -> r)
base16F :: Format r (ByteString -> r)
base16F = (ByteString -> Builder) -> Format r (ByteString -> r)
forall a r. (a -> Builder) -> Format r (a -> r)
later ByteString -> Builder
base16Builder


--------------------------------------------------------------------------------
-- Containers
--------------------------------------------------------------------------------

-- | A @Builder@ for a pair of @Buildable@ values @(a, b)@
pairBuilder :: (Buildable a, Buildable b) => (a, b) -> Builder
pairBuilder :: (a, b) -> Builder
pairBuilder (a
a, b
b) = Format Builder (a -> b -> Builder) -> a -> b -> Builder
forall a. Format Builder a -> a
bprint (Format (a -> b -> Builder) (a -> b -> Builder)
"(" Format (a -> b -> Builder) (a -> b -> Builder)
-> Format Builder (a -> b -> Builder)
-> Format Builder (a -> b -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (b -> Builder) (a -> b -> Builder)
forall a r. Buildable a => Format r (a -> r)
F.build Format (b -> Builder) (a -> b -> Builder)
-> Format Builder (b -> Builder)
-> Format Builder (a -> b -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (b -> Builder) (b -> Builder)
", " Format (b -> Builder) (b -> Builder)
-> Format Builder (b -> Builder) -> Format Builder (b -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (b -> Builder)
forall a r. Buildable a => Format r (a -> r)
F.build Format Builder (b -> Builder)
-> Format Builder Builder -> Format Builder (b -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder Builder
")") a
a b
b

-- | A @Format@ for a pair of @Buildable@ values @(a, b)@
pairF :: (Buildable a, Buildable b) => Format r ((a, b) -> r)
pairF :: Format r ((a, b) -> r)
pairF = ((a, b) -> Builder) -> Format r ((a, b) -> r)
forall a r. (a -> Builder) -> Format r (a -> r)
later (a, b) -> Builder
forall a b. (Buildable a, Buildable b) => (a, b) -> Builder
pairBuilder

-- | A @Builder@ for @Foldable@ containers of @Buildable@ values that surrounds
--   values using @prefix@ and @suffix@, and splits them using @delimiter@
foldableBuilder
  :: (Foldable t, Buildable a)
  => Builder
  -> Builder
  -> Builder
  -> t a
  -> Builder
foldableBuilder :: Builder -> Builder -> Builder -> t a -> Builder
foldableBuilder Builder
prefix Builder
delimiter Builder
suffix t a
as = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
  [Builder
prefix, [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder]
builders, Builder
suffix]
 where
  builders :: [Builder]
builders = (a -> [Builder] -> [Builder]) -> [Builder] -> t a -> [Builder]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> [Builder] -> [Builder]
appendBuilder [] t a
as
  appendBuilder :: a -> [Builder] -> [Builder]
appendBuilder a
a [] = [a -> Builder
forall p. Buildable p => p -> Builder
build a
a]
  appendBuilder a
a [Builder]
bs = a -> Builder
forall p. Buildable p => p -> Builder
build a
a Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: Builder
delimiter Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: [Builder]
bs

-- | A @Builder@ for @Foldable@ containers that outputs a JSON-style list
--
--   > "[111, ololo, blablabla]"
listBuilderJson :: (Foldable t, Buildable a) => t a -> Builder
listBuilderJson :: t a -> Builder
listBuilderJson = Builder -> Builder -> Builder -> t a -> Builder
forall (t :: * -> *) a.
(Foldable t, Buildable a) =>
Builder -> Builder -> Builder -> t a -> Builder
foldableBuilder Builder
"[" Builder
", " Builder
"]"

-- | A @Format@ for @Foldable@ containers that outputs a JSON-style list
listJson :: (Foldable t, Buildable a) => Format r (t a -> r)
listJson :: Format r (t a -> r)
listJson = (t a -> Builder) -> Format r (t a -> r)
forall a r. (a -> Builder) -> Format r (a -> r)
later t a -> Builder
forall (t :: * -> *) a. (Foldable t, Buildable a) => t a -> Builder
listBuilderJson

-- | A @Builder@ similar to @listBuilderJson@ that prints each value on a new
--   line with @indent@ spaces of indentation
listBuilderJsonIndent :: (Foldable t, Buildable a) => Word -> t a -> Builder
listBuilderJsonIndent :: Word -> t a -> Builder
listBuilderJsonIndent Word
indent t a
as
  | t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
as   = Builder
"[]"
  | Bool
otherwise = Builder -> Builder -> Builder -> t a -> Builder
forall (t :: * -> *) a.
(Foldable t, Buildable a) =>
Builder -> Builder -> Builder -> t a -> Builder
foldableBuilder (Builder
"[\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
spaces) Builder
delimiter Builder
"\n]" t a
as
 where
  spaces :: Builder
spaces    = Text -> Builder
fromLazyText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ Int64 -> Text -> Text
LT.replicate (Word -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
indent) Text
" "
  delimiter :: Builder
delimiter = Builder
",\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
spaces

-- | A @Format@ similar to @listJson@ that prints each value on a new line with
--   @indent@ spaces of indentation
listJsonIndent :: (Foldable t, Buildable a) => Word -> Format r (t a -> r)
listJsonIndent :: Word -> Format r (t a -> r)
listJsonIndent = (t a -> Builder) -> Format r (t a -> r)
forall a r. (a -> Builder) -> Format r (a -> r)
later ((t a -> Builder) -> Format r (t a -> r))
-> (Word -> t a -> Builder) -> Word -> Format r (t a -> r)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word -> t a -> Builder
forall (t :: * -> *) a.
(Foldable t, Buildable a) =>
Word -> t a -> Builder
listBuilderJsonIndent

-- | A @Builder@ for @Exts.IsList@ containers of @Buildable@ key-value pairs
--   that outputs a JSON-style colon-separated map
mapBuilderJson
  :: (Exts.IsList t, Exts.Item t ~ (k, v), Buildable k, Buildable v)
  => t
  -> Builder
mapBuilderJson :: t -> Builder
mapBuilderJson =
  Builder -> Builder -> Builder -> [Builder] -> Builder
forall (t :: * -> *) a.
(Foldable t, Buildable a) =>
Builder -> Builder -> Builder -> t a -> Builder
foldableBuilder Builder
"{" Builder
", " Builder
"}"
    ([Builder] -> Builder) -> (t -> [Builder]) -> t -> Builder
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((k, v) -> Builder) -> [(k, v)] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ((k -> v -> Builder) -> (k, v) -> Builder
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((k -> v -> Builder) -> (k, v) -> Builder)
-> (k -> v -> Builder) -> (k, v) -> Builder
forall a b. (a -> b) -> a -> b
$ Format Builder (k -> v -> Builder) -> k -> v -> Builder
forall a. Format Builder a -> a
bprint (Format (v -> Builder) (k -> v -> Builder)
forall a r. Buildable a => Format r (a -> r)
F.build Format (v -> Builder) (k -> v -> Builder)
-> Format Builder (v -> Builder)
-> Format Builder (k -> v -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (v -> Builder) (v -> Builder)
": " Format (v -> Builder) (v -> Builder)
-> Format Builder (v -> Builder) -> Format Builder (v -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (v -> Builder)
forall a r. Buildable a => Format r (a -> r)
F.build))
    ([(k, v)] -> [Builder]) -> (t -> [(k, v)]) -> t -> [Builder]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. t -> [(k, v)]
forall l. IsList l => l -> [Item l]
Exts.toList

-- | A @Format@ for @Exts.IsList@ containers of @Buildable@ key-value pairs that
--   outputs a JSON-style colon-separated map
mapJson
  :: (Exts.IsList t, Exts.Item t ~ (k, v), Buildable k, Buildable v)
  => Format r (t -> r)
mapJson :: Format r (t -> r)
mapJson = (t -> Builder) -> Format r (t -> r)
forall a r. (a -> Builder) -> Format r (a -> r)
later t -> Builder
forall t k v.
(IsList t, Item t ~ (k, v), Buildable k, Buildable v) =>
t -> Builder
mapBuilderJson