{-# 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


-- $setup
-- >>> import Fmt.Internal.Core

class TupleF a where
  {- |
Format a tuple (of up to 8 elements):

>>> tupleF (1,2,"hi")
"(1, 2, hi)"

If any of the elements takes several lines, an alternate format is used:

>>> fmt $ tupleF ("test","foo\nbar","more test")
( test
,
  foo
  bar
,
  more test )

You can also use 'tupleF' on lists to get tuple-like formatting.
  -}
  tupleF :: a -> Builder

instance (Buildable a1, Buildable a2)
  => TupleF (a1, a2) where
  tupleF :: (a1, a2) -> Builder
tupleF (a1
a1, a2
a2) = [Builder] -> Builder
forall a. TupleF a => a -> Builder
tupleF
    [a1 -> Builder
forall p. Buildable p => p -> Builder
build a1
a1, a2 -> Builder
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) = [Builder] -> Builder
forall a. TupleF a => a -> Builder
tupleF
    [a1 -> Builder
forall p. Buildable p => p -> Builder
build a1
a1, a2 -> Builder
forall p. Buildable p => p -> Builder
build a2
a2, a3 -> Builder
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) = [Builder] -> Builder
forall a. TupleF a => a -> Builder
tupleF
    [a1 -> Builder
forall p. Buildable p => p -> Builder
build a1
a1, a2 -> Builder
forall p. Buildable p => p -> Builder
build a2
a2, a3 -> Builder
forall p. Buildable p => p -> Builder
build a3
a3, a4 -> Builder
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) = [Builder] -> Builder
forall a. TupleF a => a -> Builder
tupleF
    [a1 -> Builder
forall p. Buildable p => p -> Builder
build a1
a1, a2 -> Builder
forall p. Buildable p => p -> Builder
build a2
a2, a3 -> Builder
forall p. Buildable p => p -> Builder
build a3
a3, a4 -> Builder
forall p. Buildable p => p -> Builder
build a4
a4,
     a5 -> Builder
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) = [Builder] -> Builder
forall a. TupleF a => a -> Builder
tupleF
    [a1 -> Builder
forall p. Buildable p => p -> Builder
build a1
a1, a2 -> Builder
forall p. Buildable p => p -> Builder
build a2
a2, a3 -> Builder
forall p. Buildable p => p -> Builder
build a3
a3, a4 -> Builder
forall p. Buildable p => p -> Builder
build a4
a4,
     a5 -> Builder
forall p. Buildable p => p -> Builder
build a5
a5, a6 -> Builder
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) = [Builder] -> Builder
forall a. TupleF a => a -> Builder
tupleF
    [a1 -> Builder
forall p. Buildable p => p -> Builder
build a1
a1, a2 -> Builder
forall p. Buildable p => p -> Builder
build a2
a2, a3 -> Builder
forall p. Buildable p => p -> Builder
build a3
a3, a4 -> Builder
forall p. Buildable p => p -> Builder
build a4
a4,
     a5 -> Builder
forall p. Buildable p => p -> Builder
build a5
a5, a6 -> Builder
forall p. Buildable p => p -> Builder
build a6
a6, a7 -> Builder
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) = [Builder] -> Builder
forall a. TupleF a => a -> Builder
tupleF
    [a1 -> Builder
forall p. Buildable p => p -> Builder
build a1
a1, a2 -> Builder
forall p. Buildable p => p -> Builder
build a2
a2, a3 -> Builder
forall p. Buildable p => p -> Builder
build a3
a3, a4 -> Builder
forall p. Buildable p => p -> Builder
build a4
a4,
     a5 -> Builder
forall p. Buildable p => p -> Builder
build a5
a5, a6 -> Builder
forall p. Buildable p => p -> Builder
build a6
a6, a7 -> Builder
forall p. Buildable p => p -> Builder
build a7
a7, a8 -> Builder
forall p. Buildable p => p -> Builder
build a8
a8]

instance Buildable a => TupleF [a] where
  tupleF :: [a] -> Builder
tupleF = [Builder] -> Builder
forall a. TupleF a => a -> Builder
tupleF ([Builder] -> Builder) -> ([a] -> [Builder]) -> [a] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Builder) -> [a] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map a -> Builder
forall p. Buildable p => p -> Builder
build

