{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
module Text.GridTable.Trace
( traceLines
, TraceInfo (..)
, initialTraceInfo
, tableFromTraceInfo
) where
import Prelude hiding (lines)
import Control.Applicative ((<|>))
import Control.Monad (forM_)
import Control.Monad.ST
import Data.Array
import Data.Array.MArray
import Data.Array.ST
import Data.Function (on)
import Data.List (foldl')
import Data.Maybe (fromMaybe)
import Data.Set (Set)
import Data.Text (Text)
import Text.DocLayout (charWidth)
import Text.GridTable.ArrayTable
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified Data.Text as T
traceLines :: [Text] -> Maybe (ArrayTable [Text])
traceLines :: [Text] -> Maybe (ArrayTable [Text])
traceLines [Text]
lines =
let charGrid :: CharGrid
charGrid = [Text] -> CharGrid
toCharGrid [Text]
lines
specs1 :: Maybe [ColSpec]
specs1 = Char -> CharGrid -> CharRow -> Maybe [ColSpec]
colSpecsInLine Char
'-' CharGrid
charGrid CharRow
1
partSeps :: [PartSeparator]
partSeps = CharGrid -> [PartSeparator]
findSeparators CharGrid
charGrid
charGrid' :: CharGrid
charGrid' = [CharRow] -> CharGrid -> CharGrid
convertToNormalLines (CharRow
1forall a. a -> [a] -> [a]
:forall a b. (a -> b) -> [a] -> [b]
map PartSeparator -> CharRow
partSepLine [PartSeparator]
partSeps) CharGrid
charGrid
traceInfo :: TraceInfo
traceInfo = CharGrid -> TraceInfo -> TraceInfo
traceCharGrid CharGrid
charGrid' TraceInfo
initialTraceInfo
in if forall a. Set a -> Bool
Set.null (TraceInfo -> Set CellTrace
gridCells TraceInfo
traceInfo)
then forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"no cells"
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TraceInfo
-> [PartSeparator] -> Maybe [ColSpec] -> ArrayTable [Text]
tableFromTraceInfo TraceInfo
traceInfo [PartSeparator]
partSeps Maybe [ColSpec]
specs1
type CharGrid = Array (CharRow, CharCol) GChar
type CharIndex = (CharRow, CharCol)
newtype CharRow = CharRow Int
deriving stock (CharRow -> CharRow -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CharRow -> CharRow -> Bool
$c/= :: CharRow -> CharRow -> Bool
== :: CharRow -> CharRow -> Bool
$c== :: CharRow -> CharRow -> Bool
Eq, Int -> CharRow -> ShowS
[CharRow] -> ShowS
CharRow -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CharRow] -> ShowS
$cshowList :: [CharRow] -> ShowS
show :: CharRow -> String
$cshow :: CharRow -> String
showsPrec :: Int -> CharRow -> ShowS
$cshowsPrec :: Int -> CharRow -> ShowS
Show)
deriving newtype (Int -> CharRow
CharRow -> Int
CharRow -> [CharRow]
CharRow -> CharRow
CharRow -> CharRow -> [CharRow]
CharRow -> CharRow -> CharRow -> [CharRow]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: CharRow -> CharRow -> CharRow -> [CharRow]
$cenumFromThenTo :: CharRow -> CharRow -> CharRow -> [CharRow]
enumFromTo :: CharRow -> CharRow -> [CharRow]
$cenumFromTo :: CharRow -> CharRow -> [CharRow]
enumFromThen :: CharRow -> CharRow -> [CharRow]
$cenumFromThen :: CharRow -> CharRow -> [CharRow]
enumFrom :: CharRow -> [CharRow]
$cenumFrom :: CharRow -> [CharRow]
fromEnum :: CharRow -> Int
$cfromEnum :: CharRow -> Int
toEnum :: Int -> CharRow
$ctoEnum :: Int -> CharRow
pred :: CharRow -> CharRow
$cpred :: CharRow -> CharRow
succ :: CharRow -> CharRow
$csucc :: CharRow -> CharRow
Enum, Ord CharRow
(CharRow, CharRow) -> Int
(CharRow, CharRow) -> [CharRow]
(CharRow, CharRow) -> CharRow -> Bool
(CharRow, CharRow) -> CharRow -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (CharRow, CharRow) -> Int
$cunsafeRangeSize :: (CharRow, CharRow) -> Int
rangeSize :: (CharRow, CharRow) -> Int
$crangeSize :: (CharRow, CharRow) -> Int
inRange :: (CharRow, CharRow) -> CharRow -> Bool
$cinRange :: (CharRow, CharRow) -> CharRow -> Bool
unsafeIndex :: (CharRow, CharRow) -> CharRow -> Int
$cunsafeIndex :: (CharRow, CharRow) -> CharRow -> Int
index :: (CharRow, CharRow) -> CharRow -> Int
$cindex :: (CharRow, CharRow) -> CharRow -> Int
range :: (CharRow, CharRow) -> [CharRow]
$crange :: (CharRow, CharRow) -> [CharRow]
Ix, Integer -> CharRow
CharRow -> CharRow
CharRow -> CharRow -> CharRow
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> CharRow
$cfromInteger :: Integer -> CharRow
signum :: CharRow -> CharRow
$csignum :: CharRow -> CharRow
abs :: CharRow -> CharRow
$cabs :: CharRow -> CharRow
negate :: CharRow -> CharRow
$cnegate :: CharRow -> CharRow
* :: CharRow -> CharRow -> CharRow
$c* :: CharRow -> CharRow -> CharRow
- :: CharRow -> CharRow -> CharRow
$c- :: CharRow -> CharRow -> CharRow
+ :: CharRow -> CharRow -> CharRow
$c+ :: CharRow -> CharRow -> CharRow
Num, Eq CharRow
CharRow -> CharRow -> Bool
CharRow -> CharRow -> Ordering
CharRow -> CharRow -> CharRow
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
min :: CharRow -> CharRow -> CharRow
$cmin :: CharRow -> CharRow -> CharRow
max :: CharRow -> CharRow -> CharRow
$cmax :: CharRow -> CharRow -> CharRow
>= :: CharRow -> CharRow -> Bool
$c>= :: CharRow -> CharRow -> Bool
> :: CharRow -> CharRow -> Bool
$c> :: CharRow -> CharRow -> Bool
<= :: CharRow -> CharRow -> Bool
$c<= :: CharRow -> CharRow -> Bool
< :: CharRow -> CharRow -> Bool
$c< :: CharRow -> CharRow -> Bool
compare :: CharRow -> CharRow -> Ordering
$ccompare :: CharRow -> CharRow -> Ordering
Ord)
newtype CharCol = CharCol { CharCol -> Int
fromCharCol :: Int }
deriving stock (CharCol -> CharCol -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CharCol -> CharCol -> Bool
$c/= :: CharCol -> CharCol -> Bool
== :: CharCol -> CharCol -> Bool
$c== :: CharCol -> CharCol -> Bool
Eq, Int -> CharCol -> ShowS
[CharCol] -> ShowS
CharCol -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CharCol] -> ShowS
$cshowList :: [CharCol] -> ShowS
show :: CharCol -> String
$cshow :: CharCol -> String
showsPrec :: Int -> CharCol -> ShowS
$cshowsPrec :: Int -> CharCol -> ShowS
Show)
deriving newtype (Int -> CharCol
CharCol -> Int
CharCol -> [CharCol]
CharCol -> CharCol
CharCol -> CharCol -> [CharCol]
CharCol -> CharCol -> CharCol -> [CharCol]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: CharCol -> CharCol -> CharCol -> [CharCol]
$cenumFromThenTo :: CharCol -> CharCol -> CharCol -> [CharCol]
enumFromTo :: CharCol -> CharCol -> [CharCol]
$cenumFromTo :: CharCol -> CharCol -> [CharCol]
enumFromThen :: CharCol -> CharCol -> [CharCol]
$cenumFromThen :: CharCol -> CharCol -> [CharCol]
enumFrom :: CharCol -> [CharCol]
$cenumFrom :: CharCol -> [CharCol]
fromEnum :: CharCol -> Int
$cfromEnum :: CharCol -> Int
toEnum :: Int -> CharCol
$ctoEnum :: Int -> CharCol
pred :: CharCol -> CharCol
$cpred :: CharCol -> CharCol
succ :: CharCol -> CharCol
$csucc :: CharCol -> CharCol
Enum, Ord CharCol
(CharCol, CharCol) -> Int
(CharCol, CharCol) -> [CharCol]
(CharCol, CharCol) -> CharCol -> Bool
(CharCol, CharCol) -> CharCol -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (CharCol, CharCol) -> Int
$cunsafeRangeSize :: (CharCol, CharCol) -> Int
rangeSize :: (CharCol, CharCol) -> Int
$crangeSize :: (CharCol, CharCol) -> Int
inRange :: (CharCol, CharCol) -> CharCol -> Bool
$cinRange :: (CharCol, CharCol) -> CharCol -> Bool
unsafeIndex :: (CharCol, CharCol) -> CharCol -> Int
$cunsafeIndex :: (CharCol, CharCol) -> CharCol -> Int
index :: (CharCol, CharCol) -> CharCol -> Int
$cindex :: (CharCol, CharCol) -> CharCol -> Int
range :: (CharCol, CharCol) -> [CharCol]
$crange :: (CharCol, CharCol) -> [CharCol]
Ix, Integer -> CharCol
CharCol -> CharCol
CharCol -> CharCol -> CharCol
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> CharCol
$cfromInteger :: Integer -> CharCol
signum :: CharCol -> CharCol
$csignum :: CharCol -> CharCol
abs :: CharCol -> CharCol
$cabs :: CharCol -> CharCol
negate :: CharCol -> CharCol
$cnegate :: CharCol -> CharCol
* :: CharCol -> CharCol -> CharCol
$c* :: CharCol -> CharCol -> CharCol
- :: CharCol -> CharCol -> CharCol
$c- :: CharCol -> CharCol -> CharCol
+ :: CharCol -> CharCol -> CharCol
$c+ :: CharCol -> CharCol -> CharCol
Num, Eq CharCol
CharCol -> CharCol -> Bool
CharCol -> CharCol -> Ordering
CharCol -> CharCol -> CharCol
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
min :: CharCol -> CharCol -> CharCol
$cmin :: CharCol -> CharCol -> CharCol
max :: CharCol -> CharCol -> CharCol
$cmax :: CharCol -> CharCol -> CharCol
>= :: CharCol -> CharCol -> Bool
$c>= :: CharCol -> CharCol -> Bool
> :: CharCol -> CharCol -> Bool
$c> :: CharCol -> CharCol -> Bool
<= :: CharCol -> CharCol -> Bool
$c<= :: CharCol -> CharCol -> Bool
< :: CharCol -> CharCol -> Bool
$c< :: CharCol -> CharCol -> Bool
compare :: CharCol -> CharCol -> Ordering
$ccompare :: CharCol -> CharCol -> Ordering
Ord)
data GChar
= C Char
| CZ [Char] Char
| WP
| Missing
deriving stock (GChar -> GChar -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GChar -> GChar -> Bool
$c/= :: GChar -> GChar -> Bool
== :: GChar -> GChar -> Bool
$c== :: GChar -> GChar -> Bool
Eq)
data TraceInfo = TraceInfo
{ TraceInfo -> Set CharRow
gridRowSeps :: Set CharRow
, TraceInfo -> Set CharCol
gridColSeps :: Set CharCol
, TraceInfo -> Set (CharRow, CharCol)
gridCorners :: Set CharIndex
, TraceInfo -> Set CellTrace
gridCells :: Set CellTrace
}
initialTraceInfo :: TraceInfo
initialTraceInfo :: TraceInfo
initialTraceInfo = TraceInfo
{ gridRowSeps :: Set CharRow
gridRowSeps = forall a. Ord a => [a] -> Set a
Set.fromList [Int -> CharRow
CharRow Int
1]
, gridColSeps :: Set CharCol
gridColSeps = forall a. Ord a => [a] -> Set a
Set.fromList [Int -> CharCol
CharCol Int
1]
, gridCorners :: Set (CharRow, CharCol)
gridCorners = forall a. Ord a => [a] -> Set a
Set.fromList [(Int -> CharRow
CharRow Int
1, Int -> CharCol
CharCol Int
1)]
, gridCells :: Set CellTrace
gridCells = forall a. Set a
Set.empty
}
toCharGrid :: [Text] -> CharGrid
toCharGrid :: [Text] -> CharGrid
toCharGrid [Text]
lines =
let chars :: Int
chars = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Text
t Int
m -> forall a. Ord a => a -> a -> a
max Int
m (Text -> Int
T.length Text
t)) Int
0 [Text]
lines
gbounds :: ((CharRow, CharCol), (CharRow, CharCol))
gbounds = ( (Int -> CharRow
CharRow Int
1, Int -> CharCol
CharCol Int
1)
, (Int -> CharRow
CharRow (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
lines), Int -> CharCol
CharCol Int
chars)
)
toGChars :: String -> [GChar]
toGChars [] = forall a. a -> [a]
repeat GChar
Missing
toGChars (Char
c:String
cs) = case Char -> Int
charWidth Char
c of
Int
2 -> Char -> GChar
C Char
c forall a. a -> [a] -> [a]
: GChar
WP forall a. a -> [a] -> [a]
: String -> [GChar]
toGChars String
cs
Int
1 -> Char -> GChar
C Char
c forall a. a -> [a] -> [a]
: String -> [GChar]
toGChars String
cs
Int
_ -> case forall a. (a -> Bool) -> [a] -> ([a], [a])
span ((forall a. Eq a => a -> a -> Bool
== Int
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
charWidth) String
cs of
(String
zw, []) -> [String -> Char -> GChar
CZ (Char
cforall a. a -> [a] -> [a]
:String
zw) Char
'\0']
(String
zw, Char
c':String
cs') -> String -> Char -> GChar
CZ (Char
cforall a. a -> [a] -> [a]
:String
zw) Char
c' forall a. a -> [a] -> [a]
:
case Char -> Int
charWidth Char
c' of
Int
2 -> GChar
WP forall a. a -> [a] -> [a]
: String -> [GChar]
toGChars String
cs'
Int
_ -> String -> [GChar]
toGChars String
cs'
extendedLines :: [[GChar]]
extendedLines = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Int -> [a] -> [a]
take Int
chars forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [GChar]
toGChars forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) [Text]
lines
in forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray ((CharRow, CharCol), (CharRow, CharCol))
gbounds (forall a. Monoid a => [a] -> a
mconcat [[GChar]]
extendedLines)
data PartSeparator = PartSeparator
{ PartSeparator -> CharRow
partSepLine :: CharRow
, PartSeparator -> [ColSpec]
partSepColSpec :: [ColSpec]
}
data ColSpec = ColSpec
{ ColSpec -> CharCol
colStart :: CharCol
, ColSpec -> CharCol
colEnd :: CharCol
, ColSpec -> Alignment
colAlign :: Alignment
}
findSeparators :: CharGrid -> [PartSeparator]
findSeparators :: CharGrid -> [PartSeparator]
findSeparators CharGrid
charGrid = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr CharRow -> [PartSeparator] -> [PartSeparator]
go [] [CharRow]
rowIdxs
where
gbounds :: ((CharRow, CharCol), (CharRow, CharCol))
gbounds = forall i e. Array i e -> (i, i)
bounds CharGrid
charGrid
rowIdxs :: [CharRow]
rowIdxs = [forall a b. (a, b) -> a
fst (forall a b. (a, b) -> a
fst ((CharRow, CharCol), (CharRow, CharCol))
gbounds) .. forall a b. (a, b) -> a
fst (forall a b. (a, b) -> b
snd ((CharRow, CharCol), (CharRow, CharCol))
gbounds)]
go :: CharRow -> [PartSeparator] -> [PartSeparator]
go CharRow
i [PartSeparator]
seps = case Char -> CharGrid -> CharRow -> Maybe [ColSpec]
colSpecsInLine Char
'=' CharGrid
charGrid CharRow
i of
Maybe [ColSpec]
Nothing -> [PartSeparator]
seps
Just [ColSpec]
colspecs -> CharRow -> [ColSpec] -> PartSeparator
PartSeparator CharRow
i [ColSpec]
colspecs forall a. a -> [a] -> [a]
: [PartSeparator]
seps
colSpecsInLine :: Char
-> CharGrid -> CharRow -> Maybe [ColSpec]
colSpecsInLine :: Char -> CharGrid -> CharRow -> Maybe [ColSpec]
colSpecsInLine Char
c CharGrid
charGrid CharRow
i =
case CharGrid
charGrid forall i e. Ix i => Array i e -> i -> e
! (CharRow
i, CharCol
firstCol) of
C Char
'+' -> [ColSpec] -> CharCol -> Maybe [ColSpec]
loop [] (CharCol
firstCol forall a. Num a => a -> a -> a
+ CharCol
1)
GChar
_ -> forall a. Maybe a
Nothing
where
loop :: [ColSpec] -> CharCol -> Maybe [ColSpec]
loop [ColSpec]
acc CharCol
j = case CharCol -> Maybe (Maybe ColSpec)
colSpecAt CharCol
j of
Maybe (Maybe ColSpec)
Nothing -> forall a. Maybe a
Nothing
Just Maybe ColSpec
Nothing -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [ColSpec]
acc
Just (Just ColSpec
colspec) ->
[ColSpec] -> CharCol -> Maybe [ColSpec]
loop (ColSpec
colspecforall a. a -> [a] -> [a]
:[ColSpec]
acc) (ColSpec -> CharCol
colEnd ColSpec
colspec forall a. Num a => a -> a -> a
+ CharCol
1)
gbounds :: ((CharRow, CharCol), (CharRow, CharCol))
gbounds = forall i e. Array i e -> (i, i)
bounds CharGrid
charGrid
firstCol :: CharCol
firstCol = forall a b. (a, b) -> b
snd (forall a b. (a, b) -> a
fst ((CharRow, CharCol), (CharRow, CharCol))
gbounds)
lastCol :: CharCol
lastCol = forall a b. (a, b) -> b
snd (forall a b. (a, b) -> b
snd ((CharRow, CharCol), (CharRow, CharCol))
gbounds)
colSpecAt :: CharCol -> Maybe (Maybe ColSpec)
colSpecAt :: CharCol -> Maybe (Maybe ColSpec)
colSpecAt CharCol
j
| CharCol
j forall a. Ord a => a -> a -> Bool
>= CharCol
lastCol = forall a. a -> Maybe a
Just forall a. Maybe a
Nothing
| Bool
otherwise = case CharCol -> Maybe (CharCol, Bool)
findEnd (CharCol
j forall a. Num a => a -> a -> a
+ CharCol
1) of
Maybe (CharCol, Bool)
Nothing -> forall a. Maybe a
Nothing
Just (CharCol
end, Bool
rightMark) ->
let leftMark :: Bool
leftMark = CharGrid
charGrid forall i e. Ix i => Array i e -> i -> e
! (CharRow
i, CharCol
j) forall a. Eq a => a -> a -> Bool
== Char -> GChar
C Char
':'
align :: Alignment
align = case (Bool
leftMark, Bool
rightMark) of
(Bool
False , Bool
False) -> Alignment
AlignDefault
(Bool
True , Bool
False) -> Alignment
AlignLeft
(Bool
False , Bool
True ) -> Alignment
AlignRight
(Bool
True , Bool
True ) -> Alignment
AlignCenter
colspec :: ColSpec
colspec = ColSpec
{ colStart :: CharCol
colStart = CharCol
j
, colEnd :: CharCol
colEnd = CharCol
end
, colAlign :: Alignment
colAlign = Alignment
align
}
in forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *) a. Applicative f => a -> f a
pure ColSpec
colspec)
findEnd :: CharCol -> Maybe (CharCol, Bool)
findEnd CharCol
j = case CharGrid
charGrid forall i e. Ix i => Array i e -> i -> e
! (CharRow
i, CharCol
j) of
C Char
'+' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (CharCol
j, Bool
False)
C Char
':' -> if CharGrid
charGrid forall i e. Ix i => Array i e -> i -> e
! (CharRow
i, CharCol
j forall a. Num a => a -> a -> a
+ CharCol
1) forall a. Eq a => a -> a -> Bool
== Char -> GChar
C Char
'+'
then forall (f :: * -> *) a. Applicative f => a -> f a
pure (CharCol
j forall a. Num a => a -> a -> a
+ CharCol
1, Bool
True)
else forall a. Maybe a
Nothing
C Char
c'
| Char
c' forall a. Eq a => a -> a -> Bool
== Char
c -> CharCol -> Maybe (CharCol, Bool)
findEnd (CharCol
j forall a. Num a => a -> a -> a
+ CharCol
1)
GChar
_ -> forall a. Maybe a
Nothing
convertToNormalLines :: [CharRow] -> CharGrid -> CharGrid
convertToNormalLines :: [CharRow] -> CharGrid -> CharGrid
convertToNormalLines [CharRow]
sepLines CharGrid
charGrid = forall i e. (forall s. ST s (STArray s i e)) -> Array i e
runSTArray forall a b. (a -> b) -> a -> b
$ do
STArray s (CharRow, CharCol) GChar
mutGrid <- forall i (a :: * -> * -> *) e (b :: * -> * -> *) (m :: * -> *).
(Ix i, IArray a e, MArray b e m) =>
a i e -> m (b i e)
thaw CharGrid
charGrid
let gbounds :: ((CharRow, CharCol), (CharRow, CharCol))
gbounds = forall i e. Array i e -> (i, i)
bounds CharGrid
charGrid
cols :: [CharCol]
cols = [forall a b. (a, b) -> b
snd (forall a b. (a, b) -> a
fst ((CharRow, CharCol), (CharRow, CharCol))
gbounds) .. forall a b. (a, b) -> b
snd (forall a b. (a, b) -> b
snd ((CharRow, CharCol), (CharRow, CharCol))
gbounds)]
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [CharRow]
sepLines forall a b. (a -> b) -> a -> b
$ \CharRow
rowidx -> do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [CharCol]
cols forall a b. (a -> b) -> a -> b
$ \CharCol
colidx -> do
let idx :: (CharRow, CharCol)
idx = (CharRow
rowidx, CharCol
colidx)
GChar
c <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STArray s (CharRow, CharCol) GChar
mutGrid (CharRow, CharCol)
idx
case GChar
c of
C Char
'=' -> forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STArray s (CharRow, CharCol) GChar
mutGrid (CharRow, CharCol)
idx (Char -> GChar
C Char
'-')
C Char
':' -> forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STArray s (CharRow, CharCol) GChar
mutGrid (CharRow, CharCol)
idx (Char -> GChar
C Char
'-')
GChar
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
forall (m :: * -> *) a. Monad m => a -> m a
return STArray s (CharRow, CharCol) GChar
mutGrid
traceCharGrid :: CharGrid
-> TraceInfo
-> TraceInfo
traceCharGrid :: CharGrid -> TraceInfo -> TraceInfo
traceCharGrid CharGrid
charGrid TraceInfo
traceInfo =
case forall a. Set a -> Maybe (a, Set a)
Set.minView (TraceInfo -> Set (CharRow, CharCol)
gridCorners TraceInfo
traceInfo) of
Maybe ((CharRow, CharCol), Set (CharRow, CharCol))
Nothing -> TraceInfo
traceInfo
Just (startIdx :: (CharRow, CharCol)
startIdx@(CharRow
top, CharCol
left), Set (CharRow, CharCol)
corners) ->
case CharGrid -> (CharRow, CharCol) -> Maybe ScanResult
traceCell CharGrid
charGrid (CharRow, CharCol)
startIdx of
Maybe ScanResult
Nothing ->
CharGrid -> TraceInfo -> TraceInfo
traceCharGrid CharGrid
charGrid TraceInfo
traceInfo { gridCorners :: Set (CharRow, CharCol)
gridCorners = Set (CharRow, CharCol)
corners }
Just ((CharRow
bottom, CharCol
right), Set CharRow
newrowseps, Set CharCol
newcolseps) -> do
let content :: [Text]
content = CharGrid -> (CharRow, CharCol) -> (CharRow, CharCol) -> [Text]
getLines CharGrid
charGrid (CharRow, CharCol)
startIdx (CharRow
bottom, CharCol
right)
let cell :: CellTrace
cell = [Text] -> CharCol -> CharCol -> CharRow -> CharRow -> CellTrace
CellTrace [Text]
content CharCol
left CharCol
right CharRow
top CharRow
bottom
let rowseps :: Set CharRow
rowseps = TraceInfo -> Set CharRow
gridRowSeps TraceInfo
traceInfo
let colseps :: Set CharCol
colseps = TraceInfo -> Set CharCol
gridColSeps TraceInfo
traceInfo
let cells :: Set CellTrace
cells = TraceInfo -> Set CellTrace
gridCells TraceInfo
traceInfo
CharGrid -> TraceInfo -> TraceInfo
traceCharGrid CharGrid
charGrid forall a b. (a -> b) -> a -> b
$ TraceInfo
{ gridRowSeps :: Set CharRow
gridRowSeps = Set CharRow
newrowseps forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set CharRow
rowseps
, gridColSeps :: Set CharCol
gridColSeps = Set CharCol
newcolseps forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set CharCol
colseps
, gridCorners :: Set (CharRow, CharCol)
gridCorners = forall a. Ord a => a -> Set a -> Set a
Set.insert (CharRow
top, CharCol
right) forall a b. (a -> b) -> a -> b
$
forall a. Ord a => a -> Set a -> Set a
Set.insert (CharRow
bottom, CharCol
left) Set (CharRow, CharCol)
corners
, gridCells :: Set CellTrace
gridCells = CellTrace
cell forall a. Ord a => a -> Set a -> Set a
`Set.insert` Set CellTrace
cells
}
type ScanResult = (CharIndex, Set CharRow, Set CharCol)
type RowSeps = Set CharRow
type ColSeps = Set CharCol
traceCell :: CharGrid -> CharIndex -> Maybe ScanResult
traceCell :: CharGrid -> (CharRow, CharCol) -> Maybe ScanResult
traceCell = CharGrid -> (CharRow, CharCol) -> Maybe ScanResult
scanRight
scanRight :: CharGrid -> CharIndex -> Maybe ScanResult
scanRight :: CharGrid -> (CharRow, CharCol) -> Maybe ScanResult
scanRight CharGrid
charGrid start :: (CharRow, CharCol)
start@(CharRow
top, CharCol
left) = do
Set CharCol -> CharCol -> Maybe ScanResult
loop forall a. Set a
Set.empty (CharCol
left forall a. Num a => a -> a -> a
+ CharCol
1)
where
loop :: ColSeps -> CharCol -> Maybe ScanResult
loop :: Set CharCol -> CharCol -> Maybe ScanResult
loop Set CharCol
colseps CharCol
j
| Bool -> Bool
not (forall i e. Array i e -> (i, i)
bounds CharGrid
charGrid forall a. Ix a => (a, a) -> a -> Bool
`inRange` (CharRow
top, CharCol
j)) = forall a. Maybe a
Nothing
| Bool
otherwise = case CharGrid
charGrid forall i e. Ix i => Array i e -> i -> e
! (CharRow
top, CharCol
j) of
C Char
'-' -> Set CharCol -> CharCol -> Maybe ScanResult
loop Set CharCol
colseps (CharCol
j forall a. Num a => a -> a -> a
+ CharCol
1)
C Char
'+' ->
let colseps' :: Set CharCol
colseps' = forall a. Ord a => a -> Set a -> Set a
Set.insert CharCol
j Set CharCol
colseps
in case CharGrid -> (CharRow, CharCol) -> CharCol -> Maybe ScanResult
scanDown CharGrid
charGrid (CharRow, CharCol)
start CharCol
j of
Maybe ScanResult
Nothing -> Set CharCol -> CharCol -> Maybe ScanResult
loop Set CharCol
colseps' (CharCol
j forall a. Num a => a -> a -> a
+ CharCol
1) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
CharGrid -> (CharRow, CharCol) -> CharCol -> Maybe ScanResult
lastCellInRow CharGrid
charGrid (CharRow, CharCol)
start (CharCol
j forall a. Num a => a -> a -> a
+ CharCol
1)
Just ((CharRow, CharCol)
end, Set CharRow
rowseps, Set CharCol
newcolseps) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure
( (CharRow, CharCol)
end
, Set CharRow
rowseps
, Set CharCol
colseps' forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set CharCol
newcolseps
)
GChar
_ -> forall a. Maybe a
Nothing
scanDown :: CharGrid
-> CharIndex
-> CharCol
-> Maybe ScanResult
scanDown :: CharGrid -> (CharRow, CharCol) -> CharCol -> Maybe ScanResult
scanDown CharGrid
charGrid start :: (CharRow, CharCol)
start@(CharRow
top, CharCol
_left) CharCol
right = do
Set CharRow -> CharRow -> Maybe ScanResult
loop forall a. Set a
Set.empty (CharRow
top forall a. Num a => a -> a -> a
+ CharRow
1)
where
loop :: RowSeps -> CharRow -> Maybe ScanResult
loop :: Set CharRow -> CharRow -> Maybe ScanResult
loop Set CharRow
rowseps CharRow
i =
if Bool -> Bool
not (forall i e. Array i e -> (i, i)
bounds CharGrid
charGrid forall a. Ix a => (a, a) -> a -> Bool
`inRange` (CharRow
i, CharCol
right))
then forall a. Maybe a
Nothing
else case CharGrid
charGrid forall i e. Ix i => Array i e -> i -> e
! (CharRow
i, CharCol
right) of
C Char
'+' ->
let rowseps' :: Set CharRow
rowseps' = forall a. Ord a => a -> Set a -> Set a
Set.insert CharRow
i Set CharRow
rowseps
in case CharGrid
-> (CharRow, CharCol)
-> (CharRow, CharCol)
-> Maybe (Set CharRow, Set CharCol)
scanLeft CharGrid
charGrid (CharRow, CharCol)
start (CharRow
i, CharCol
right) of
Maybe (Set CharRow, Set CharCol)
Nothing -> Set CharRow -> CharRow -> Maybe ScanResult
loop Set CharRow
rowseps' (CharRow
i forall a. Num a => a -> a -> a
+ CharRow
1)
Just (Set CharRow
newrowseps, Set CharCol
colseps) ->
forall a. a -> Maybe a
Just ( (CharRow
i, CharCol
right)
, Set CharRow
rowseps' forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set CharRow
newrowseps
, Set CharCol
colseps
)
C Char
'|' -> Set CharRow -> CharRow -> Maybe ScanResult
loop Set CharRow
rowseps (CharRow
i forall a. Num a => a -> a -> a
+ CharRow
1)
GChar
_ ->
if CharCol
right forall a. Eq a => a -> a -> Bool
== forall a b. (a, b) -> b
snd (forall a b. (a, b) -> b
snd (forall i e. Array i e -> (i, i)
bounds CharGrid
charGrid))
then Set CharRow -> CharRow -> Maybe ScanResult
loop Set CharRow
rowseps (CharRow
i forall a. Num a => a -> a -> a
+ CharRow
1)
else forall a. Maybe a
Nothing
scanLeft :: CharGrid -> CharIndex -> CharIndex
-> Maybe (RowSeps, ColSeps)
scanLeft :: CharGrid
-> (CharRow, CharCol)
-> (CharRow, CharCol)
-> Maybe (Set CharRow, Set CharCol)
scanLeft CharGrid
charGrid start :: (CharRow, CharCol)
start@(CharRow
_top,CharCol
left) end :: (CharRow, CharCol)
end@(CharRow
bottom, CharCol
right) =
let go :: CharCol -> Maybe ColSeps -> Maybe ColSeps
go :: CharCol -> Maybe (Set CharCol) -> Maybe (Set CharCol)
go CharCol
_ Maybe (Set CharCol)
Nothing = forall a. Maybe a
Nothing
go CharCol
j (Just Set CharCol
colseps) = case CharGrid
charGrid forall i e. Ix i => Array i e -> i -> e
! (CharRow
bottom, CharCol
j) of
C Char
'+' -> forall a. a -> Maybe a
Just (forall a. Ord a => a -> Set a -> Set a
Set.insert CharCol
j Set CharCol
colseps)
C Char
'-' -> forall a. a -> Maybe a
Just Set CharCol
colseps
GChar
_ -> forall a. Maybe a
Nothing
in if CharGrid
charGrid forall i e. Ix i => Array i e -> i -> e
! (CharRow
bottom, CharCol
left) forall a. Eq a => a -> a -> Bool
/= Char -> GChar
C Char
'+'
then forall a. Maybe a
Nothing
else
case forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr CharCol -> Maybe (Set CharCol) -> Maybe (Set CharCol)
go (forall a. a -> Maybe a
Just forall a. Set a
Set.empty) [(CharCol
right forall a. Num a => a -> a -> a
- CharCol
1), CharCol
right forall a. Num a => a -> a -> a
- CharCol
2 .. (CharCol
left forall a. Num a => a -> a -> a
+ CharCol
1)] of
Maybe (Set CharCol)
Nothing -> forall a. Maybe a
Nothing
Just Set CharCol
colseps ->
case CharGrid
-> (CharRow, CharCol) -> (CharRow, CharCol) -> Maybe (Set CharRow)
scanUp CharGrid
charGrid (CharRow, CharCol)
start (CharRow, CharCol)
end of
Just Set CharRow
rowseps -> forall a. a -> Maybe a
Just (Set CharRow
rowseps, Set CharCol
colseps)
Maybe (Set CharRow)
Nothing -> forall a. Maybe a
Nothing
scanUp :: CharGrid -> CharIndex -> CharIndex
-> Maybe RowSeps
scanUp :: CharGrid
-> (CharRow, CharCol) -> (CharRow, CharCol) -> Maybe (Set CharRow)
scanUp CharGrid
charGrid (CharRow
top, CharCol
left) (CharRow
bottom, CharCol
_right) =
let go :: CharRow -> Maybe RowSeps -> Maybe RowSeps
go :: CharRow -> Maybe (Set CharRow) -> Maybe (Set CharRow)
go CharRow
_ Maybe (Set CharRow)
Nothing = forall a. Maybe a
Nothing
go CharRow
i (Just Set CharRow
rowseps) = case CharGrid
charGrid forall i e. Ix i => Array i e -> i -> e
! (CharRow
i, CharCol
left) of
C Char
'+' -> forall a. a -> Maybe a
Just (forall a. Ord a => a -> Set a -> Set a
Set.insert CharRow
i Set CharRow
rowseps)
C Char
'|' -> forall a. a -> Maybe a
Just Set CharRow
rowseps
GChar
_ -> forall a. Maybe a
Nothing
in forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr CharRow -> Maybe (Set CharRow) -> Maybe (Set CharRow)
go (forall a. a -> Maybe a
Just forall a. Set a
Set.empty) [CharRow
bottom forall a. Num a => a -> a -> a
- CharRow
1, CharRow
bottom forall a. Num a => a -> a -> a
- CharRow
2 .. CharRow
top forall a. Num a => a -> a -> a
+ CharRow
1]
lastCellInRow :: CharGrid -> CharIndex -> CharCol -> Maybe ScanResult
lastCellInRow :: CharGrid -> (CharRow, CharCol) -> CharCol -> Maybe ScanResult
lastCellInRow CharGrid
charGrid start :: (CharRow, CharCol)
start@(CharRow
top, CharCol
_left) CharCol
right =
if forall i e. Array i e -> (i, i)
bounds CharGrid
charGrid forall a. Ix a => (a, a) -> a -> Bool
`inRange` (CharRow
top, CharCol
right) Bool -> Bool -> Bool
&&
CharGrid
charGrid forall i e. Ix i => Array i e -> i -> e
! (CharRow
top, CharCol
right) forall a. Eq a => a -> a -> Bool
== GChar
Missing
then CharGrid -> (CharRow, CharCol) -> Maybe ScanResult
scanRestOfLines CharGrid
charGrid (CharRow, CharCol)
start
else forall a. Maybe a
Nothing
lastColumn :: CharGrid -> CharCol
lastColumn :: CharGrid -> CharCol
lastColumn = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i e. Array i e -> (i, i)
bounds
lastRow :: CharGrid -> CharRow
lastRow :: CharGrid -> CharRow
lastRow = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i e. Array i e -> (i, i)
bounds
scanRightRestOfLine :: CharGrid -> CharIndex -> CharRow -> Maybe ColSeps
scanRightRestOfLine :: CharGrid -> (CharRow, CharCol) -> CharRow -> Maybe (Set CharCol)
scanRightRestOfLine CharGrid
charGrid (CharRow
_top, CharCol
left) CharRow
bottom =
let go :: CharCol -> Maybe ColSeps -> Maybe ColSeps
go :: CharCol -> Maybe (Set CharCol) -> Maybe (Set CharCol)
go CharCol
_ Maybe (Set CharCol)
Nothing = forall a. Maybe a
Nothing
go CharCol
j (Just Set CharCol
colseps) = case CharGrid
charGrid forall i e. Ix i => Array i e -> i -> e
! (CharRow
bottom, CharCol
j) of
C Char
'+' -> forall a. a -> Maybe a
Just (forall a. Ord a => a -> Set a -> Set a
Set.insert CharCol
j Set CharCol
colseps)
C Char
'-' -> forall a. a -> Maybe a
Just Set CharCol
colseps
GChar
Missing -> forall a. a -> Maybe a
Just Set CharCol
colseps
GChar
_ -> forall a. Maybe a
Nothing
in if CharGrid
charGrid forall i e. Ix i => Array i e -> i -> e
! (CharRow
bottom, CharCol
left) forall a. Eq a => a -> a -> Bool
/= Char -> GChar
C Char
'+'
then forall a. Maybe a
Nothing
else forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr CharCol -> Maybe (Set CharCol) -> Maybe (Set CharCol)
go (forall a. a -> Maybe a
Just forall a. Set a
Set.empty) [CharCol
left forall a. Num a => a -> a -> a
+ CharCol
1 .. CharGrid -> CharCol
lastColumn CharGrid
charGrid]
scanRestOfLines :: CharGrid -> CharIndex -> Maybe ScanResult
scanRestOfLines :: CharGrid -> (CharRow, CharCol) -> Maybe ScanResult
scanRestOfLines CharGrid
charGrid start :: (CharRow, CharCol)
start@(CharRow
top, CharCol
_left) =
let go :: Maybe CharIndex -> CharRow -> Maybe CharIndex
go :: Maybe (CharRow, CharCol) -> CharRow -> Maybe (CharRow, CharCol)
go Maybe (CharRow, CharCol)
idx CharRow
i = Maybe (CharRow, CharCol)
idx forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
case CharGrid -> (CharRow, CharCol) -> CharRow -> Maybe (Set CharCol)
scanRightRestOfLine CharGrid
charGrid (CharRow, CharCol)
start CharRow
i of
Maybe (Set CharCol)
Nothing -> forall a. Maybe a
Nothing
Just Set CharCol
_colseps -> forall a. a -> Maybe a
Just (CharRow
i, CharGrid -> CharCol
lastColumn CharGrid
charGrid)
in case forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Maybe (CharRow, CharCol) -> CharRow -> Maybe (CharRow, CharCol)
go forall a. Maybe a
Nothing [CharRow
top forall a. Num a => a -> a -> a
+ CharRow
1 .. CharGrid -> CharRow
lastRow CharGrid
charGrid] of
Just (CharRow
bottom, CharCol
right) -> forall a. a -> Maybe a
Just
( (CharRow
bottom, CharCol
right)
, forall a. a -> Set a
Set.singleton CharRow
bottom
, forall a. a -> Set a
Set.singleton CharCol
right)
Maybe (CharRow, CharCol)
Nothing -> forall a. Maybe a
Nothing
getLines :: CharGrid -> CharIndex -> CharIndex -> [Text]
getLines :: CharGrid -> (CharRow, CharCol) -> (CharRow, CharCol) -> [Text]
getLines CharGrid
charGrid (CharRow
top, CharCol
left) (CharRow
bottom, CharCol
right) =
let rowIdxs :: [CharRow]
rowIdxs = [CharRow
top forall a. Num a => a -> a -> a
+ CharRow
1 .. CharRow
bottom forall a. Num a => a -> a -> a
- CharRow
1]
colIdxs :: [CharCol]
colIdxs = [CharCol
left forall a. Num a => a -> a -> a
+ CharCol
1 .. CharCol
right forall a. Num a => a -> a -> a
- CharCol
1]
toChars :: CharRow -> CharCol -> String
toChars CharRow
rowIdx CharCol
colIdx = case CharGrid
charGrid forall i e. Ix i => Array i e -> i -> e
! (CharRow
rowIdx, CharCol
colIdx) of
C Char
c -> [Char
c]
CZ String
zw Char
c -> String
zw forall a. [a] -> [a] -> [a]
++ [Char
c]
GChar
_ -> []
in forall a b. (a -> b) -> [a] -> [b]
map (\CharRow
ir -> String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (CharRow -> CharCol -> String
toChars CharRow
ir) [CharCol]
colIdxs)
[CharRow]
rowIdxs
data CellTrace = CellTrace
{ CellTrace -> [Text]
cellTraceContent :: [Text]
, CellTrace -> CharCol
cellTraceLeft :: CharCol
, CellTrace -> CharCol
cellTraceRight :: CharCol
, CellTrace -> CharRow
cellTraceTop :: CharRow
, CellTrace -> CharRow
cellTraceBottom :: CharRow
}
deriving stock (CellTrace -> CellTrace -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CellTrace -> CellTrace -> Bool
$c/= :: CellTrace -> CellTrace -> Bool
== :: CellTrace -> CellTrace -> Bool
$c== :: CellTrace -> CellTrace -> Bool
Eq, Int -> CellTrace -> ShowS
[CellTrace] -> ShowS
CellTrace -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CellTrace] -> ShowS
$cshowList :: [CellTrace] -> ShowS
show :: CellTrace -> String
$cshow :: CellTrace -> String
showsPrec :: Int -> CellTrace -> ShowS
$cshowsPrec :: Int -> CellTrace -> ShowS
Show)
instance Ord CellTrace where
CellTrace
x compare :: CellTrace -> CellTrace -> Ordering
`compare` CellTrace
y =
case (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` CellTrace -> CharRow
cellTraceTop) CellTrace
x CellTrace
y of
Ordering
EQ -> (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` CellTrace -> CharCol
cellTraceLeft) CellTrace
x CellTrace
y
Ordering
o -> Ordering
o
tableFromTraceInfo :: TraceInfo
-> [PartSeparator]
-> Maybe [ColSpec]
-> ArrayTable [Text]
tableFromTraceInfo :: TraceInfo
-> [PartSeparator] -> Maybe [ColSpec] -> ArrayTable [Text]
tableFromTraceInfo TraceInfo
traceInfo [PartSeparator]
partSeps Maybe [ColSpec]
colSpecsFirstLine =
let rowseps :: [CharRow]
rowseps = forall a. Set a -> [a]
Set.toAscList forall a b. (a -> b) -> a -> b
$ TraceInfo -> Set CharRow
gridRowSeps TraceInfo
traceInfo
colseps :: [CharCol]
colseps = forall a. Set a -> [a]
Set.toAscList forall a b. (a -> b) -> a -> b
$ TraceInfo -> Set CharCol
gridColSeps TraceInfo
traceInfo
rowindex :: Map CharRow RowIndex
rowindex = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [CharRow]
rowseps [RowIndex
1..]
colindex :: Map CharCol ColIndex
colindex = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [CharCol]
colseps [ColIndex
1..]
colwidths :: [CharCol]
colwidths = [ CharCol
b forall a. Num a => a -> a -> a
- CharCol
a forall a. Num a => a -> a -> a
- CharCol
1 | (CharCol
b, CharCol
a) <- forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. [a] -> [a]
tail [CharCol]
colseps) [CharCol]
colseps ]
colSpecs :: [(Alignment, Int)]
colSpecs = forall a b. [a] -> [b] -> [(a, b)]
zip
(forall a b. (a -> b) -> [a] -> [b]
map ColSpec -> Alignment
colAlign
(case [PartSeparator]
partSeps of
PartSeparator
partSep:[PartSeparator]
_ -> PartSeparator -> [ColSpec]
partSepColSpec PartSeparator
partSep
[] -> forall a. a -> Maybe a -> a
fromMaybe [] Maybe [ColSpec]
colSpecsFirstLine)
forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat Alignment
AlignDefault)
(forall a b. (a -> b) -> [a] -> [b]
map CharCol -> Int
fromCharCol [CharCol]
colwidths)
lastCol :: ColIndex
lastCol = Int -> ColIndex
ColIndex (forall (t :: * -> *) a. Foldable t => t a -> Int
length [CharCol]
colwidths)
mlastLine :: Maybe CharRow
mlastLine = forall a. Set a -> Maybe a
Set.lookupMax (TraceInfo -> Set CharRow
gridRowSeps TraceInfo
traceInfo)
tableHead :: Maybe RowIndex
tableHead = case [PartSeparator]
partSeps of
PartSeparator
ps:[PartSeparator]
_ -> forall a. Num a => a -> a -> a
subtract RowIndex
1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PartSeparator -> CharRow
partSepLine PartSeparator
ps forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map CharRow RowIndex
rowindex
[] -> forall a. Maybe a
Nothing
tableFoot :: Maybe RowIndex
tableFoot = case forall a. [a] -> [a]
reverse [PartSeparator]
partSeps of
PartSeparator
rps:PartSeparator
rps':[PartSeparator]
_ | forall a. a -> Maybe a
Just (PartSeparator -> CharRow
partSepLine PartSeparator
rps) forall a. Eq a => a -> a -> Bool
== Maybe CharRow
mlastLine ->
PartSeparator -> CharRow
partSepLine PartSeparator
rps' forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map CharRow RowIndex
rowindex
[PartSeparator]
_ ->
forall a. Maybe a
Nothing
in ArrayTable
{ arrayTableCells :: Array CellIndex (GridCell [Text])
arrayTableCells = forall i e. (forall s. ST s (STArray s i e)) -> Array i e
runSTArray (forall s.
TraceInfo
-> Map CharRow RowIndex
-> Map CharCol ColIndex
-> ST s (STArray s CellIndex (GridCell [Text]))
toMutableArray TraceInfo
traceInfo Map CharRow RowIndex
rowindex Map CharCol ColIndex
colindex)
, arrayTableHead :: Maybe RowIndex
arrayTableHead = Maybe RowIndex
tableHead
, arrayTableFoot :: Maybe RowIndex
arrayTableFoot = Maybe RowIndex
tableFoot
, arrayTableColSpecs :: Array ColIndex (Alignment, Int)
arrayTableColSpecs = forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (ColIndex
1, ColIndex
lastCol) [(Alignment, Int)]
colSpecs
}
toMutableArray :: TraceInfo
-> Map.Map CharRow RowIndex
-> Map.Map CharCol ColIndex
-> ST s (STArray s CellIndex (GridCell [Text]))
toMutableArray :: forall s.
TraceInfo
-> Map CharRow RowIndex
-> Map CharCol ColIndex
-> ST s (STArray s CellIndex (GridCell [Text]))
toMutableArray TraceInfo
traceInfo Map CharRow RowIndex
rowindex Map CharCol ColIndex
colindex = do
let nrows :: Int
nrows = forall k a. Map k a -> Int
Map.size Map CharRow RowIndex
rowindex forall a. Num a => a -> a -> a
- Int
1
let ncols :: Int
ncols = forall k a. Map k a -> Int
Map.size Map CharCol ColIndex
colindex forall a. Num a => a -> a -> a
- Int
1
let gbounds :: (CellIndex, CellIndex)
gbounds = ( (Int -> RowIndex
RowIndex Int
1, Int -> ColIndex
ColIndex Int
1)
, (Int -> RowIndex
RowIndex Int
nrows, Int -> ColIndex
ColIndex Int
ncols)
)
STArray s CellIndex BuilderCell
tblgrid <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (CellIndex, CellIndex)
gbounds BuilderCell
FreeCell
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a. Set a -> [a]
Set.toAscList forall a b. (a -> b) -> a -> b
$ TraceInfo -> Set CellTrace
gridCells TraceInfo
traceInfo) forall a b. (a -> b) -> a -> b
$
\(CellTrace [Text]
content CharCol
left CharCol
right CharRow
top CharRow
bottom) -> do
let cellPos :: Maybe (CellIndex, RowSpan, ColSpan)
cellPos = do
RowIndex
rnum <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup CharRow
top Map CharRow RowIndex
rowindex
ColIndex
cnum <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup CharCol
left Map CharCol ColIndex
colindex
RowSpan
rs <- Int -> RowSpan
RowSpan forall b c a. (b -> c) -> (a -> b) -> a -> c
. RowIndex -> Int
fromRowIndex forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => a -> a -> a
subtract RowIndex
rnum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup CharRow
bottom Map CharRow RowIndex
rowindex
ColSpan
cs <- Int -> ColSpan
ColSpan forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColIndex -> Int
fromColIndex forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => a -> a -> a
subtract ColIndex
cnum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup CharCol
right Map CharCol ColIndex
colindex
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((RowIndex
rnum, ColIndex
cnum), RowSpan
rs, ColSpan
cs)
let (CellIndex
idx, RowSpan
rowspan, ColSpan
colspan) = case Maybe (CellIndex, RowSpan, ColSpan)
cellPos of
Just (CellIndex, RowSpan, ColSpan)
cp -> (CellIndex, RowSpan, ColSpan)
cp
Maybe (CellIndex, RowSpan, ColSpan)
Nothing -> forall a. HasCallStack => String -> a
error String
"A cell or row index was not found"
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STArray s CellIndex BuilderCell
tblgrid CellIndex
idx forall b c a. (b -> c) -> (a -> b) -> a -> c
. GridCell [Text] -> BuilderCell
FilledCell forall a b. (a -> b) -> a -> b
$
forall a. RowSpan -> ColSpan -> a -> GridCell a
ContentCell RowSpan
rowspan ColSpan
colspan [Text]
content
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (CellIndex -> RowSpan -> ColSpan -> [CellIndex]
continuationIndices CellIndex
idx RowSpan
rowspan ColSpan
colspan) forall a b. (a -> b) -> a -> b
$ \CellIndex
contIdx -> do
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STArray s CellIndex BuilderCell
tblgrid CellIndex
contIdx forall a b. (a -> b) -> a -> b
$
GridCell [Text] -> BuilderCell
FilledCell (forall a. CellIndex -> GridCell a
ContinuationCell CellIndex
idx)
let fromBuilderCell :: BuilderCell -> GridCell [Text]
fromBuilderCell :: BuilderCell -> GridCell [Text]
fromBuilderCell = \case
FilledCell GridCell [Text]
c -> GridCell [Text]
c
BuilderCell
FreeCell ->
forall a. RowSpan -> ColSpan -> a -> GridCell a
ContentCell RowSpan
1 ColSpan
1 forall a. Monoid a => a
mempty
forall (a :: * -> * -> *) e' (m :: * -> *) e i.
(MArray a e' m, MArray a e m, Ix i) =>
(e' -> e) -> a i e' -> m (a i e)
mapArray BuilderCell -> GridCell [Text]
fromBuilderCell STArray s CellIndex BuilderCell
tblgrid
continuationIndices :: (RowIndex, ColIndex)
-> RowSpan -> ColSpan
-> [CellIndex]
continuationIndices :: CellIndex -> RowSpan -> ColSpan -> [CellIndex]
continuationIndices (RowIndex Int
ridx, ColIndex Int
cidx) RowSpan
rowspan ColSpan
colspan =
let (RowSpan Int
rs) = RowSpan
rowspan
(ColSpan Int
cs) = ColSpan
colspan
in [ (Int -> RowIndex
RowIndex Int
r, Int -> ColIndex
ColIndex Int
c) | Int
r <- [Int
ridx..(Int
ridx forall a. Num a => a -> a -> a
+ Int
rs forall a. Num a => a -> a -> a
- Int
1)]
, Int
c <- [Int
cidx..(Int
cidx forall a. Num a => a -> a -> a
+ Int
cs forall a. Num a => a -> a -> a
- Int
1)]
, (Int
r, Int
c) forall a. Eq a => a -> a -> Bool
/= (Int
ridx, Int
cidx)]
data BuilderCell
= FilledCell (GridCell [Text])
| FreeCell