{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Fmt.Internal.Formatters where
import Data.List (intersperse)
import Lens.Micro
#if __GLASGOW_HASKELL__ < 804
import Data.Monoid ((<>))
#endif
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Data.Text (Text)
import Formatting.Buildable
import qualified Formatting.Internal.Raw as F
import Data.Text.Lazy.Builder hiding (fromString)
import Data.Foldable (toList)
import GHC.Exts (IsList, Item)
import qualified GHC.Exts as IsList (toList)
import Fmt.Internal.Core
indentF :: Int -> Builder -> Builder
indentF :: Int -> Builder -> Builder
indentF Int
n Builder
a = case Text -> [Text]
TL.lines (Builder -> Text
toLazyText Builder
a) of
[] -> Text -> Builder
fromLazyText (Text
spaces forall a. Semigroup a => a -> a -> a
<> Text
"\n")
[Text]
xs -> Text -> Builder
fromLazyText forall a b. (a -> b) -> a -> b
$ [Text] -> Text
TL.unlines (forall a b. (a -> b) -> [a] -> [b]
map (Text
spaces forall a. Semigroup a => a -> a -> a
<>) [Text]
xs)
where
spaces :: Text
spaces = Int64 -> Text -> Text
TL.replicate (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) (Char -> Text
TL.singleton Char
' ')
indentF' :: Int -> T.Text -> Builder -> Builder
indentF' :: Int -> Text -> Builder -> Builder
indentF' Int
n Text
pref Builder
a = case Text -> [Text]
TL.lines (Builder -> Text
toLazyText Builder
a) of
[] -> Text -> Builder
fromText Text
pref forall a. Semigroup a => a -> a -> a
<> Builder
"\n"
(Text
x:[Text]
xs) -> Text -> Builder
fromLazyText forall a b. (a -> b) -> a -> b
$
[Text] -> Text
TL.unlines forall a b. (a -> b) -> a -> b
$ (Text -> Text
TL.fromStrict Text
pref forall a. Semigroup a => a -> a -> a
<> Text
x) forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (Text
spaces forall a. Semigroup a => a -> a -> a
<>) [Text]
xs
where
spaces :: Text
spaces = Int64 -> Text -> Text
TL.replicate (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) (Char -> Text
TL.singleton Char
' ')
nameF :: Builder -> Builder -> Builder
nameF :: Builder -> Builder -> Builder
nameF Builder
k Builder
v = case Text -> [Text]
TL.lines (Builder -> Text
toLazyText Builder
v) of
[] -> Builder
k forall a. Semigroup a => a -> a -> a
<> Builder
":\n"
[Text
l] -> Builder
k forall a. Semigroup a => a -> a -> a
<> Builder
": " forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromLazyText Text
l forall a. Semigroup a => a -> a -> a
<> Builder
"\n"
[Text]
ls -> Builder
k forall a. Semigroup a => a -> a -> a
<> Builder
":\n" forall a. Semigroup a => a -> a -> a
<>
forall a. Monoid a => [a] -> a
mconcat [Builder
" " forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromLazyText Text
s forall a. Semigroup a => a -> a -> a
<> Builder
"\n" | Text
s <- [Text]
ls]
unwordsF :: (Foldable f, Buildable a) => f a -> Builder
unwordsF :: forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
unwordsF = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse Builder
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall p. Buildable p => p -> Builder
build forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
{-# SPECIALIZE unwordsF :: Buildable a => [a] -> Builder #-}
unlinesF :: (Foldable f, Buildable a) => f a -> Builder
unlinesF :: forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
unlinesF = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Builder -> Builder
nl forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p. Buildable p => p -> Builder
build) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
where
nl :: Builder -> Builder
nl Builder
x | Text
"\n" Text -> Text -> Bool
`TL.isSuffixOf` Builder -> Text
toLazyText Builder
x = Builder
x
| Bool
otherwise = Builder
x forall a. Semigroup a => a -> a -> a
<> Builder
"\n"
{-# SPECIALIZE unlinesF :: Buildable a => [a] -> Builder #-}
listF :: (Foldable f, Buildable a) => f a -> Builder
listF :: forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
listF = forall (f :: * -> *) a.
Foldable f =>
(a -> Builder) -> f a -> Builder
listF' forall p. Buildable p => p -> Builder
build
{-# INLINE listF #-}
listF' :: (Foldable f) => (a -> Builder) -> f a -> Builder
listF' :: forall (f :: * -> *) a.
Foldable f =>
(a -> Builder) -> f a -> Builder
listF' a -> Builder
fbuild f a
xs = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$
Builder
"[" forall a. a -> [a] -> [a]
:
forall a. a -> [a] -> [a]
intersperse Builder
", " (forall a b. (a -> b) -> [a] -> [b]
map a -> Builder
fbuild (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f a
xs)) forall a. [a] -> [a] -> [a]
++
[Builder
"]"]
{-# SPECIALIZE listF' :: (a -> Builder) -> [a] -> Builder #-}
blockListF :: forall f a. (Foldable f, Buildable a) => f a -> Builder
blockListF :: forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
blockListF = forall (f :: * -> *) a.
Foldable f =>
Text -> (a -> Builder) -> f a -> Builder
blockListF' Text
"-" forall p. Buildable p => p -> Builder
build
{-# INLINE blockListF #-}
blockListF'
:: forall f a. Foldable f
=> Text
-> (a -> Builder)
-> f a
-> Builder
blockListF' :: forall (f :: * -> *) a.
Foldable f =>
Text -> (a -> Builder) -> f a -> Builder
blockListF' Text
bullet a -> Builder
fbuild f a
xs = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Builder]
items then Builder
"[]\n" else forall a. Monoid a => [a] -> a
mconcat [Builder]
items
where
items :: [Builder]
items = forall a b. (a -> b) -> [a] -> [b]
map a -> Builder
buildItem (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f a
xs)
spaces :: Builder
spaces = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate (Text -> Int
T.length Text
bullet forall a. Num a => a -> a -> a
+ Int
1) (Char -> Builder
singleton Char
' ')
buildItem :: a -> Builder
buildItem a
x = case Text -> [Text]
TL.lines (Builder -> Text
toLazyText (a -> Builder
fbuild a
x)) of
[] -> Text
bullet forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"\n"
(Text
l:[Text]
ls) -> Text
bullet forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" " forall b. FromBuilder b => Builder -> Builder -> b
+| Text
l forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"\n" forall a. Semigroup a => a -> a -> a
<>
forall a. Monoid a => [a] -> a
mconcat [Builder
spaces forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromLazyText Text
s forall a. Semigroup a => a -> a -> a
<> Builder
"\n" | Text
s <- [Text]
ls]
{-# SPECIALIZE blockListF' :: Text -> (a -> Builder) -> [a] -> Builder #-}
jsonListF :: forall f a. (Foldable f, Buildable a) => f a -> Builder
jsonListF :: forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
jsonListF = forall (f :: * -> *) a.
Foldable f =>
(a -> Builder) -> f a -> Builder
jsonListF' forall p. Buildable p => p -> Builder
build
{-# INLINE jsonListF #-}
jsonListF' :: forall f a. (Foldable f) => (a -> Builder) -> f a -> Builder
jsonListF' :: forall (f :: * -> *) a.
Foldable f =>
(a -> Builder) -> f a -> Builder
jsonListF' a -> Builder
fbuild f a
xs
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Builder]
items = Builder
"[]\n"
| Bool
otherwise = Builder
"[\n" forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat [Builder]
items forall a. Semigroup a => a -> a -> a
<> Builder
"]\n"
where
items :: [Builder]
items = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Bool -> a -> Builder
buildItem (Bool
True forall a. a -> [a] -> [a]
: forall a. a -> [a]
repeat Bool
False) (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f a
xs)
buildItem :: Bool -> a -> Builder
buildItem :: Bool -> a -> Builder
buildItem Bool
isFirst a
x =
case forall a b. (a -> b) -> [a] -> [b]
map Text -> Builder
fromLazyText (Text -> [Text]
TL.lines (Builder -> Text
toLazyText (a -> Builder
fbuild a
x))) of
[] | Bool
isFirst -> Builder
"\n"
| Bool
otherwise -> Builder
",\n"
[Builder]
ls ->
forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. Semigroup a => a -> a -> a
<> Builder
"\n") forall a b. (a -> b) -> a -> b
$
[Builder]
ls forall a b. a -> (a -> b) -> b
& forall s a. Cons s s a a => Traversal' s a
_head forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (if Bool
isFirst then (Builder
" " forall a. Semigroup a => a -> a -> a
<>) else (Builder
", " forall a. Semigroup a => a -> a -> a
<>))
forall a b. a -> (a -> b) -> b
& forall s a. Cons s s a a => Traversal' s s
_tailforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s t a b. Each s t a b => Traversal s t a b
each forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Builder
" " forall a. Semigroup a => a -> a -> a
<>)
{-# SPECIALIZE jsonListF' :: (a -> Builder) -> [a] -> Builder #-}
mapF :: (IsList t, Item t ~ (k, v), Buildable k, Buildable v) => t -> Builder
mapF :: forall t k v.
(IsList t, Item t ~ (k, v), Buildable k, Buildable v) =>
t -> Builder
mapF = forall t k v.
(IsList t, Item t ~ (k, v)) =>
(k -> Builder) -> (v -> Builder) -> t -> Builder
mapF' forall p. Buildable p => p -> Builder
build forall p. Buildable p => p -> Builder
build
{-# INLINE mapF #-}
mapF'
:: (IsList t, Item t ~ (k, v))
=> (k -> Builder) -> (v -> Builder) -> t -> Builder
mapF' :: forall t k v.
(IsList t, Item t ~ (k, v)) =>
(k -> Builder) -> (v -> Builder) -> t -> Builder
mapF' k -> Builder
fbuild_k v -> Builder
fbuild_v t
xs =
Builder
"{" forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a. a -> [a] -> [a]
intersperse Builder
", " (forall a b. (a -> b) -> [a] -> [b]
map (k, v) -> Builder
buildPair (forall l. IsList l => l -> [Item l]
IsList.toList t
xs))) forall a. Semigroup a => a -> a -> a
<> Builder
"}"
where
buildPair :: (k, v) -> Builder
buildPair (k
k, v
v) = k -> Builder
fbuild_k k
k forall a. Semigroup a => a -> a -> a
<> Builder
": " forall a. Semigroup a => a -> a -> a
<> v -> Builder
fbuild_v v
v
blockMapF :: (IsList t, Item t ~ (k, v), Buildable k, Buildable v) => t -> Builder
blockMapF :: forall t k v.
(IsList t, Item t ~ (k, v), Buildable k, Buildable v) =>
t -> Builder
blockMapF = forall t k v.
(IsList t, Item t ~ (k, v)) =>
(k -> Builder) -> (v -> Builder) -> t -> Builder
blockMapF' forall p. Buildable p => p -> Builder
build forall p. Buildable p => p -> Builder
build
{-# INLINE blockMapF #-}
blockMapF'
:: (IsList t, Item t ~ (k, v))
=> (k -> Builder) -> (v -> Builder) -> t -> Builder
blockMapF' :: forall t k v.
(IsList t, Item t ~ (k, v)) =>
(k -> Builder) -> (v -> Builder) -> t -> Builder
blockMapF' k -> Builder
fbuild_k v -> Builder
fbuild_v t
xs
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Builder]
items = Builder
"{}\n"
| Bool
otherwise = forall a. Monoid a => [a] -> a
mconcat [Builder]
items
where
items :: [Builder]
items = forall a b. (a -> b) -> [a] -> [b]
map (\(k
k, v
v) -> Builder -> Builder -> Builder
nameF (k -> Builder
fbuild_k k
k) (v -> Builder
fbuild_v v
v)) (forall l. IsList l => l -> [Item l]
IsList.toList t
xs)
jsonMapF :: (IsList t, Item t ~ (k, v), Buildable k, Buildable v) => t -> Builder
jsonMapF :: forall t k v.
(IsList t, Item t ~ (k, v), Buildable k, Buildable v) =>
t -> Builder
jsonMapF = forall t k v.
(IsList t, Item t ~ (k, v)) =>
(k -> Builder) -> (v -> Builder) -> t -> Builder
jsonMapF' forall p. Buildable p => p -> Builder
build forall p. Buildable p => p -> Builder
build
{-# INLINE jsonMapF #-}
jsonMapF'
:: forall t k v.
(IsList t, Item t ~ (k, v))
=> (k -> Builder) -> (v -> Builder) -> t -> Builder
jsonMapF' :: forall t k v.
(IsList t, Item t ~ (k, v)) =>
(k -> Builder) -> (v -> Builder) -> t -> Builder
jsonMapF' k -> Builder
fbuild_k v -> Builder
fbuild_v t
xs
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Builder]
items = Builder
"{}\n"
| Bool
otherwise = Builder
"{\n" forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat [Builder]
items forall a. Semigroup a => a -> a -> a
<> Builder
"}\n"
where
items :: [Builder]
items = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Bool -> (k, v) -> Builder
buildItem (Bool
True forall a. a -> [a] -> [a]
: forall a. a -> [a]
repeat Bool
False) (forall l. IsList l => l -> [Item l]
IsList.toList t
xs)
buildItem :: Bool -> (k, v) -> Builder
buildItem :: Bool -> (k, v) -> Builder
buildItem Bool
isFirst (k
k, v
v) = do
let kb :: Builder
kb = (if Bool
isFirst then Builder
" " else Builder
", ") forall a. Semigroup a => a -> a -> a
<> k -> Builder
fbuild_k k
k
case forall a b. (a -> b) -> [a] -> [b]
map Text -> Builder
fromLazyText (Text -> [Text]
TL.lines (Builder -> Text
toLazyText (v -> Builder
fbuild_v v
v))) of
[] -> Builder
kb forall a. Semigroup a => a -> a -> a
<> Builder
":\n"
[Builder
l] -> Builder
kb forall a. Semigroup a => a -> a -> a
<> Builder
": " forall a. Semigroup a => a -> a -> a
<> Builder
l forall a. Semigroup a => a -> a -> a
<> Builder
"\n"
[Builder]
ls -> Builder
kb forall a. Semigroup a => a -> a -> a
<> Builder
":\n" forall a. Semigroup a => a -> a -> a
<>
forall a. Monoid a => [a] -> a
mconcat [Builder
" " forall a. Semigroup a => a -> a -> a
<> Builder
s forall a. Semigroup a => a -> a -> a
<> Builder
"\n" | Builder
s <- [Builder]
ls]
maybeF :: Buildable a => Maybe a -> Builder
maybeF :: forall a. Buildable a => Maybe a -> Builder
maybeF = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
"<Nothing>" forall p. Buildable p => p -> Builder
build
eitherF :: (Buildable a, Buildable b) => Either a b -> Builder
eitherF :: forall a b. (Buildable a, Buildable b) => Either a b -> Builder
eitherF = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\a
x -> Builder
"<Left: " forall a. Semigroup a => a -> a -> a
<> forall p. Buildable p => p -> Builder
build a
x forall a. Semigroup a => a -> a -> a
<> Builder
">")
(\b
x -> Builder
"<Right: " forall a. Semigroup a => a -> a -> a
<> forall p. Buildable p => p -> Builder
build b
x forall a. Semigroup a => a -> a -> a
<> Builder
">")
prefixF :: Buildable a => Int -> a -> Builder
prefixF :: forall a. Buildable a => Int -> a -> Builder
prefixF Int
size =
Text -> Builder
fromLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Text -> Text
TL.take (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p. Buildable p => p -> Builder
build
suffixF :: Buildable a => Int -> a -> Builder
suffixF :: forall a. Buildable a => Int -> a -> Builder
suffixF Int
size =
Text -> Builder
fromLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(\Text
t -> Int64 -> Text -> Text
TL.drop (Text -> Int64
TL.length Text
t forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size) Text
t) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Builder -> Text
toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p. Buildable p => p -> Builder
build
padLeftF :: Buildable a => Int -> Char -> a -> Builder
padLeftF :: forall a. Buildable a => Int -> Char -> a -> Builder
padLeftF = forall a. Buildable a => Int -> Char -> a -> Builder
F.left
padRightF :: Buildable a => Int -> Char -> a -> Builder
padRightF :: forall a. Buildable a => Int -> Char -> a -> Builder
padRightF = forall a. Buildable a => Int -> Char -> a -> Builder
F.right
padBothF :: Buildable a => Int -> Char -> a -> Builder
padBothF :: forall a. Buildable a => Int -> Char -> a -> Builder
padBothF Int
i Char
c =
Text -> Builder
fromLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Char -> Text -> Text
TL.center (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i) Char
c forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p. Buildable p => p -> Builder
build
whenF :: Bool -> Builder -> Builder
whenF :: Bool -> Builder -> Builder
whenF Bool
True Builder
x = Builder
x
whenF Bool
False Builder
_ = forall a. Monoid a => a
mempty
{-# INLINE whenF #-}
unlessF :: Bool -> Builder -> Builder
unlessF :: Bool -> Builder -> Builder
unlessF Bool
False Builder
x = Builder
x
unlessF Bool
True Builder
_ = forall a. Monoid a => a
mempty
{-# INLINE unlessF #-}