summaryrefslogtreecommitdiffhomepage
path: root/lib/Language/Haskell/Stylish/Align.hs
blob: 1f28d7a51177ad739c1df0db55749ebfd49ecd2a (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
--------------------------------------------------------------------------------
-- | This module is useful for aligning things.
module Language.Haskell.Stylish.Align
    ( Alignable (..)
    , align
    ) where


--------------------------------------------------------------------------------
import           Data.List                       (nub)
import qualified Language.Haskell.Exts           as H


--------------------------------------------------------------------------------
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
    { aContainer :: !a
    , aLeft      :: !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.
    , aRightLead :: !Int
    } deriving (Show)


--------------------------------------------------------------------------------
-- | Create changes that perform the alignment.
align
    :: Maybe Int              -- ^ Max columns
    -> [Alignable H.SrcSpan]  -- ^ Alignables
    -> [Change String]        -- ^ Changes performing the alignment.
align _ [] = []
align maxColumns alignment
    -- Do not make any change if we would go past the maximum number of columns.
    | exceedsColumns (longestLeft + longestRight) = []
    | not (fixable alignment)                     = []
    | otherwise                                   = map align' alignment
  where
    exceedsColumns i = case maxColumns of
        Nothing -> False  -- No number exceeds a maximum column count of
                          -- Nothing, because there is no limit to exceed.
        Just c -> i > c

    -- The longest thing in the left column.
    longestLeft = maximum $ map (H.srcSpanEndColumn . aLeft) alignment

    -- The longest thing in the right column.
    longestRight = maximum
        [ H.srcSpanEndColumn (aRight a) - H.srcSpanStartColumn (aRight a)
            + aRightLead a
        | a <- alignment
        ]

    align' a = changeLine (H.srcSpanStartLine $ aContainer a) $ \str ->
        let column      = H.srcSpanEndColumn $ aLeft a
            (pre, post) = splitAt column str
        in [padRight longestLeft (trimRight pre) ++ trimLeft post]


--------------------------------------------------------------------------------
-- | Checks that all the alignables appear on a single line, and that they do
-- not overlap.
fixable :: [Alignable H.SrcSpan] -> Bool
fixable []     = False
fixable [_]    = False
fixable fields = all singleLine containers && nonOverlapping containers
  where
    containers        = map aContainer fields
    singleLine s      = H.srcSpanStartLine s == H.srcSpanEndLine s
    nonOverlapping ss = length ss == length (nub $ map H.srcSpanStartLine ss)