module Language.Haskell.Brittany.Internal.Transformations.Par
  ( transformSimplifyPar
  )
where



#include "prelude.inc"

import           Language.Haskell.Brittany.Internal.Utils
import           Language.Haskell.Brittany.Internal.Config.Types
import           Language.Haskell.Brittany.Internal.Types

import qualified Data.Generics.Uniplate.Direct as Uniplate



transformSimplifyPar :: BriDoc -> BriDoc
transformSimplifyPar :: BriDoc -> BriDoc
transformSimplifyPar = (BriDoc -> BriDoc) -> BriDoc -> BriDoc
forall on. Uniplate on => (on -> on) -> on -> on
transformUp ((BriDoc -> BriDoc) -> BriDoc -> BriDoc)
-> (BriDoc -> BriDoc) -> BriDoc -> BriDoc
forall a b. (a -> b) -> a -> b
$ \case
  -- BDPar BrIndentNone line1 line2 -> Just $ BDLines [line1, line2]
  -- BDPar line indented ->
  --   Just $ BDLines [line, indented]
  -- BDPar ind1 (BDPar ind2 line p1) p2 | ind1==ind2 ->
  --   Just $ BDPar ind1 line (BDLines [p1, p2])
  x :: BriDoc
x@(BDPar BrIndent
_ (BDPar BrIndent
_ BDPar{} BriDoc
_) BriDoc
_) -> BriDoc
x
  BDPar BrIndent
ind1 (BDPar BrIndent
ind2 BriDoc
line BriDoc
p1) (BDLines [BriDoc]
indenteds) ->
    BrIndent -> BriDoc -> BriDoc -> BriDoc
BDPar BrIndent
ind1 BriDoc
line ([BriDoc] -> BriDoc
BDLines (BrIndent -> BriDoc -> BriDoc
BDEnsureIndent BrIndent
ind2 BriDoc
p1 BriDoc -> [BriDoc] -> [BriDoc]
forall a. a -> [a] -> [a]
: [BriDoc]
indenteds))
  BDPar BrIndent
ind1 (BDPar BrIndent
ind2 BriDoc
line BriDoc
p1) BriDoc
p2 ->
    BrIndent -> BriDoc -> BriDoc -> BriDoc
BDPar BrIndent
ind1 BriDoc
line ([BriDoc] -> BriDoc
BDLines [BrIndent -> BriDoc -> BriDoc
BDEnsureIndent BrIndent
ind2 BriDoc
p1, BriDoc
p2])
  BDLines [BriDoc]
lines | (BriDoc -> Bool) -> [BriDoc] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ( \case
                        BDLines{} -> Bool
True
                        BDEmpty{} -> Bool
True
                        BriDoc
_         -> Bool
False
                      )
                      [BriDoc]
lines  -> case [BriDoc] -> [BriDoc]
go [BriDoc]
lines of
    []  -> BriDoc
BDEmpty
    [BriDoc
x] -> BriDoc
x
    [BriDoc]
xs  -> [BriDoc] -> BriDoc
BDLines [BriDoc]
xs
   where
    go :: [BriDoc] -> [BriDoc]
go = (BriDoc -> [BriDoc]) -> [BriDoc] -> [BriDoc]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
(=<<) ((BriDoc -> [BriDoc]) -> [BriDoc] -> [BriDoc])
-> (BriDoc -> [BriDoc]) -> [BriDoc] -> [BriDoc]
forall a b. (a -> b) -> a -> b
$ \case
      BDLines [BriDoc]
l -> [BriDoc] -> [BriDoc]
go [BriDoc]
l
      BriDoc
BDEmpty   -> []
      BriDoc
x         -> [BriDoc
x]
  BDLines []                    -> BriDoc
BDEmpty
  BDLines [BriDoc
x]                   -> BriDoc
x
  -- BDCols sig cols | BDPar ind line indented <- List.last cols ->
  --   Just $ BDPar ind (BDCols sig (List.init cols ++ [line])) indented
  -- BDPar BrIndentNone line indented ->
  --   Just $ BDLines [line, indented]
  BDEnsureIndent BrIndent
BrIndentNone BriDoc
x -> BriDoc
x
  BriDoc
x                             -> BriDoc
x