--------------------------------------------------------------------------------
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
forall a. Block a -> Block a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: 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
Eq, Block a -> Block a -> Bool
Block a -> Block a -> Ordering
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
min :: Block a -> Block a -> Block a
$cmin :: forall a. Block a -> Block a -> Block a
max :: Block a -> Block a -> Block a
$cmax :: forall a. Block a -> Block a -> Block a
>= :: 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
$c< :: forall a. Block a -> Block a -> Bool
compare :: Block a -> Block a -> Ordering
$ccompare :: forall a. Block a -> Block a -> Ordering
Ord, Int -> Block a -> ShowS
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
showList :: [Block a] -> ShowS
$cshowList :: forall a. [Block a] -> ShowS
show :: Block a -> String
$cshow :: forall a. Block a -> String
showsPrec :: Int -> Block a -> ShowS
$cshowsPrec :: forall a. Int -> Block a -> ShowS
Show)


--------------------------------------------------------------------------------
instance Semigroup (Block a) where
    <> :: 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 = 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 forall a. Num a => a -> a -> a
- Int
start 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) = forall a. Int -> Int -> Block a
Block (Int
start forall a. Num a => a -> a -> a
+ Int
offset) (Int
end 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 = forall {a} {a}. Block a -> Block a -> Bool
follows Block a
b1 Block a
b2 Bool -> Bool -> 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 forall a. Eq a => a -> a -> Bool
== Int
s2 Bool -> Bool -> Bool
|| Int
e1 forall a. Num a => a -> a -> a
+ Int
1 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) = forall a. Int -> Int -> Block a
Block (forall a. Ord a => a -> a -> a
min Int
s1 Int
s2) (forall a. Ord a => a -> a -> a
max Int
e1 Int
e2)


--------------------------------------------------------------------------------
overlapping :: [Block a] -> Bool
overlapping :: forall a. [Block a] -> Bool
overlapping = 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 = [forall a. Block a -> Int
blockStart Block a
b .. forall a. Block a -> Int
blockEnd Block a
b] in
        if 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 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 = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr 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 forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Block a -> Block a -> Bool
adjacent Block a
b1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Block a, [a])]
gs of
        ([(Block a, [a])]
_, [])               -> (Block a
b1, [a
x]) forall a. a -> [a] -> [a]
: [(Block a, [a])]
gs
        ([(Block a, [a])]
ys, ((Block a
b2, [a]
xs) : [(Block a, [a])]
zs)) -> (forall a. Block a -> Block a -> Block a
merge Block a
b1 Block a
b2, a
x forall a. a -> [a] -> [a]
: [a]
xs) forall a. a -> [a] -> [a]
: ([(Block a, [a])]
ys 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 forall a. Block a -> Block a -> Bool
`adjacent` Block a
b = forall a. Block a -> Block a -> Block a
merge Block a
a Block a
b forall a. a -> [a] -> [a]
: forall a. [Block a] -> [Block a]
mergeAdjacent [Block a]
rest
mergeAdjacent (Block a
a : [Block a]
rest)     = Block a
a forall a. a -> [a] -> [a]
: forall a. [Block a] -> [Block a]
mergeAdjacent [Block a]
rest
mergeAdjacent []             = []