--------------------------------------------------------------------------------
module Language.Haskell.Stylish.Block
    ( Block (..)
    , LineBlock
    , realSrcSpanToLineBlock
    , SpanBlock
    , blockLength
    , moveBlock
    , adjacent
    , merge
    , mergeAdjacent
    , overlapping
    , groupAdjacent
    ) where


--------------------------------------------------------------------------------
import qualified Data.IntSet      as IS
import qualified GHC.Types.SrcLoc as GHC


--------------------------------------------------------------------------------
-- | Indicates a line span
data Block a = Block
    { forall a. Block a -> Int
blockStart :: Int
    , forall a. Block a -> Int
blockEnd   :: Int
    } deriving (Block a -> Block a -> Bool
(Block a -> Block a -> Bool)
-> (Block a -> Block a -> Bool) -> Eq (Block a)
forall a. Block a -> Block a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Block a -> Block a -> Bool
== :: Block a -> Block a -> Bool
$c/= :: forall a. Block a -> Block a -> Bool
/= :: Block a -> Block a -> Bool
Eq, Eq (Block a)
Eq (Block a) =>
(Block a -> Block a -> Ordering)
-> (Block a -> Block a -> Bool)
-> (Block a -> Block a -> Bool)
-> (Block a -> Block a -> Bool)
-> (Block a -> Block a -> Bool)
-> (Block a -> Block a -> Block a)
-> (Block a -> Block a -> Block a)
-> Ord (Block a)
Block a -> Block a -> Bool
Block a -> Block a -> Ordering
Block a -> Block a -> Block a
forall a. Eq (Block a)
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Block a -> Block a -> Bool
forall a. Block a -> Block a -> Ordering
forall a. Block a -> Block a -> Block a
$ccompare :: forall a. Block a -> Block a -> Ordering
compare :: Block a -> Block a -> Ordering
$c< :: forall a. Block a -> Block a -> Bool
< :: Block a -> Block a -> Bool
$c<= :: forall a. Block a -> Block a -> Bool
<= :: Block a -> Block a -> Bool
$c> :: forall a. Block a -> Block a -> Bool
> :: Block a -> Block a -> Bool
$c>= :: forall a. Block a -> Block a -> Bool
>= :: Block a -> Block a -> Bool
$cmax :: forall a. Block a -> Block a -> Block a
max :: Block a -> Block a -> Block a
$cmin :: forall a. Block a -> Block a -> Block a
min :: Block a -> Block a -> Block a
Ord, Int -> Block a -> ShowS
[Block a] -> ShowS
Block a -> String
(Int -> Block a -> ShowS)
-> (Block a -> String) -> ([Block a] -> ShowS) -> Show (Block a)
forall a. Int -> Block a -> ShowS
forall a. [Block a] -> ShowS
forall a. Block a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> Block a -> ShowS
showsPrec :: Int -> Block a -> ShowS
$cshow :: forall a. Block a -> String
show :: Block a -> String
$cshowList :: forall a. [Block a] -> ShowS
showList :: [Block a] -> ShowS
Show)


--------------------------------------------------------------------------------
instance Semigroup (Block a) where
    <> :: Block a -> Block a -> Block a
(<>) = Block a -> Block a -> Block a
forall a. Block a -> Block a -> Block a
merge


--------------------------------------------------------------------------------
type LineBlock = Block String


--------------------------------------------------------------------------------
type SpanBlock = Block Char


--------------------------------------------------------------------------------
realSrcSpanToLineBlock :: GHC.RealSrcSpan -> Block String
realSrcSpanToLineBlock :: RealSrcSpan -> Block String
realSrcSpanToLineBlock RealSrcSpan
s = Int -> Int -> Block String
forall a. Int -> Int -> Block a
Block (RealSrcSpan -> Int
GHC.srcSpanStartLine RealSrcSpan
s) (RealSrcSpan -> Int
GHC.srcSpanEndLine RealSrcSpan
s)


--------------------------------------------------------------------------------
blockLength :: Block a -> Int
blockLength :: forall a. Block a -> Int
blockLength (Block Int
start Int
end) = Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1


--------------------------------------------------------------------------------
moveBlock :: Int -> Block a -> Block a
moveBlock :: forall a. Int -> Block a -> Block a
moveBlock Int
offset (Block Int
start Int
end) = Int -> Int -> Block a
forall a. Int -> Int -> Block a
Block (Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset) (Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset)


--------------------------------------------------------------------------------
adjacent :: Block a -> Block a -> Bool
adjacent :: forall a. Block a -> Block a -> Bool
adjacent Block a
b1 Block a
b2 = Block a -> Block a -> Bool
forall {a} {a}. Block a -> Block a -> Bool
follows Block a
b1 Block a
b2 Bool -> Bool -> Bool
|| Block a -> Block a -> Bool
forall {a} {a}. Block a -> Block a -> Bool
follows Block a
b2 Block a
b1
  where
    follows :: Block a -> Block a -> Bool