instance {-# OVERLAPPING #-} TupleF [Builder] where
  tupleF :: [Builder] -> Builder
tupleF [Builder]
xs
    | Bool
True Bool -> [Bool] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Bool]
mls = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat (Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse Builder
",\n" [Builder]
items)
    | Bool
otherwise = Builder
"(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat (Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse Builder
", " [Builder]
xs) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
")"
   where
    ([Bool]
mls, [Builder]
items) = [(Bool, Builder)] -> ([Bool], [Builder])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Bool, Builder)] -> ([Bool], [Builder]))
-> [(Bool, Builder)] -> ([Bool], [Builder])
forall a b. (a -> b) -> a -> b
$ (Builder -> Bool -> Bool -> (Bool, Builder))
-> [Builder] -> [Bool] -> [Bool] -> [(Bool, Builder)]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 Builder -> Bool -> Bool -> (Bool, Builder)
buildItem
                             [Builder]
xs (ASetter [Bool] [Bool] Bool Bool -> Bool -> [Bool] -> [Bool]
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter [Bool] [Bool] Bool Bool
forall s a. Cons s s a a => Traversal' s a
_head Bool
True [Bool]
falses) (ASetter [Bool] [Bool] Bool Bool -> Bool -> [Bool] -> [Bool]
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter [Bool] [Bool] Bool Bool
forall s a. Snoc s s a a => Traversal' s a
_last Bool
True [Bool]
falses)
    -- A list of 'False's which has the same length as 'xs'
    falses :: [Bool]
falses = (Builder -> Bool) -> [Builder] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Builder -> Bool
forall a b. a -> b -> a
const Bool
False) [Builder]
xs
    -- Returns 'True' if the item is multiline
    buildItem :: Builder
              -> Bool              -- ^ Is the item the first?
              -> Bool              -- ^ Is the item the last?
              -> (Bool, Builder)
    buildItem :: Builder -> Bool -> Bool -> (Bool, Builder)
buildItem Builder
x Bool
isFirst Bool
isLast =
      case (Text -> Builder) -> [Text] -> [Builder]
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 ([Builder] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Builder] -> [Builder]
forall a. [a] -> [a]
tail [Builder]
ls)),
            [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> ([Builder] -> [Builder]) -> [Builder] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder -> Builder) -> [Builder] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n") ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$
              [Builder]
ls [Builder] -> ([Builder] -> [Builder]) -> [Builder]
forall a b. a -> (a -> b) -> b
& (Builder -> Identity Builder) -> [Builder] -> Identity [Builder]
forall s a. Cons s s a a => Traversal' s a
_head ((Builder -> Identity Builder) -> [Builder] -> Identity [Builder])
-> (Builder -> Builder) -> [Builder] -> [Builder]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (if Bool
isFirst then (Builder
"( " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) else (Builder
"  " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>))
                 [Builder] -> ([Builder] -> [Builder]) -> [Builder]
forall a b. a -> (a -> b) -> b
& ([Builder] -> Identity [Builder])
-> [Builder] -> Identity [Builder]
forall s a. Cons s s a a => Traversal' s s
_tail(([Builder] -> Identity [Builder])
 -> [Builder] -> Identity [Builder])
-> ((Builder -> Identity Builder)
    -> [Builder] -> Identity [Builder])
-> (Builder -> Identity Builder)
-> [Builder]
-> Identity [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Builder -> Identity Builder) -> [Builder] -> Identity [Builder]
forall s t a b. Each s t a b => Traversal s t a b
each ((Builder -> Identity Builder) -> [Builder] -> Identity [Builder])
-> (Builder -> Builder) -> [Builder] -> [Builder]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Builder
"  " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>)
                 [Builder] -> ([Builder] -> [Builder]) -> [Builder]
forall a b. a -> (a -> b) -> b
& (Builder -> Identity Builder) -> [Builder] -> Identity [Builder]
forall s a. Snoc s s a a => Traversal' s a
_last ((Builder -> Identity Builder) -> [Builder] -> Identity [Builder])
-> (Builder -> Builder) -> [Builder] -> [Builder]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (if Bool
isLast then (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" )") else Builder -> Builder
forall a. a -> a
id))