module Language.Haskell.Stylish.Align
( Alignable (..)
, align
) where
import Data.List (nub)
import qualified GHC.Types.SrcLoc as GHC
import Language.Haskell.Stylish.Editor
import Language.Haskell.Stylish.Util
data Alignable a = Alignable
{ Alignable a -> a
aContainer :: !a
, Alignable a -> a
aLeft :: !a
, Alignable a -> a
aRight :: !a
, Alignable a -> Int
aRightLead :: !Int
} deriving (Int -> Alignable a -> ShowS
[Alignable a] -> ShowS
Alignable a -> String
(Int -> Alignable a -> ShowS)
-> (Alignable a -> String)
-> ([Alignable a] -> ShowS)
-> Show (Alignable a)
forall a. Show a => Int -> Alignable a -> ShowS
forall a. Show a => [Alignable a] -> ShowS
forall a. Show a => Alignable a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Alignable a] -> ShowS
$cshowList :: forall a. Show a => [Alignable a] -> ShowS
show :: Alignable a -> String
$cshow :: forall a. Show a => Alignable a -> String
showsPrec :: Int -> Alignable a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Alignable a -> ShowS
Show)
align
:: Maybe Int
-> [Alignable GHC.RealSrcSpan]
-> [Change String]
align :: Maybe Int -> [Alignable RealSrcSpan] -> [Change String]
align Maybe Int
_ [] = []
align Maybe Int
maxColumns [Alignable RealSrcSpan]
alignment
| Int -> Bool
exceedsColumns (Int
longestLeft Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
longestRight) = []
| Bool -> Bool
not ([Alignable RealSrcSpan] -> Bool
fixable [Alignable RealSrcSpan]
alignment) = []
| Bool
otherwise = (Alignable RealSrcSpan -> Change String)
-> [Alignable RealSrcSpan] -> [Change String]
forall a b. (a -> b) -> [a] -> [b]
map Alignable RealSrcSpan -> Change String
align' [Alignable RealSrcSpan]
alignment
where
exceedsColumns :: Int -> Bool
exceedsColumns Int
i = case Maybe Int
maxColumns of
Maybe Int
Nothing -> Bool
False
Just Int
c -> Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
c
longestLeft :: Int
longestLeft = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Alignable RealSrcSpan -> Int) -> [Alignable RealSrcSpan] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (RealSrcSpan -> Int
GHC.srcSpanEndCol (RealSrcSpan -> Int)
-> (Alignable RealSrcSpan -> RealSrcSpan)
-> Alignable RealSrcSpan
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alignable RealSrcSpan -> RealSrcSpan
forall a. Alignable a -> a
aLeft) [Alignable RealSrcSpan]
alignment
longestRight :: Int
longestRight = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum
[ RealSrcSpan -> Int
GHC.srcSpanEndCol (Alignable RealSrcSpan -> RealSrcSpan
forall a. Alignable a -> a
aRight Alignable RealSrcSpan
a) Int -> Int -> Int
forall a. Num a => a -> a -> a
- RealSrcSpan -> Int
GHC.srcSpanStartCol (Alignable RealSrcSpan -> RealSrcSpan
forall a. Alignable a -> a
aRight Alignable RealSrcSpan
a)
Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Alignable RealSrcSpan -> Int
forall a. Alignable a -> Int
aRightLead Alignable RealSrcSpan
a
| Alignable RealSrcSpan
a <- [Alignable RealSrcSpan]
alignment
]
align' :: Alignable RealSrcSpan -> Change String
align' Alignable RealSrcSpan
a = Int -> (String -> [String]) -> Change String
forall a. Int -> (a -> [a]) -> Change a
changeLine (RealSrcSpan -> Int
GHC.srcSpanStartLine (RealSrcSpan -> Int) -> RealSrcSpan -> Int
forall a b. (a -> b) -> a -> b
$ Alignable RealSrcSpan -> RealSrcSpan
forall a. Alignable a -> a
aContainer Alignable RealSrcSpan
a) ((String -> [String]) -> Change String)
-> (String -> [String]) -> Change String
forall a b. (a -> b) -> a -> b
$ \String
str ->
let column :: Int
column = RealSrcSpan -> Int
GHC.srcSpanEndCol (RealSrcSpan -> Int) -> RealSrcSpan -> Int
forall a b. (a -> b) -> a -> b
$ Alignable RealSrcSpan -> RealSrcSpan
forall a. Alignable a -> a
aLeft Alignable RealSrcSpan
a
(String
pre, String
post) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
column String
str
in [Int -> ShowS
padRight Int
longestLeft (ShowS
trimRight String
pre) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
trimLeft String
post]
fixable :: [Alignable GHC.RealSrcSpan] -> Bool
fixable :: [Alignable RealSrcSpan] -> Bool
fixable [] = Bool
False
fixable [Alignable RealSrcSpan
_] = Bool
False
fixable [Alignable RealSrcSpan]
fields = (RealSrcSpan -> Bool) -> [RealSrcSpan] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all RealSrcSpan -> Bool
singleLine [RealSrcSpan]
containers Bool -> Bool -> Bool
&& [RealSrcSpan] -> Bool
nonOverlapping [RealSrcSpan]
containers
where
containers :: [RealSrcSpan]
containers = (Alignable RealSrcSpan -> RealSrcSpan)
-> [Alignable RealSrcSpan] -> [RealSrcSpan]
forall a b. (a -> b) -> [a] -> [b]
map Alignable RealSrcSpan -> RealSrcSpan
forall a. Alignable a -> a
aContainer [Alignable RealSrcSpan]
fields
singleLine :: RealSrcSpan -> Bool
singleLine RealSrcSpan
s = RealSrcSpan -> Int
GHC.srcSpanStartLine RealSrcSpan
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== RealSrcSpan -> Int
GHC.srcSpanEndLine RealSrcSpan
s
nonOverlapping :: [RealSrcSpan] -> Bool
nonOverlapping [RealSrcSpan]
ss = [RealSrcSpan] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [RealSrcSpan]
ss Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Int] -> [Int]
forall a. Eq a => [a] -> [a]
nub ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (RealSrcSpan -> Int) -> [RealSrcSpan] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map RealSrcSpan -> Int
GHC.srcSpanStartLine [RealSrcSpan]
ss)