{-# LANGUAGE OverloadedStrings #-}

module HieDb.Html
    ( Color (..)
    , Span (..)
    , generate
    ) where

import           Control.Monad (forM_)
import           Data.Function (on)
import           Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import           Data.List (foldl', sortBy)
import           Data.Text   (Text)
import qualified Data.Text as T
import           Lucid

import           HieDb.Compat

generate :: FilePath -> ModuleName -> [Text] -> [Span] -> IO ()
generate :: String -> ModuleName -> [Text] -> [Span] -> IO ()
generate String
fp ModuleName
mn [Text]
ts [Span]
sps = String -> HtmlT Identity () -> IO ()
forall a. String -> Html a -> IO ()
renderToFile String
fp (HtmlT Identity () -> IO ()) -> HtmlT Identity () -> IO ()
forall a b. (a -> b) -> a -> b
$ HtmlT Identity () -> HtmlT Identity ()
forall (m :: * -> *) a. Applicative m => HtmlT m a -> HtmlT m a
doctypehtml_ (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ do
    HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
head_ (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
title_ (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ String -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => String -> HtmlT m ()
toHtml (String -> HtmlT Identity ()) -> String -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ ModuleName -> String
moduleNameString ModuleName
mn
    HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
body_ (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$
        [(Int, Text, [LineSpan])]
-> ((Int, Text, [LineSpan]) -> HtmlT Identity ())
-> HtmlT Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Text] -> [Span] -> [(Int, Text, [LineSpan])]
layout [Text]
ts [Span]
sps) (Int, Text, [LineSpan]) -> HtmlT Identity ()
generateLine'
  where
    generateLine' :: (Int, Text, [LineSpan]) -> Html ()
    generateLine' :: (Int, Text, [LineSpan]) -> HtmlT Identity ()
generateLine' (Int
i, Text
t, [LineSpan]
lsps) = [Attribute] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
pre_ [Text -> Attribute
forall arg result. TermRaw arg result => arg -> result
style_ Text
"margin:0em;font-size:large"] (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ do
        [Attribute] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
span_ [Text -> Attribute
forall arg result. TermRaw arg result => arg -> result
style_ Text
"background-color:lightcyan;padding-right:1em"] (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ Int -> HtmlT Identity ()
padLineNumber Int
i
        Int -> Text -> [LineSpan] -> HtmlT Identity ()
go Int
1 Text
t [LineSpan]
lsps

    go :: Int -> Text -> [LineSpan] -> Html ()
    go :: Int -> Text -> [LineSpan] -> HtmlT Identity ()
go Int
_   Text
t [] = Text -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => Text -> HtmlT m ()
toHtml Text
t
    go Int
col Text
t lsps :: [LineSpan]
lsps@(LineSpan
lsp : [LineSpan]
lsps')
        | Int
col Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< LineSpan -> Int
lspStartColumn LineSpan
lsp = do
            let (Text
t1, Text
t2) = Int -> Text -> (Text, Text)
T.splitAt (LineSpan -> Int
lspStartColumn LineSpan
lsp Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
col) Text
t
            Text -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => Text -> HtmlT m ()
toHtml Text
t1
            Int -> Text -> [LineSpan] -> HtmlT Identity ()
go (LineSpan -> Int
lspStartColumn LineSpan
lsp) Text
t2 [LineSpan]
lsps
        | Bool
otherwise = do
            let l :: Int
l        = LineSpan -> Int
lspEndColumn LineSpan
lsp Int -> Int -> Int
forall a. Num a => a -> a -> a
- LineSpan -> Int
lspStartColumn LineSpan
lsp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                (Text
t1, Text
t2) = Int -> Text -> (Text, Text)
T.splitAt Int
l Text
t
            [Attribute] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
span_ [LineSpan -> Attribute
lineSpanAttribute LineSpan
lsp] (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ Text -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => Text -> HtmlT m ()
toHtml Text
t1
            Int -> Text -> [LineSpan] -> HtmlT Identity ()
go (LineSpan -> Int
lspEndColumn LineSpan
lsp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
t2 [LineSpan]
lsps'

padLineNumber :: Int -> Html ()
padLineNumber :: Int -> HtmlT Identity ()
padLineNumber Int
n = let s :: String
s = Int -> String
forall a. Show a => a -> String
show Int
n in String -> Int -> HtmlT Identity ()
forall {t} {m :: * -> *}.
(Ord t, Num t, Monad m) =>
String -> t -> HtmlT m ()
go String
s (Int -> HtmlT Identity ()) -> Int -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s
  where
    go :: String -> t -> HtmlT m ()
go String
s t
l
        | t
l t -> t -> Bool
forall a. Ord a => a -> a -> Bool
>= t
6    = String -> HtmlT m ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => String -> HtmlT m ()
toHtml String
s
        | Bool
otherwise = String -> t -> HtmlT m ()
go (Char
' ' Char -> String -> String
forall a. a -> [a] -> [a]
: String
s) (t
l t -> t -> t
forall a. Num a => a -> a -> a
+ t
1)

data Color = Reachable | Unreachable deriving (Int -> Color -> String -> String
[Color] -> String -> String
Color -> String
(Int -> Color -> String -> String)
-> (Color -> String) -> ([Color] -> String -> String) -> Show Color
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Color -> String -> String
showsPrec :: Int -> Color -> String -> String
$cshow :: Color -> String
show :: Color -> String
$cshowList :: [Color] -> String -> String
showList :: [Color] -> String -> String
Show, ReadPrec [Color]
ReadPrec Color
Int -> ReadS Color
ReadS [Color]
(Int -> ReadS Color)
-> ReadS [Color]
-> ReadPrec Color
-> ReadPrec [Color]
-> Read Color
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Color
readsPrec :: Int -> ReadS Color
$creadList :: ReadS [Color]
readList :: ReadS [Color]
$creadPrec :: ReadPrec Color
readPrec :: ReadPrec Color
$creadListPrec :: ReadPrec [Color]
readListPrec :: ReadPrec [Color]
Read, Color -> Color -> Bool
(Color -> Color -> Bool) -> (Color -> Color -> Bool) -> Eq Color
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Color -> Color -> Bool
== :: Color -> Color -> Bool
$c/= :: Color -> Color -> Bool
/= :: Color -> Color -> Bool
Eq, Eq Color
Eq Color =>
(Color -> Color -> Ordering)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Color)
-> (Color -> Color -> Color)
-> Ord Color
Color -> Color -> Bool
Color -> Color -> Ordering
Color -> Color -> Color
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
$ccompare :: Color -> Color -> Ordering
compare :: Color -> Color -> Ordering
$c< :: Color -> Color -> Bool
< :: Color -> Color -> Bool
$c<= :: Color -> Color -> Bool
<= :: Color -> Color -> Bool
$c> :: Color -> Color -> Bool
> :: Color -> Color -> Bool
$c>= :: Color -> Color -> Bool
>= :: Color -> Color -> Bool
$cmax :: Color -> Color -> Color
max :: Color -> Color -> Color
$cmin :: Color -> Color -> Color
min :: Color -> Color -> Color
Ord)

data Span = Span
    { Span -> Int
spStartLine   :: !Int
    , Span -> Int
spStartColumn :: !Int
    , Span -> Int
spEndLine     :: !Int
    , Span -> Int
spEndColumn   :: !Int
    , Span -> Color
spColor       :: !Color
    } deriving (Int -> Span -> String -> String
[Span] -> String -> String
Span -> String
(Int -> Span -> String -> String)
-> (Span -> String) -> ([Span] -> String -> String) -> Show Span
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Span -> String -> String
showsPrec :: Int -> Span -> String -> String
$cshow :: Span -> String
show :: Span -> String
$cshowList :: [Span] -> String -> String
showList :: [Span] -> String -> String
Show, ReadPrec [Span]
ReadPrec Span
Int -> ReadS Span
ReadS [Span]
(Int -> ReadS Span)
-> ReadS [Span] -> ReadPrec Span -> ReadPrec [Span] -> Read Span
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Span
readsPrec :: Int -> ReadS Span
$creadList :: ReadS [Span]
readList :: ReadS [Span]
$creadPrec :: ReadPrec Span
readPrec :: ReadPrec Span
$creadListPrec :: ReadPrec [Span]
readListPrec :: ReadPrec [Span]
Read, Span -> Span -> Bool
(Span -> Span -> Bool) -> (Span -> Span -> Bool) -> Eq Span
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Span -> Span -> Bool
== :: Span -> Span -> Bool
$c/= :: Span -> Span -> Bool
/= :: Span -> Span -> Bool
Eq, Eq Span
Eq Span =>
(Span -> Span -> Ordering)
-> (Span -> Span -> Bool)
-> (Span -> Span -> Bool)
-> (Span -> Span -> Bool)
-> (Span -> Span -> Bool)
-> (Span -> Span -> Span)
-> (Span -> Span -> Span)
-> Ord Span
Span -> Span -> Bool
Span -> Span -> Ordering
Span -> Span -> Span
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
$ccompare :: Span -> Span -> Ordering
compare :: Span -> Span -> Ordering
$c< :: Span -> Span -> Bool
< :: Span -> Span -> Bool
$c<= :: Span -> Span -> Bool
<= :: Span -> Span -> Bool
$c> :: Span -> Span -> Bool
> :: Span -> Span -> Bool
$c>= :: Span -> Span -> Bool
>= :: Span -> Span -> Bool
$cmax :: Span -> Span -> Span
max :: Span -> Span -> Span
$cmin :: Span -> Span -> Span
min :: Span -> Span -> Span
Ord)

data LineSpan = LineSpan
    { LineSpan -> Int
lspLine        :: !Int
    , LineSpan -> Int
lspStartColumn :: !Int
    , LineSpan -> Int
lspEndColumn   :: !Int
    , LineSpan -> Color
lspColor       :: !Color
    } deriving (Int -> LineSpan -> String -> String
[LineSpan] -> String -> String
LineSpan -> String
(Int -> LineSpan -> String -> String)
-> (LineSpan -> String)
-> ([LineSpan] -> String -> String)
-> Show LineSpan
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> LineSpan -> String -> String
showsPrec :: Int -> LineSpan -> String -> String
$cshow :: LineSpan -> String
show :: LineSpan -> String
$cshowList :: [LineSpan] -> String -> String
showList :: [LineSpan] -> String -> String
Show, ReadPrec [LineSpan]
ReadPrec LineSpan
Int -> ReadS LineSpan
ReadS [LineSpan]
(Int -> ReadS LineSpan)
-> ReadS [LineSpan]
-> ReadPrec LineSpan
-> ReadPrec [LineSpan]
-> Read LineSpan
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS LineSpan
readsPrec :: Int -> ReadS LineSpan
$creadList :: ReadS [LineSpan]
readList :: ReadS [LineSpan]
$creadPrec :: ReadPrec LineSpan
readPrec :: ReadPrec LineSpan
$creadListPrec :: ReadPrec [LineSpan]
readListPrec :: ReadPrec [LineSpan]
Read, LineSpan -> LineSpan -> Bool
(LineSpan -> LineSpan -> Bool)
-> (LineSpan -> LineSpan -> Bool) -> Eq LineSpan
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LineSpan -> LineSpan -> Bool
== :: LineSpan -> LineSpan -> Bool
$c/= :: LineSpan -> LineSpan -> Bool
/= :: LineSpan -> LineSpan -> Bool
Eq, Eq LineSpan
Eq LineSpan =>
(LineSpan -> LineSpan -> Ordering)
-> (LineSpan -> LineSpan -> Bool)
-> (LineSpan -> LineSpan -> Bool)
-> (LineSpan -> LineSpan -> Bool)
-> (LineSpan -> LineSpan -> Bool)
-> (LineSpan -> LineSpan -> LineSpan)
-> (LineSpan -> LineSpan -> LineSpan)
-> Ord LineSpan
LineSpan -> LineSpan -> Bool
LineSpan -> LineSpan -> Ordering
LineSpan -> LineSpan -> LineSpan
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
$ccompare :: LineSpan -> LineSpan -> Ordering
compare :: LineSpan -> LineSpan -> Ordering
$c< :: LineSpan -> LineSpan -> Bool
< :: LineSpan -> LineSpan -> Bool
$c<= :: LineSpan -> LineSpan -> Bool
<= :: LineSpan -> LineSpan -> Bool
$c> :: LineSpan -> LineSpan -> Bool
> :: LineSpan -> LineSpan -> Bool
$c>= :: LineSpan -> LineSpan -> Bool
>= :: LineSpan -> LineSpan -> Bool
$cmax :: LineSpan -> LineSpan -> LineSpan
max :: LineSpan -> LineSpan -> LineSpan
$cmin :: LineSpan -> LineSpan -> LineSpan
min :: LineSpan -> LineSpan -> LineSpan
Ord)

lineSpanAttribute :: LineSpan -> Attribute
lineSpanAttribute :: LineSpan -> Attribute
lineSpanAttribute LineSpan
lsp =
    let color :: Text
color = case LineSpan -> Color
lspColor LineSpan
lsp of
            Color
Reachable   -> Text
"lightgreen"
            Color
Unreachable -> Text
"yellow"
    in  Text -> Attribute
forall arg result. TermRaw arg result => arg -> result
style_ (Text -> Attribute) -> Text -> Attribute
forall a b. (a -> b) -> a -> b
$ Text
"background-color:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
color

lineSpans :: (Int -> Int) -> Span -> [LineSpan]
lineSpans :: (Int -> Int) -> Span -> [LineSpan]
lineSpans Int -> Int
cols Span
sp
    | Span -> Int
spStartLine Span
sp Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Span -> Int
spEndLine Span
sp = LineSpan -> [LineSpan]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return LineSpan
        { lspLine :: Int
lspLine        = Span -> Int
spStartLine Span
sp
        , lspStartColumn :: Int
lspStartColumn = Span -> Int
spStartColumn Span
sp
        , lspEndColumn :: Int
lspEndColumn   = Span -> Int
spEndColumn Span
sp
        , lspColor :: Color
lspColor       = Span -> Color
spColor Span
sp
        }
    | Bool
otherwise =
        let lsp1 :: LineSpan
lsp1  = LineSpan
                        { lspLine :: Int
lspLine        = Span -> Int
spStartLine Span
sp
                        , lspStartColumn :: Int
lspStartColumn = Span -> Int
spStartColumn Span
sp
                        , lspEndColumn :: Int
lspEndColumn   = Int -> Int
cols (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Span -> Int
spStartLine Span
sp
                        , lspColor :: Color
lspColor       = Span -> Color
spColor Span
sp
                        }
            lsp :: Int -> LineSpan
lsp Int
i = LineSpan
                        { lspLine :: Int
lspLine        = Int
i
                        , lspStartColumn :: Int
lspStartColumn = Int
1
                        , lspEndColumn :: Int
lspEndColumn   = Int -> Int
cols Int
i
                        , lspColor :: Color
lspColor       = Span -> Color
spColor Span
sp
                        }
            lsp2 :: LineSpan
lsp2  = LineSpan
                        { lspLine :: Int
lspLine        = Span -> Int
spEndLine Span
sp
                        , lspStartColumn :: Int
lspStartColumn = Int
1
                        , lspEndColumn :: Int
lspEndColumn   = Span -> Int
spEndColumn Span
sp
                        , lspColor :: Color
lspColor       = Span -> Color
spColor Span
sp
                        }
        in  LineSpan
lsp1 LineSpan -> [LineSpan] -> [LineSpan]
forall a. a -> [a] -> [a]
: [Int -> LineSpan
lsp Int
i | Int
i <- [Span -> Int
spStartLine Span
sp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 .. Span -> Int
spEndLine Span
sp Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]] [LineSpan] -> [LineSpan] -> [LineSpan]
forall a. [a] -> [a] -> [a]
++ [LineSpan
lsp2]

layout :: [Text] -> [Span] -> [(Int, Text, [LineSpan])]
layout :: [Text] -> [Span] -> [(Int, Text, [LineSpan])]
layout [Text]
ts [Span]
ss =
    let m1 :: IntMap (Text, Int, [a])
m1 = [(Int, (Text, Int, [a]))] -> IntMap (Text, Int, [a])
forall a. [(Int, a)] -> IntMap a
IM.fromList [(Int
i, (Text
t, Text -> Int
T.length Text
t, [])) | (Int
i, Text
t) <- [Int] -> [Text] -> [(Int, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [Text]
ts]
        m2 :: IntMap (Text, Int, [LineSpan])
m2 = (IntMap (Text, Int, [LineSpan])
 -> Span -> IntMap (Text, Int, [LineSpan]))
-> IntMap (Text, Int, [LineSpan])
-> [Span]
-> IntMap (Text, Int, [LineSpan])
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' IntMap (Text, Int, [LineSpan])
-> Span -> IntMap (Text, Int, [LineSpan])
f IntMap (Text, Int, [LineSpan])
forall {a}. IntMap (Text, Int, [a])
m1 [Span]
ss :: IntMap (Text, Int, [LineSpan])
    in  [(Int
i, Text
t, [LineSpan]
lsps) | (Int
i, (Text
t, [LineSpan]
lsps)) <- IntMap (Text, [LineSpan]) -> [(Int, (Text, [LineSpan]))]
forall a. IntMap a -> [(Int, a)]
IM.toList (IntMap (Text, [LineSpan]) -> [(Int, (Text, [LineSpan]))])
-> IntMap (Text, [LineSpan]) -> [(Int, (Text, [LineSpan]))]
forall a b. (a -> b) -> a -> b
$ (Text, Int, [LineSpan]) -> (Text, [LineSpan])
j ((Text, Int, [LineSpan]) -> (Text, [LineSpan]))
-> IntMap (Text, Int, [LineSpan]) -> IntMap (Text, [LineSpan])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IntMap (Text, Int, [LineSpan])
m2]
  where
    f :: IntMap (Text, Int, [LineSpan]) -> Span -> IntMap (Text, Int, [LineSpan])
    f :: IntMap (Text, Int, [LineSpan])
-> Span -> IntMap (Text, Int, [LineSpan])
f IntMap (Text, Int, [LineSpan])
m = (IntMap (Text, Int, [LineSpan])
 -> LineSpan -> IntMap (Text, Int, [LineSpan]))
-> IntMap (Text, Int, [LineSpan])
-> [LineSpan]
-> IntMap (Text, Int, [LineSpan])
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' IntMap (Text, Int, [LineSpan])
-> LineSpan -> IntMap (Text, Int, [LineSpan])
g IntMap (Text, Int, [LineSpan])
m ([LineSpan] -> IntMap (Text, Int, [LineSpan]))
-> (Span -> [LineSpan]) -> Span -> IntMap (Text, Int, [LineSpan])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int) -> Span -> [LineSpan]
lineSpans Int -> Int
lookup'
      where lookup' :: Int -> Int
lookup' Int
i = case Int
-> IntMap (Text, Int, [LineSpan]) -> Maybe (Text, Int, [LineSpan])
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
i IntMap (Text, Int, [LineSpan])
m of
                Maybe (Text, Int, [LineSpan])
Nothing        -> Int
0
                Just (Text
_, Int
l, [LineSpan]
_) -> Int
l

    g :: IntMap (Text, Int, [LineSpan]) -> LineSpan -> IntMap (Text, Int, [LineSpan])
    g :: IntMap (Text, Int, [LineSpan])
-> LineSpan -> IntMap (Text, Int, [LineSpan])
g IntMap (Text, Int, [LineSpan])
m LineSpan
lsp = ((Text, Int, [LineSpan]) -> (Text, Int, [LineSpan]))
-> Int
-> IntMap (Text, Int, [LineSpan])
-> IntMap (Text, Int, [LineSpan])
forall a. (a -> a) -> Int -> IntMap a -> IntMap a
IM.adjust (LineSpan -> (Text, Int, [LineSpan]) -> (Text, Int, [LineSpan])
h LineSpan
lsp) (LineSpan -> Int
lspLine LineSpan
lsp) IntMap (Text, Int, [LineSpan])
m

    h :: LineSpan -> (Text, Int, [LineSpan]) -> (Text, Int, [LineSpan])
    h :: LineSpan -> (Text, Int, [LineSpan]) -> (Text, Int, [LineSpan])
h LineSpan
lsp (Text
t, Int
l, [LineSpan]
lsps) = (Text
t, Int
l, LineSpan
lsp LineSpan -> [LineSpan] -> [LineSpan]
forall a. a -> [a] -> [a]
: [LineSpan]
lsps)

    j :: (Text, Int, [LineSpan]) -> (Text, [LineSpan])
    j :: (Text, Int, [LineSpan]) -> (Text, [LineSpan])
j (Text
t, Int
_, [LineSpan]
lsps) = (Text
t, (LineSpan -> LineSpan -> Ordering) -> [LineSpan] -> [LineSpan]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Int -> Ordering)
-> (LineSpan -> Int) -> LineSpan -> LineSpan -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` LineSpan -> Int
lspStartColumn) [LineSpan]
lsps)