{-# 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) = 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)
    -- A list of 'False's which has the same length as 'xs'
    falses :: [Bool]
falses = forall a b. (a -> b) -> [a] -> [b]
map (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 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))