brittany/source/library/Brittany/Internal/Transformations/Columns.hs

163 lines
5.1 KiB
Haskell

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Brittany.Internal.Transformations.Columns where
import qualified Data.Generics.Uniplate.Direct as Uniplate
import qualified GHC.OldList as List
import Brittany.Internal.Prelude
import Brittany.Internal.Types
transformSimplifyColumns :: BriDoc -> BriDoc
transformSimplifyColumns = Uniplate.rewrite $ \case
-- BDWrapAnnKey annKey bd ->
-- BDWrapAnnKey annKey $ transformSimplify bd
BDEmpty -> Nothing
BDLit{} -> Nothing
BDSeq list
| any
(\case
BDSeq{} -> True
BDEmpty{} -> True
_ -> False
)
list
-> Just $ BDSeq $ list >>= \case
BDEmpty -> []
BDSeq l -> l
x -> [x]
BDSeq (BDCols sig1 cols1@(_ : _) : rest)
| all
(\case
BDSeparator -> True
_ -> False
)
rest
-> Just $ BDCols sig1 (List.init cols1 ++ [BDSeq (List.last cols1 : rest)])
BDLines lines
| any
(\case
BDLines{} -> True
BDEmpty{} -> True
_ -> False
)
lines
-> Just $ BDLines $ filter isNotEmpty $ lines >>= \case
BDLines l -> l
x -> [x]
-- prior floating in
BDAnnotationPrior annKey1 (BDSeq (l : lr)) ->
Just $ BDSeq (BDAnnotationPrior annKey1 l : lr)
BDAnnotationPrior annKey1 (BDLines (l : lr)) ->
Just $ BDLines (BDAnnotationPrior annKey1 l : lr)
BDAnnotationPrior annKey1 (BDCols sig (l : lr)) ->
Just $ BDCols sig (BDAnnotationPrior annKey1 l : lr)
-- post floating in
BDAnnotationRest annKey1 (BDSeq list) ->
Just $ BDSeq $ List.init list ++ [BDAnnotationRest annKey1 $ List.last list]
BDAnnotationRest annKey1 (BDLines list) ->
Just
$ BDLines
$ List.init list
++ [BDAnnotationRest annKey1 $ List.last list]
BDAnnotationRest annKey1 (BDCols sig cols) ->
Just
$ BDCols sig
$ List.init cols
++ [BDAnnotationRest annKey1 $ List.last cols]
BDAnnotationKW annKey1 kw (BDSeq list) ->
Just
$ BDSeq
$ List.init list
++ [BDAnnotationKW annKey1 kw $ List.last list]
BDAnnotationKW annKey1 kw (BDLines list) ->
Just
$ BDLines
$ List.init list
++ [BDAnnotationKW annKey1 kw $ List.last list]
BDAnnotationKW annKey1 kw (BDCols sig cols) ->
Just
$ BDCols sig
$ List.init cols
++ [BDAnnotationKW annKey1 kw $ List.last cols]
-- ensureIndent float-in
-- not sure if the following rule is necessary; tests currently are
-- unaffected.
-- BDEnsureIndent indent (BDLines lines) ->
-- Just $ BDLines $ BDEnsureIndent indent <$> lines
-- matching col special transformation
BDCols sig1 cols1@(_ : _)
| BDLines lines@(_ : _ : _) <- List.last cols1
, BDCols sig2 cols2 <- List.last lines
, sig1 == sig2
-> Just $ BDLines
[ BDCols sig1 $ List.init cols1 ++ [BDLines $ List.init lines]
, BDCols sig2 cols2
]
BDCols sig1 cols1@(_ : _)
| BDLines lines@(_ : _ : _) <- List.last cols1
, BDEnsureIndent _ (BDCols sig2 cols2) <- List.last lines
, sig1 == sig2
-> Just $ BDLines
[ BDCols sig1 $ List.init cols1 ++ [BDLines $ List.init lines]
, BDCols sig2 cols2
]
BDPar ind col1@(BDCols sig1 _) col2@(BDCols sig2 _) | sig1 == sig2 ->
Just $ BDAddBaseY ind (BDLines [col1, col2])
BDPar ind col1@(BDCols sig1 _) (BDLines (col2@(BDCols sig2 _) : rest))
| sig1 == sig2 -> Just $ BDPar ind (BDLines [col1, col2]) (BDLines rest)
BDPar ind (BDLines lines1) col2@(BDCols sig2 _)
| BDCols sig1 _ <- List.last lines1, sig1 == sig2 -> Just
$ BDAddBaseY ind (BDLines $ lines1 ++ [col2])
BDPar ind (BDLines lines1) (BDLines (col2@(BDCols sig2 _) : rest))
| BDCols sig1 _ <- List.last lines1, sig1 == sig2 -> Just
$ BDPar ind (BDLines $ lines1 ++ [col2]) (BDLines rest)
-- BDPar ind1 (BDCols sig1 cols1) (BDPar ind2 line (BDCols sig2 cols2))
-- | sig1==sig2 ->
-- Just $ BDPar
-- ind1
-- (BDLines [BDCols sig1 cols1, BDCols sig])
BDCols sig1 cols
| BDPar _ind line (BDCols sig2 cols2) <- List.last cols, sig1 == sig2
-> Just
$ BDLines [BDCols sig1 (List.init cols ++ [line]), BDCols sig2 cols2]
BDCols sig1 cols
| BDPar ind line (BDLines lines) <- List.last cols
, BDCols sig2 cols2 <- List.last lines
, sig1 == sig2
-> Just $ BDLines
[ BDCols sig1
$ List.init cols
++ [BDPar ind line (BDLines $ List.init lines)]
, BDCols sig2 cols2
]
BDLines [x] -> Just $ x
BDLines [] -> Just $ BDEmpty
BDSeq{} -> Nothing
BDCols{} -> Nothing
BDSeparator -> Nothing
BDAddBaseY{} -> Nothing
BDBaseYPushCur{} -> Nothing
BDBaseYPop{} -> Nothing
BDIndentLevelPushCur{} -> Nothing
BDIndentLevelPop{} -> Nothing
BDPar{} -> Nothing
BDAlt{} -> Nothing
BDForceMultiline{} -> Nothing
BDForceSingleline{} -> Nothing
BDForwardLineMode{} -> Nothing
BDExternal{} -> Nothing
BDPlain{} -> Nothing
BDLines{} -> Nothing
BDAnnotationPrior{} -> Nothing
BDAnnotationKW{} -> Nothing
BDAnnotationRest{} -> Nothing
BDMoveToKWDP{} -> Nothing
BDEnsureIndent{} -> Nothing
BDSetParSpacing{} -> Nothing
BDForceParSpacing{} -> Nothing
BDDebug{} -> Nothing
BDNonBottomSpacing _ x -> Just x