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


--------------------------------------------------------------------------------
import           Data.List                       (nub)
import qualified GHC.Types.SrcLoc                as GHC


--------------------------------------------------------------------------------
import qualified Language.Haskell.Stylish.Editor as 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
    { forall a. Alignable a -> a
aContainer :: !a
    , forall a. Alignable a -> a
aLeft      :: !a
    , forall 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.
    , forall a. Alignable a -> Int
aRightLead :: !Int
    } deriving (Int -> Alignable a -> ShowS
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 GHC.RealSrcSpan]    -- ^ Alignables
  -> Editor.Edits                   -- ^ Changes performing the alignment
align :: Maybe Int -> [Alignable RealSrcSpan] -> Edits
align Maybe Int
_ [] = forall a. Monoid a => a
mempty
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 forall a. Num a => a -> a -> a
+ Int
longestRight)  = forall a. Monoid a => a
mempty
  | Bool -> Bool
not ([Alignable RealSrcSpan] -> Bool
fixable [Alignable RealSrcSpan]
alignment)                      = forall a. Monoid a => a
mempty
  | Bool
otherwise                                    = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Alignable RealSrcSpan -> Edits
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 forall a. Ord a => a -> a -> Bool
> Int
c

    -- The longest thing in the left column
    longestLeft :: Int
longestLeft = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (RealSrcSpan -> Int
GHC.srcSpanEndCol forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Alignable a -> a
aLeft) [Alignable RealSrcSpan]
alignment

    -- The longest thing in the right column
    longestRight :: Int
longestRight = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum
      [ RealSrcSpan -> Int
GHC.srcSpanEndCol (forall a. Alignable a -> a
aRight Alignable RealSrcSpan
a) forall a. Num a => a -> a -> a
- RealSrcSpan -> Int
GHC.srcSpanStartCol (forall a. Alignable a -> a
aRight Alignable RealSrcSpan
a)
          forall a. Num a => a -> a -> a
+ forall a. Alignable a -> Int
aRightLead Alignable RealSrcSpan
a
      | Alignable RealSrcSpan
a <- [Alignable RealSrcSpan]
alignment
      ]

    align' :: Alignable RealSrcSpan -> Edits
align' Alignable RealSrcSpan
a = Int -> (String -> [String]) -> Edits
Editor.changeLine (RealSrcSpan -> Int
GHC.srcSpanStartLine forall a b. (a -> b) -> a -> b
$ forall a. Alignable a -> a
aContainer Alignable RealSrcSpan
a) forall a b. (a -> b) -> a -> b
$ \String
str ->
      let column :: Int
column = RealSrcSpan -> Int
GHC.srcSpanEndCol forall a b. (a -> b) -> a -> b
$ forall a. Alignable a -> a
aLeft Alignable RealSrcSpan
a
          (String
pre, String
post) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
column String
str
      in [Int -> ShowS
padRight Int
longestLeft (ShowS
trimRight String
pre) 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 GHC.RealSrcSpan] -> Bool
fixable :: [Alignable RealSrcSpan] -> Bool
fixable []     = Bool
False
fixable [Alignable RealSrcSpan
_]    = Bool
False
fixable [Alignable RealSrcSpan]
fields = 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        = forall a b. (a -> b) -> [a] -> [b]
map forall a. Alignable a -> a
aContainer [Alignable RealSrcSpan]
fields
    singleLine :: RealSrcSpan -> Bool
singleLine RealSrcSpan
s      = RealSrcSpan -> Int
GHC.srcSpanStartLine RealSrcSpan
s forall a. Eq a => a -> a -> Bool
== RealSrcSpan -> Int
GHC.srcSpanEndLine RealSrcSpan
s
    nonOverlapping :: [RealSrcSpan] -> Bool
nonOverlapping [RealSrcSpan]
ss = forall (t :: * -> *) a. Foldable t => t a -> Int
length [RealSrcSpan]
ss forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map RealSrcSpan -> Int
GHC.srcSpanStartLine [RealSrcSpan]
ss)