follows (Block Int
_ Int
e1) (Block Int
s2 Int
_) = Int
e1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
s2 Bool -> Bool -> Bool
|| Int
e1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
s2


--------------------------------------------------------------------------------
merge :: Block a -> Block a -> Block a
merge :: forall a. Block a -> Block a -> Block a
merge (Block Int
s1 Int
e1) (Block Int
s2 Int
e2) = Int -> Int -> Block a
forall a. Int -> Int -> Block a
Block (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
s1 Int
s2) (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
e1 Int
e2)


--------------------------------------------------------------------------------
overlapping :: [Block a] -> Bool
overlapping :: forall a. [Block a] -> Bool
overlapping = IntSet -> [Block a] -> Bool
forall {a}. IntSet -> [Block a] -> Bool
go IntSet
IS.empty
  where
    go :: IntSet -> [Block a] -> Bool
go IntSet
_   []       = Bool
False
    go IntSet
acc (Block a
b : [Block a]
bs) =
        let ints :: [Int]
ints = [Block a -> Int
forall a. Block a -> Int
blockStart Block a
b .. Block a -> Int
forall a. Block a -> Int
blockEnd Block a
b] in
        if (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Int -> IntSet -> Bool
`IS.member` IntSet
acc) [Int]
ints
            then Bool
True
            else IntSet -> [Block a] -> Bool
go (IntSet -> IntSet -> IntSet
IS.union IntSet
acc (IntSet -> IntSet) -> IntSet -> IntSet
forall a b. (a -> b) -> a -> b
$ [Int] -> IntSet
IS.fromList [Int]
ints) [Block a]
bs


--------------------------------------------------------------------------------
-- | Groups adjacent blocks into larger blocks
groupAdjacent :: [(Block a, b)]
              -> [(Block a, [b])]
groupAdjacent :: forall a b. [(Block a, b)] -> [(Block a, [b])]
groupAdjacent = ((Block a, b) -> [(Block a, [b])] -> [(Block a, [b])])
-> [(Block a, [b])] -> [(Block a, b)] -> [(Block a, [b])]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Block a, b) -> [(Block a, [b])] -> [(Block a, [b])]
forall {a} {a}.
(Block a, a) -> [(Block a, [a])] -> [(Block a, [a])]
go []
  where
    -- This code is ugly and not optimal, and no fucks were given.
    go :: (Block a, a) -> [(Block a, [a])] -> [(Block a, [a])]
go (Block a
b1, a
x) [(Block a, [a])]
gs = case ((Block a, [a]) -> Bool)
-> [(Block a, [a])] -> ([(Block a, [a])], [(Block a, [a])])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Block a -> Block a -> Bool
forall a. Block a -> Block a -> Bool
adjacent Block a
b1 (Block a -> Bool)
-> ((Block a, [a]) -> Block a) -> (Block a, [a]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Block a, [a]) -> Block a
forall a b. (a, b) -> a
fst) [(Block a, [a])]
gs of
        ([(Block a, [a])]
_, [])               -> (Block a
b1, [a
x]) (Block a, [a]) -> [(Block a, [a])] -> [(Block a, [a])]
forall a. a -> [a] -> [a]
: [(Block a, [a])]
gs
        ([(Block a, [a])]
ys, ((Block a
b2, [a]
xs) : [(Block a, [a])]
zs)) -> (Block a -> Block a -> Block a
forall a. Block a -> Block a -> Block a
merge Block a
b1 Block a
b2, a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs) (Block a, [a]) -> [(Block a, [a])] -> [(Block a, [a])]
forall a. a -> [a] -> [a]
: ([(Block a, [a])]
ys [(Block a, [a])] -> [(Block a, [a])] -> [(Block a, [a])]
forall a. [a] -> [a] -> [a]
++ [(Block a, [a])]
zs)

mergeAdjacent :: [Block a] -> [Block a]
mergeAdjacent :: forall a. [Block a] -> [Block a]
mergeAdjacent (Block a
a : Block a
b : [Block a]
rest) | Block a
a Block a -> Block a -> Bool
forall a. Block a -> Block a -> Bool
`adjacent` Block a
b = Block a -> Block a -> Block a
forall a. Block a -> Block a -> Block a
merge Block a
a Block a
b Block a -> [Block a] -> [Block a]
forall a. a -> [a] -> [a]
: [Block a] -> [Block a]
forall a. [Block a] -> [Block a]
mergeAdjacent [Block a]
rest
mergeAdjacent (Block a
a : [Block a]
rest)     = Block a
a Block a -> [Block a] -> [Block a]
forall a. a -> [a] -> [a]
: [Block a] -> [Block a]
forall a. [Block a] -> [Block a]
mergeAdjacent [Block a]
rest
mergeAdjacent []             = []