{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
module Fmt.Internal.Tuple where
#if __GLASGOW_HASKELL__ < 804
import Data.Monoid ((<>))
#endif
import Data.List (intersperse)
import qualified Data.Text.Lazy as TL
import Data.Text.Lazy.Builder
import Formatting.Buildable (Buildable, build)
import Lens.Micro
class TupleF a where
tupleF :: a -> Builder
instance (Buildable a1, Buildable a2)
=> TupleF (a1, a2) where
tupleF :: (a1, a2) -> Builder
tupleF (a1
a1, a2
a2) = forall a. TupleF a => a -> Builder
tupleF
[forall p. Buildable p => p -> Builder
build a1
a1, forall p. Buildable p => p -> Builder
build a2
a2]
instance (Buildable a1, Buildable a2, Buildable a3)
=> TupleF (a1, a2, a3) where
tupleF :: (a1, a2, a3) -> Builder
tupleF (a1
a1, a2
a2, a3
a3) = forall a. TupleF a => a -> Builder
tupleF
[forall p. Buildable p => p -> Builder
build a1
a1, forall p. Buildable p => p -> Builder
build a2
a2, forall p. Buildable p => p -> Builder
build a3
a3]
instance (Buildable a1, Buildable a2, Buildable a3, Buildable a4)
=> TupleF (a1, a2, a3, a4) where
tupleF :: (a1, a2, a3, a4) -> Builder
tupleF (a1
a1, a2
a2, a3
a3, a4
a4) = forall a. TupleF a => a -> Builder
tupleF
[forall p. Buildable p => p -> Builder
build a1
a1, forall p. Buildable p => p -> Builder
build a2
a2, forall p. Buildable p => p -> Builder
build a3
a3, forall p. Buildable p => p -> Builder
build a4
a4]
instance (Buildable a1, Buildable a2, Buildable a3, Buildable a4,
Buildable a5)
=> TupleF (a1, a2, a3, a4, a5) where
tupleF :: (a1, a2, a3, a4, a5) -> Builder
tupleF (a1
a1, a2
a2, a3
a3, a4
a4, a5
a5) = forall a. TupleF a => a -> Builder
tupleF
[forall p. Buildable p => p -> Builder
build a1
a1, forall p. Buildable p => p -> Builder
build a2
a2, forall p. Buildable p => p -> Builder
build a3
a3, forall p. Buildable p => p -> Builder
build a4
a4,
forall p. Buildable p => p -> Builder
build a5
a5]
instance (Buildable a1, Buildable a2, Buildable a3, Buildable a4,
Buildable a5, Buildable a6)
=> TupleF (a1, a2, a3, a4, a5, a6) where
tupleF :: (a1, a2, a3, a4, a5, a6) -> Builder
tupleF (a1
a1, a2
a2, a3
a3, a4
a4, a5
a5, a6
a6) = forall a. TupleF a => a -> Builder
tupleF
[forall p. Buildable p => p -> Builder
build a1
a1, forall p. Buildable p => p -> Builder
build a2
a2, forall p. Buildable p => p -> Builder
build a3
a3, forall p. Buildable p => p -> Builder
build a4
a4,
forall p. Buildable p => p -> Builder
build a5
a5, forall p. Buildable p => p -> Builder
build a6
a6]
instance (Buildable a1, Buildable a2, Buildable a3, Buildable a4,
Buildable a5, Buildable a6, Buildable a7)
=> TupleF (a1, a2, a3, a4, a5, a6, a7) where
tupleF :: (a1, a2, a3, a4, a5, a6, a7) -> Builder
tupleF (a1
a1, a2
a2, a3
a3, a4
a4, a5
a5, a6
a6, a7
a7) = forall a. TupleF a => a -> Builder
tupleF
[forall p. Buildable p => p -> Builder
build a1
a1, forall p. Buildable p => p -> Builder
build a2
a2, forall p. Buildable p => p -> Builder
build a3
a3, forall p. Buildable p => p -> Builder
build a4
a4,
forall p. Buildable p => p -> Builder
build a5
a5, forall p. Buildable p => p -> Builder
build a6
a6, forall p. Buildable p => p -> Builder
build a7
a7]
instance (Buildable a1, Buildable a2, Buildable a3, Buildable a4,
Buildable a5, Buildable a6, Buildable a7, Buildable a8)
=> TupleF (a1, a2, a3, a4, a5, a6, a7, a8) where
tupleF :: (a1, a2, a3, a4, a5, a6, a7, a8) -> Builder
tupleF (a1
a1, a2
a2, a3
a3, a4
a4, a5
a5, a6
a6, a7
a7, a8
a8) = forall a. TupleF a => a -> Builder
tupleF
[forall p. Buildable p => p -> Builder
build a1
a1, forall p. Buildable p => p -> Builder
build a2
a2, forall p. Buildable p => p -> Builder
build a3
a3, forall p. Buildable p => p -> Builder
build a4
a4,
forall p. Buildable p => p -> Builder
build a5
a5, forall p. Buildable p => p -> Builder
build a6
a6, forall p. Buildable p => p -> Builder
build a7
a7, forall p. Buildable p => p -> Builder
build a8
a8]
instance Buildable a => TupleF [a] where
tupleF :: [a] -> Builder
tupleF = forall a. TupleF a => a -> Builder
tupleF 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
instance {-# OVERLAPPING #-} TupleF [Builder] where
tupleF :: [Builder] -> Builder
tupleF [Builder]
xs
| Bool
True forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Bool]
mls = forall a. Monoid a => [a] -> a
mconcat (forall a. a -> [a] -> [a]
intersperse Builder
",\n" [Builder]
items)
| Bool
otherwise = Builder
"(" forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a. a -> [a] -> [a]
intersperse Builder
", " [Builder]
xs) forall a. Semigroup a => a -> a -> a
<> Builder
")"
where
([Bool]
mls, [Builder]
items) = forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$ forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 Builder -> Bool -> Bool -> (Bool, Builder)
buildItem
[Builder]
xs (forall s t a b. ASetter s t a b -> b -> s -> t
set forall s a. Cons s s a a => Traversal' s a
_head Bool
True [Bool]
falses) (forall s t a b. ASetter s t a b -> b -> s -> t
set forall s a. Snoc s s a a => Traversal' s a
_last Bool
True [Bool]
falses)
falses :: [Bool]
falses = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. a -> b -> a
const Bool
False) [Builder]
xs
buildItem :: Builder
-> Bool
-> Bool
-> (Bool, Builder)
buildItem :: Builder -> Bool -> Bool -> (Bool, Builder)
buildItem Builder
x Bool
isFirst Bool
isLast =
case forall a b. (a -> b) -> [a] -> [b]
map Text -> Builder
fromLazyText (Text -> [Text]
TL.lines (Builder -> Text
toLazyText Builder
x)) of
[] | Bool
isFirst Bool -> Bool -> Bool
&& Bool
isLast -> (Bool
False, Builder
"()\n")
| Bool
isFirst -> (Bool
False, Builder
"(\n")
| Bool
isLast -> (Bool
False, Builder
" )\n")
| Bool
otherwise -> (Bool
False, Builder
"")
[Builder]
ls ->
(Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall a. [a] -> [a]
tail [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
<>)
forall a b. a -> (a -> b) -> b
& forall s a. Snoc s s a a => Traversal' s a
_last forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (if Bool
isLast then (forall a. Semigroup a => a -> a -> a
<> Builder
" )") else forall a. a -> a
id))