--------------------------------------------------------------------------------
-- | This module is useful for aligning things.
module Language.Haskell.Stylish.Align
    ( Alignable (..)
    , align
    ) where


--------------------------------------------------------------------------------
import           Data.List                       (nub)
import qualified SrcLoc                          as S


--------------------------------------------------------------------------------
import           Language.Haskell.Stylish.Editor
import           Language.Haskell.Stylish.Util


--------------------------------------------------------------------------------
-- | This represent a single line which can be aligned.  We have something on
-- the left and the right side, e.g.:
--
-- > [x]  -> x + 1
-- > ^^^^    ^^^^^
-- > LEFT    RIGHT
--
-- We also have the container which holds the entire line:
--
-- > [x]  -> x + 1
-- > ^^^^^^^^^^^^^
-- > CONTAINER
--
-- And then we have a "right lead" which is just represented by an 'Int', since
-- @haskell-src-exts@ often does not allow us to access it.  In the example this
-- is:
--
-- > [x]  -> x + 1
-- >      ^^^
-- >      RLEAD
--
-- This info is enough to align a bunch of these lines.  Users of this module
-- should construct a list of 'Alignable's representing whatever they want to
-- align, and then call 'align' on that.
data Alignable a = Alignable
    { Alignable a -> a
aContainer :: !a
    , Alignable a -> a
aLeft      :: !a
    , Alignable a -> a
aRight     :: !a
    -- | This is the minimal number of columns we need for the leading part not
    -- included in our right string.  For example, for datatype alignment, this
    -- leading part is the string ":: " so we use 3.
    , 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)

--------------------------------------------------------------------------------
-- | Create changes that perform the alignment.

align
  :: Maybe Int                    -- ^ Max columns
  -> [Alignable S.RealSrcSpan]    -- ^ Alignables
  -> [Change String]              -- ^ Changes performing the alignment
align :: Maybe Int -> [Alignable RealSrcSpan] -> [Change String]
align Maybe Int
_ [] = []
align Maybe Int
maxColumns [Alignable RealSrcSpan]
alignment
  -- Do not make an changes if we would go past the maximum number of columns
  | 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

    -- The longest thing in the left column
    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
S.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

    -- The longest thing in the right column
    longestRight :: Int
longestRight = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum
      [ RealSrcSpan -> Int
S.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
S.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
S.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
S.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] 

--------------------------------------------------------------------------------
-- | Checks that all the alignables appear on a single line, and that they do
-- not overlap.

fixable :: [Alignable S.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
S.srcSpanStartLine RealSrcSpan
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== RealSrcSpan -> Int
S.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
S.srcSpanStartLine [RealSrcSpan]
ss)