{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE RankNTypes                 #-}
{- |
Module      : Text.GridTable.Trace
Copyright   : © 2022 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <albert@zeitkraut.de>

Trace cells of a grid table.
-}

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.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

-- | Traces out the cells in the given lines and converts them to a
-- table containing the bare cell lines.
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
1CharRow -> [CharRow] -> [CharRow]
forall a. a -> [a] -> [a]
:(PartSeparator -> CharRow) -> [PartSeparator] -> [CharRow]
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 Set CellTrace -> Bool
forall a. Set a -> Bool
Set.null (TraceInfo -> Set CellTrace
gridCells TraceInfo
traceInfo)
     then String -> Maybe (ArrayTable [Text])
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"no cells"
     else ArrayTable [Text] -> Maybe (ArrayTable [Text])
forall (m :: * -> *) a. Monad m => a -> m a
return (ArrayTable [Text] -> Maybe (ArrayTable [Text]))
-> ArrayTable [Text] -> Maybe (ArrayTable [Text])
forall a b. (a -> b) -> a -> b
$ TraceInfo
-> [PartSeparator] -> Maybe [ColSpec] -> ArrayTable [Text]
tableFromTraceInfo TraceInfo
traceInfo [PartSeparator]
partSeps Maybe [ColSpec]
specs1

-- | Type used to represent the 2D layout of table characters
type CharGrid = Array (CharRow, CharCol) GChar

-- | Index of a half-width character in the character-wise
-- representation.
type CharIndex = (CharRow, CharCol)

-- | Character row
newtype CharRow = CharRow Int
  deriving stock (CharRow -> CharRow -> Bool
(CharRow -> CharRow -> Bool)
-> (CharRow -> CharRow -> Bool) -> Eq CharRow
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
(Int -> CharRow -> ShowS)
-> (CharRow -> String) -> ([CharRow] -> ShowS) -> Show CharRow
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]
(CharRow -> CharRow)
-> (CharRow -> CharRow)
-> (Int -> CharRow)
-> (CharRow -> Int)
-> (CharRow -> [CharRow])
-> (CharRow -> CharRow -> [CharRow])
-> (CharRow -> CharRow -> [CharRow])
-> (CharRow -> CharRow -> CharRow -> [CharRow])
-> Enum 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
Ord CharRow
-> ((CharRow, CharRow) -> [CharRow])
-> ((CharRow, CharRow) -> CharRow -> Int)
-> ((CharRow, CharRow) -> CharRow -> Int)
-> ((CharRow, CharRow) -> CharRow -> Bool)
-> ((CharRow, CharRow) -> Int)
-> ((CharRow, CharRow) -> Int)
-> Ix 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]
$cp1Ix :: Ord CharRow
Ix, Integer -> CharRow
CharRow -> CharRow
CharRow -> CharRow -> CharRow
(CharRow -> CharRow -> CharRow)
-> (CharRow -> CharRow -> CharRow)
-> (CharRow -> CharRow -> CharRow)
-> (CharRow -> CharRow)
-> (CharRow -> CharRow)
-> (CharRow -> CharRow)
-> (Integer -> CharRow)
-> Num 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
Eq CharRow
-> (CharRow -> CharRow -> Ordering)
-> (CharRow -> CharRow -> Bool)
-> (CharRow -> CharRow -> Bool)
-> (CharRow -> CharRow -> Bool)
-> (CharRow -> CharRow -> Bool)
-> (CharRow -> CharRow -> CharRow)
-> (CharRow -> CharRow -> CharRow)
-> Ord 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
$cp1Ord :: Eq CharRow
Ord)

-- | Character column
newtype CharCol = CharCol { CharCol -> Int
fromCharCol :: Int }
  deriving stock (CharCol -> CharCol -> Bool
(CharCol -> CharCol -> Bool)
-> (CharCol -> CharCol -> Bool) -> Eq CharCol
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
(Int -> CharCol -> ShowS)
-> (CharCol -> String) -> ([CharCol] -> ShowS) -> Show CharCol
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]
(CharCol -> CharCol)
-> (CharCol -> CharCol)
-> (Int -> CharCol)
-> (CharCol -> Int)
-> (CharCol -> [CharCol])
-> (CharCol -> CharCol -> [CharCol])
-> (CharCol -> CharCol -> [CharCol])
-> (CharCol -> CharCol -> CharCol -> [CharCol])
-> Enum 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
Ord CharCol
-> ((CharCol, CharCol) -> [CharCol])
-> ((CharCol, CharCol) -> CharCol -> Int)
-> ((CharCol, CharCol) -> CharCol -> Int)
-> ((CharCol, CharCol) -> CharCol -> Bool)
-> ((CharCol, CharCol) -> Int)
-> ((CharCol, CharCol) -> Int)
-> Ix 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]
$cp1Ix :: Ord CharCol
Ix, Integer -> CharCol
CharCol -> CharCol
CharCol -> CharCol -> CharCol
(CharCol -> CharCol -> CharCol)
-> (CharCol -> CharCol -> CharCol)
-> (CharCol -> CharCol -> CharCol)
-> (CharCol -> CharCol)
-> (CharCol -> CharCol)
-> (CharCol -> CharCol)
-> (Integer -> CharCol)
-> Num 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
Eq CharCol
-> (CharCol -> CharCol -> Ordering)
-> (CharCol -> CharCol -> Bool)
-> (CharCol -> CharCol -> Bool)
-> (CharCol -> CharCol -> Bool)
-> (CharCol -> CharCol -> Bool)
-> (CharCol -> CharCol -> CharCol)
-> (CharCol -> CharCol -> CharCol)
-> Ord 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
$cp1Ord :: Eq CharCol
Ord)

data GChar
  = C Char           -- ^ half- or full-width character
  | CZ [Char] Char   -- ^ character preceded by zero-width chars
  | WP               -- ^ padding for wide characters
  | Missing          -- ^ padding for short lines
  deriving stock (GChar -> GChar -> Bool
(GChar -> GChar -> Bool) -> (GChar -> GChar -> Bool) -> Eq GChar
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)

-- | Converts a list of lines into a char array.
toCharGrid :: [Text] -> CharGrid
toCharGrid :: [Text] -> CharGrid
toCharGrid [Text]
lines =
  let chars :: Int
chars = (Text -> Int -> Int) -> Int -> [Text] -> Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Text
t Int
m -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
m (Text -> Int
T.length Text
t)) Int
0 [Text]
lines -- potential overcount
      gbounds :: ((CharRow, CharCol), (CharRow, CharCol))
gbounds = ( (Int -> CharRow
CharRow Int
1, Int -> CharCol
CharCol Int
1)
                , (Int -> CharRow
CharRow ([Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
lines), Int -> CharCol
CharCol Int
chars)
                )
      toGChars :: String -> [GChar]
toGChars []     = GChar -> [GChar]
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 GChar -> [GChar] -> [GChar]
forall a. a -> [a] -> [a]
: GChar
WP GChar -> [GChar] -> [GChar]
forall a. a -> [a] -> [a]
: String -> [GChar]
toGChars String
cs
        Int
1 -> Char -> GChar
C Char
c GChar -> [GChar] -> [GChar]
forall a. a -> [a] -> [a]
: String -> [GChar]
toGChars String
cs
        Int
_ -> case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (Int -> Bool) -> (Char -> Int) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
charWidth) String
cs of
               (String
zw, [])     -> [String -> Char -> GChar
CZ (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
zw) Char
'\0']
               (String
zw, Char
c':String
cs') -> String -> Char -> GChar
CZ (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
zw) Char
c' GChar -> [GChar] -> [GChar]
forall a. a -> [a] -> [a]
:
                               case Char -> Int
charWidth Char
c' of
                                 Int
2 -> GChar
WP GChar -> [GChar] -> [GChar]
forall a. a -> [a] -> [a]
: String -> [GChar]
toGChars String
cs'
                                 Int
_ -> String -> [GChar]
toGChars String
cs'
      extendedLines :: [[GChar]]
extendedLines = (Text -> [GChar]) -> [Text] -> [[GChar]]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> [GChar] -> [GChar]
forall a. Int -> [a] -> [a]
take Int
chars ([GChar] -> [GChar]) -> (Text -> [GChar]) -> Text -> [GChar]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [GChar]
toGChars (String -> [GChar]) -> (Text -> String) -> Text -> [GChar]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) [Text]
lines
  in ((CharRow, CharCol), (CharRow, CharCol)) -> [GChar] -> CharGrid
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray ((CharRow, CharCol), (CharRow, CharCol))
gbounds ([[GChar]] -> [GChar]
forall a. Monoid a => [a] -> a
mconcat [[GChar]]
extendedLines)

-- | Information on, and extracted from, a body separator line. This is a line
-- that uses @=@ instead of @-@ to demark cell borders.
data PartSeparator = PartSeparator
  { PartSeparator -> CharRow
partSepLine    :: CharRow
  , PartSeparator -> [ColSpec]
partSepColSpec :: [ColSpec]
  }

-- | Alignment and character grid position of a column.
data ColSpec = ColSpec
  { ColSpec -> CharCol
colStart :: CharCol
  , ColSpec -> CharCol
colEnd   :: CharCol
  , ColSpec -> Alignment
colAlign :: Alignment
  }

-- | Finds the row indices of all separator lines, i.e., lines that
-- contain only @+@ and @=@ characters.
findSeparators :: CharGrid -> [PartSeparator]
findSeparators :: CharGrid -> [PartSeparator]
findSeparators CharGrid
charGrid = (CharRow -> [PartSeparator] -> [PartSeparator])
-> [PartSeparator] -> [CharRow] -> [PartSeparator]
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 = CharGrid -> ((CharRow, CharCol), (CharRow, CharCol))
forall i e. Array i e -> (i, i)
bounds CharGrid
charGrid
    rowIdxs :: [CharRow]
rowIdxs = [(CharRow, CharCol) -> CharRow
forall a b. (a, b) -> a
fst (((CharRow, CharCol), (CharRow, CharCol)) -> (CharRow, CharCol)
forall a b. (a, b) -> a
fst ((CharRow, CharCol), (CharRow, CharCol))
gbounds) .. (CharRow, CharCol) -> CharRow
forall a b. (a, b) -> a
fst (((CharRow, CharCol), (CharRow, CharCol)) -> (CharRow, CharCol)
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 PartSeparator -> [PartSeparator] -> [PartSeparator]
forall a. a -> [a] -> [a]
: [PartSeparator]
seps

-- | Checks for a separator in the given line, returning the column properties
-- if it finds such a line.
colSpecsInLine :: Char  -- ^ Character used in line (usually @-@)
               -> CharGrid -> CharRow -> Maybe [ColSpec]
colSpecsInLine :: Char -> CharGrid -> CharRow -> Maybe [ColSpec]
colSpecsInLine Char
c CharGrid
charGrid CharRow
i =
  case CharGrid
charGrid CharGrid -> (CharRow, CharCol) -> GChar
forall i e. Ix i => Array i e -> i -> e
! (CharRow
i, CharCol
firstCol) of
    C Char
'+' -> [ColSpec] -> CharCol -> Maybe [ColSpec]
loop [] (CharCol
firstCol CharCol -> CharCol -> CharCol
forall a. Num a => a -> a -> a
+ CharCol
1)
    GChar
_     -> Maybe [ColSpec]
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      -> Maybe [ColSpec]
forall a. Maybe a
Nothing
                   Just Maybe ColSpec
Nothing -> [ColSpec] -> Maybe [ColSpec]
forall a. a -> Maybe a
Just ([ColSpec] -> Maybe [ColSpec]) -> [ColSpec] -> Maybe [ColSpec]
forall a b. (a -> b) -> a -> b
$ [ColSpec] -> [ColSpec]
forall a. [a] -> [a]
reverse [ColSpec]
acc
                   Just (Just ColSpec
colspec) ->
                     [ColSpec] -> CharCol -> Maybe [ColSpec]
loop (ColSpec
colspecColSpec -> [ColSpec] -> [ColSpec]
forall a. a -> [a] -> [a]
:[ColSpec]
acc) (ColSpec -> CharCol
colEnd ColSpec
colspec CharCol -> CharCol -> CharCol
forall a. Num a => a -> a -> a
+ CharCol
1)
    gbounds :: ((CharRow, CharCol), (CharRow, CharCol))
gbounds = CharGrid -> ((CharRow, CharCol), (CharRow, CharCol))
forall i e. Array i e -> (i, i)
bounds CharGrid
charGrid
    firstCol :: CharCol
firstCol = (CharRow, CharCol) -> CharCol
forall a b. (a, b) -> b
snd (((CharRow, CharCol), (CharRow, CharCol)) -> (CharRow, CharCol)
forall a b. (a, b) -> a
fst ((CharRow, CharCol), (CharRow, CharCol))
gbounds)
    lastCol :: CharCol
lastCol = (CharRow, CharCol) -> CharCol
forall a b. (a, b) -> b
snd (((CharRow, CharCol), (CharRow, CharCol)) -> (CharRow, CharCol)
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 CharCol -> CharCol -> Bool
forall a. Ord a => a -> a -> Bool
>= CharCol
lastCol = Maybe ColSpec -> Maybe (Maybe ColSpec)
forall a. a -> Maybe a
Just Maybe ColSpec
forall a. Maybe a
Nothing
      | Bool
otherwise = case CharCol -> Maybe (CharCol, Bool)
findEnd (CharCol
j CharCol -> CharCol -> CharCol
forall a. Num a => a -> a -> a
+ CharCol
1) of
          Maybe (CharCol, Bool)
Nothing               -> Maybe (Maybe ColSpec)
forall a. Maybe a
Nothing
          Just (CharCol
end, Bool
rightMark) ->
            let leftMark :: Bool
leftMark = CharGrid
charGrid CharGrid -> (CharRow, CharCol) -> GChar
forall i e. Ix i => Array i e -> i -> e
! (CharRow
i, CharCol
j) GChar -> GChar -> Bool
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 :: CharCol -> CharCol -> Alignment -> ColSpec
ColSpec
                  { colStart :: CharCol
colStart = CharCol
j
                  , colEnd :: CharCol
colEnd = CharCol
end
                  , colAlign :: Alignment
colAlign = Alignment
align
                  }
            in Maybe ColSpec -> Maybe (Maybe ColSpec)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ColSpec -> Maybe ColSpec
forall (f :: * -> *) a. Applicative f => a -> f a
pure ColSpec
colspec)
    findEnd :: CharCol -> Maybe (CharCol, Bool)
findEnd CharCol
j = case CharGrid
charGrid CharGrid -> (CharRow, CharCol) -> GChar
forall i e. Ix i => Array i e -> i -> e
! (CharRow
i, CharCol
j) of
      C Char
'+' -> (CharCol, Bool) -> Maybe (CharCol, Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CharCol
j, Bool
False)
      C Char
':' -> if CharGrid
charGrid CharGrid -> (CharRow, CharCol) -> GChar
forall i e. Ix i => Array i e -> i -> e
! (CharRow
i, CharCol
j CharCol -> CharCol -> CharCol
forall a. Num a => a -> a -> a
+ CharCol
1) GChar -> GChar -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> GChar
C Char
'+'
                  then (CharCol, Bool) -> Maybe (CharCol, Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CharCol
j CharCol -> CharCol -> CharCol
forall a. Num a => a -> a -> a
+ CharCol
1, Bool
True)
                  else Maybe (CharCol, Bool)
forall a. Maybe a
Nothing
      C Char
c'
        | Char
c' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c -> CharCol -> Maybe (CharCol, Bool)
findEnd (CharCol
j CharCol -> CharCol -> CharCol
forall a. Num a => a -> a -> a
+ CharCol
1)
      GChar
_           -> Maybe (CharCol, Bool)
forall a. Maybe a
Nothing

-- | Returns new character grid in which the given lines have been
-- converted to normal cell-separating lines.
convertToNormalLines :: [CharRow] -> CharGrid -> CharGrid
convertToNormalLines :: [CharRow] -> CharGrid -> CharGrid
convertToNormalLines [CharRow]
sepLines CharGrid
charGrid = (forall s. ST s (STArray s (CharRow, CharCol) GChar)) -> CharGrid
forall i e. (forall s. ST s (STArray s i e)) -> Array i e
runSTArray ((forall s. ST s (STArray s (CharRow, CharCol) GChar)) -> CharGrid)
-> (forall s. ST s (STArray s (CharRow, CharCol) GChar))
-> CharGrid
forall a b. (a -> b) -> a -> b
$ do
  STArray s (CharRow, CharCol) GChar
mutGrid <- CharGrid -> ST s (STArray s (CharRow, CharCol) GChar)
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 = CharGrid -> ((CharRow, CharCol), (CharRow, CharCol))
forall i e. Array i e -> (i, i)
bounds CharGrid
charGrid
      cols :: [CharCol]
cols = [(CharRow, CharCol) -> CharCol
forall a b. (a, b) -> b
snd (((CharRow, CharCol), (CharRow, CharCol)) -> (CharRow, CharCol)
forall a b. (a, b) -> a
fst ((CharRow, CharCol), (CharRow, CharCol))
gbounds) .. (CharRow, CharCol) -> CharCol
forall a b. (a, b) -> b
snd (((CharRow, CharCol), (CharRow, CharCol)) -> (CharRow, CharCol)
forall a b. (a, b) -> b
snd ((CharRow, CharCol), (CharRow, CharCol))
gbounds)]
  [CharRow] -> (CharRow -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [CharRow]
sepLines ((CharRow -> ST s ()) -> ST s ())
-> (CharRow -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \CharRow
rowidx -> do
    [CharCol] -> (CharCol -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [CharCol]
cols ((CharCol -> ST s ()) -> ST s ())
-> (CharCol -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \CharCol
colidx -> do
      let idx :: (CharRow, CharCol)
idx = (CharRow
rowidx, CharCol
colidx)
      GChar
c <- STArray s (CharRow, CharCol) GChar
-> (CharRow, CharCol) -> ST s GChar
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
      -- convert `=` to `-` and remove alignment markers
      case GChar
c of
        C Char
'=' -> STArray s (CharRow, CharCol) GChar
-> (CharRow, CharCol) -> GChar -> ST s ()
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
':' -> STArray s (CharRow, CharCol) GChar
-> (CharRow, CharCol) -> GChar -> ST s ()
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
_        -> () -> ST s ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  STArray s (CharRow, CharCol) GChar
-> ST s (STArray s (CharRow, CharCol) GChar)
forall (m :: * -> *) a. Monad m => a -> m a
return STArray s (CharRow, CharCol) GChar
mutGrid

-- | Info on the grid. Used to keep track of information collected while
-- tracing a character grid. The set of cells is used as a kind of queue
-- during parsing, while the other data is required to assemble the
-- final table.
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
  }

-- | Initial tracing info.
initialTraceInfo :: TraceInfo
initialTraceInfo :: TraceInfo
initialTraceInfo = TraceInfo :: Set CharRow
-> Set CharCol
-> Set (CharRow, CharCol)
-> Set CellTrace
-> TraceInfo
TraceInfo
  { gridRowSeps :: Set CharRow
gridRowSeps = [CharRow] -> Set CharRow
forall a. Ord a => [a] -> Set a
Set.fromList [Int -> CharRow
CharRow Int
1]
  , gridColSeps :: Set CharCol
gridColSeps = [CharCol] -> Set CharCol
forall a. Ord a => [a] -> Set a
Set.fromList [Int -> CharCol
CharCol Int
1]
  , gridCorners :: Set (CharRow, CharCol)
gridCorners = [(CharRow, CharCol)] -> Set (CharRow, CharCol)
forall a. Ord a => [a] -> Set a
Set.fromList [(Int -> CharRow
CharRow Int
1, Int -> CharCol
CharCol Int
1)]
  , gridCells :: Set CellTrace
gridCells   = [CellTrace] -> Set CellTrace
forall a. Ord a => [a] -> Set a
Set.fromList []
  }

-- | Trace the given char grid and collect all relevant info.
-- This function calls itself recursively.
traceCharGrid :: CharGrid
              -> TraceInfo
              -> TraceInfo
traceCharGrid :: CharGrid -> TraceInfo -> TraceInfo
traceCharGrid CharGrid
charGrid TraceInfo
traceInfo =
  -- Get the next corner an remove it from the set of unparsed corners.
  case Set (CharRow, CharCol)
-> Maybe ((CharRow, CharCol), Set (CharRow, CharCol))
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 ->
          -- Corner is not a top-left corner of another cell. Continue
          -- with the remaining corners.
          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 (TraceInfo -> TraceInfo) -> TraceInfo -> TraceInfo
forall a b. (a -> b) -> a -> b
$ TraceInfo :: Set CharRow
-> Set CharCol
-> Set (CharRow, CharCol)
-> Set CellTrace
-> TraceInfo
TraceInfo
            { gridRowSeps :: Set CharRow
gridRowSeps = Set CharRow
newrowseps Set CharRow -> Set CharRow -> Set CharRow
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set CharRow
rowseps
            , gridColSeps :: Set CharCol
gridColSeps = Set CharCol
newcolseps Set CharCol -> Set CharCol -> Set CharCol
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set CharCol
colseps
            , gridCorners :: Set (CharRow, CharCol)
gridCorners = (CharRow, CharCol)
-> Set (CharRow, CharCol) -> Set (CharRow, CharCol)
forall a. Ord a => a -> Set a -> Set a
Set.insert (CharRow
top, CharCol
right) (Set (CharRow, CharCol) -> Set (CharRow, CharCol))
-> Set (CharRow, CharCol) -> Set (CharRow, CharCol)
forall a b. (a -> b) -> a -> b
$
                            (CharRow, CharCol)
-> Set (CharRow, CharCol) -> Set (CharRow, CharCol)
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 CellTrace -> Set CellTrace -> Set CellTrace
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

-- | Traces a single cell on the grid, starting at the given position.
traceCell :: CharGrid -> CharIndex -> Maybe ScanResult
traceCell :: CharGrid -> (CharRow, CharCol) -> Maybe ScanResult
traceCell = CharGrid -> (CharRow, CharCol) -> Maybe ScanResult
scanRight

-- | Scans right from the given index, following a cell separator line
-- to the next column marker (@+@), then scans down. Returns the
-- bottom-right index of the cell if it can complete the trace, and
-- nothing if it reaches the end of line before the trace is complete.
--
-- All row and column markers found during scanning are seen are
-- collected and returned as part of the result.
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 Set CharCol
forall a. Set a
Set.empty (CharCol
left CharCol -> CharCol -> CharCol
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 (CharGrid -> ((CharRow, CharCol), (CharRow, CharCol))
forall i e. Array i e -> (i, i)
bounds CharGrid
charGrid ((CharRow, CharCol), (CharRow, CharCol))
-> (CharRow, CharCol) -> Bool
forall a. Ix a => (a, a) -> a -> Bool
`inRange` (CharRow
top, CharCol
j)) = Maybe ScanResult
forall a. Maybe a
Nothing
      | Bool
otherwise = case CharGrid
charGrid CharGrid -> (CharRow, CharCol) -> GChar
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 CharCol -> CharCol -> CharCol
forall a. Num a => a -> a -> a
+ CharCol
1)
          C Char
'+' ->
            let colseps' :: Set CharCol
colseps' = CharCol -> Set CharCol -> Set CharCol
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 CharCol -> CharCol -> CharCol
forall a. Num a => a -> a -> a
+ CharCol
1)
                 Just ((CharRow, CharCol)
end, Set CharRow
rowseps, Set CharCol
newcolseps) -> ScanResult -> Maybe ScanResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                   ( (CharRow, CharCol)
end
                   , Set CharRow
rowseps
                   , Set CharCol
colseps' Set CharCol -> Set CharCol -> Set CharCol
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set CharCol
newcolseps
                   )
          GChar
_ -> Maybe ScanResult
forall a. Maybe a
Nothing

-- | Like 'scanRight', but scans down in the given column.
scanDown :: CharGrid
         -> CharIndex  -- ^ top-left corner of cell
         -> CharCol    -- ^ column of the cell's right border
         -> 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 Set CharRow
forall a. Set a
Set.empty (CharRow
top CharRow -> CharRow -> CharRow
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 (CharGrid -> ((CharRow, CharCol), (CharRow, CharCol))
forall i e. Array i e -> (i, i)
bounds CharGrid
charGrid ((CharRow, CharCol), (CharRow, CharCol))
-> (CharRow, CharCol) -> Bool
forall a. Ix a => (a, a) -> a -> Bool
`inRange` (CharRow
i, CharCol
right))
      then Maybe ScanResult
forall a. Maybe a
Nothing
      else case CharGrid
charGrid CharGrid -> (CharRow, CharCol) -> GChar
forall i e. Ix i => Array i e -> i -> e
! (CharRow
i, CharCol
right) of
             C Char
'+' ->
               let rowseps' :: Set CharRow
rowseps' = CharRow -> Set CharRow -> Set CharRow
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 CharRow -> CharRow -> CharRow
forall a. Num a => a -> a -> a
+ CharRow
1)
                    Just (Set CharRow
newrowseps, Set CharCol
colseps) ->
                      ScanResult -> Maybe ScanResult
forall a. a -> Maybe a
Just ( (CharRow
i, CharCol
right)
                           , Set CharRow
rowseps' Set CharRow -> Set CharRow -> Set CharRow
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 CharRow -> CharRow -> CharRow
forall a. Num a => a -> a -> a
+ CharRow
1)
             GChar
_ -> -- all but the final column must be terminated
               if CharCol
right CharCol -> CharCol -> Bool
forall a. Eq a => a -> a -> Bool
== (CharRow, CharCol) -> CharCol
forall a b. (a, b) -> b
snd (((CharRow, CharCol), (CharRow, CharCol)) -> (CharRow, CharCol)
forall a b. (a, b) -> b
snd (CharGrid -> ((CharRow, CharCol), (CharRow, CharCol))
forall i e. Array i e -> (i, i)
bounds CharGrid
charGrid))
               then Set CharRow -> CharRow -> Maybe ScanResult
loop Set CharRow
rowseps (CharRow
i CharRow -> CharRow -> CharRow
forall a. Num a => a -> a -> a
+ CharRow
1)
               else Maybe ScanResult
forall a. Maybe a
Nothing

-- | Like 'scanRight', but scans left starting at the bottom-right
-- corner.
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 = Maybe (Set CharCol)
forall a. Maybe a
Nothing
       go CharCol
j (Just Set CharCol
colseps) = case CharGrid
charGrid CharGrid -> (CharRow, CharCol) -> GChar
forall i e. Ix i => Array i e -> i -> e
! (CharRow
bottom, CharCol
j) of
                               C Char
'+' -> Set CharCol -> Maybe (Set CharCol)
forall a. a -> Maybe a
Just (CharCol -> Set CharCol -> Set CharCol
forall a. Ord a => a -> Set a -> Set a
Set.insert CharCol
j Set CharCol
colseps)
                               C Char
'-' -> Set CharCol -> Maybe (Set CharCol)
forall a. a -> Maybe a
Just Set CharCol
colseps
                               GChar
_        -> Maybe (Set CharCol)
forall a. Maybe a
Nothing

  in if CharGrid
charGrid CharGrid -> (CharRow, CharCol) -> GChar
forall i e. Ix i => Array i e -> i -> e
! (CharRow
bottom, CharCol
left) GChar -> GChar -> Bool
forall a. Eq a => a -> a -> Bool
/= Char -> GChar
C Char
'+'
     then Maybe (Set CharRow, Set CharCol)
forall a. Maybe a
Nothing
     else
       case (CharCol -> Maybe (Set CharCol) -> Maybe (Set CharCol))
-> Maybe (Set CharCol) -> [CharCol] -> Maybe (Set CharCol)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr CharCol -> Maybe (Set CharCol) -> Maybe (Set CharCol)
go (Set CharCol -> Maybe (Set CharCol)
forall a. a -> Maybe a
Just Set CharCol
forall a. Set a
Set.empty) [(CharCol
right CharCol -> CharCol -> CharCol
forall a. Num a => a -> a -> a
- CharCol
1), CharCol
right CharCol -> CharCol -> CharCol
forall a. Num a => a -> a -> a
- CharCol
2 .. (CharCol
left CharCol -> CharCol -> CharCol
forall a. Num a => a -> a -> a
+ CharCol
1)] of
         Maybe (Set CharCol)
Nothing      -> Maybe (Set CharRow, Set CharCol)
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 -> (Set CharRow, Set CharCol) -> Maybe (Set CharRow, Set CharCol)
forall a. a -> Maybe a
Just (Set CharRow
rowseps, Set CharCol
colseps)
             Maybe (Set CharRow)
Nothing      -> Maybe (Set CharRow, Set CharCol)
forall a. Maybe a
Nothing

-- | Scans up from the bottom-left corner back to the top-left corner.
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 = Maybe (Set CharRow)
forall a. Maybe a
Nothing
      go CharRow
i (Just Set CharRow
rowseps) = case CharGrid
charGrid CharGrid -> (CharRow, CharCol) -> GChar
forall i e. Ix i => Array i e -> i -> e
! (CharRow
i, CharCol
left) of
                              C Char
'+' -> Set CharRow -> Maybe (Set CharRow)
forall a. a -> Maybe a
Just (CharRow -> Set CharRow -> Set CharRow
forall a. Ord a => a -> Set a -> Set a
Set.insert CharRow
i Set CharRow
rowseps)
                              C Char
'|' -> Set CharRow -> Maybe (Set CharRow)
forall a. a -> Maybe a
Just Set CharRow
rowseps
                              GChar
_        -> Maybe (Set CharRow)
forall a. Maybe a
Nothing
  in (CharRow -> Maybe (Set CharRow) -> Maybe (Set CharRow))
-> Maybe (Set CharRow) -> [CharRow] -> Maybe (Set CharRow)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr CharRow -> Maybe (Set CharRow) -> Maybe (Set CharRow)
go (Set CharRow -> Maybe (Set CharRow)
forall a. a -> Maybe a
Just Set CharRow
forall a. Set a
Set.empty) [CharRow
bottom CharRow -> CharRow -> CharRow
forall a. Num a => a -> a -> a
- CharRow
1, CharRow
bottom CharRow -> CharRow -> CharRow
forall a. Num a => a -> a -> a
- CharRow
2 .. CharRow
top CharRow -> CharRow -> CharRow
forall a. Num a => a -> a -> a
+ CharRow
1]

-- | Gets the textual contents, i.e. the lines of a cell.
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 CharRow -> CharRow -> CharRow
forall a. Num a => a -> a -> a
+ CharRow
1 .. CharRow
bottom CharRow -> CharRow -> CharRow
forall a. Num a => a -> a -> a
- CharRow
1]
      colIdxs :: [CharCol]
colIdxs = [CharCol
left CharCol -> CharCol -> CharCol
forall a. Num a => a -> a -> a
+ CharCol
1 .. CharCol
right CharCol -> CharCol -> CharCol
forall a. Num a => a -> a -> a
- CharCol
1]
      toChars :: CharRow -> CharCol -> String
toChars CharRow
rowIdx CharCol
colIdx = case CharGrid
charGrid CharGrid -> (CharRow, CharCol) -> GChar
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 String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
c]
        GChar
_       -> []
  in (CharRow -> Text) -> [CharRow] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\CharRow
ir -> String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ (CharCol -> String) -> [CharCol] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (CharRow -> CharCol -> String
toChars CharRow
ir) [CharCol]
colIdxs)
         [CharRow]
rowIdxs

-- | Traced cell with raw contents and border positions.
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
(CellTrace -> CellTrace -> Bool)
-> (CellTrace -> CellTrace -> Bool) -> Eq CellTrace
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
(Int -> CellTrace -> ShowS)
-> (CellTrace -> String)
-> ([CellTrace] -> ShowS)
-> Show CellTrace
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 (CharRow -> CharRow -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (CharRow -> CharRow -> Ordering)
-> (CellTrace -> CharRow) -> CellTrace -> CellTrace -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` CellTrace -> CharRow
cellTraceTop) CellTrace
x CellTrace
y of
      Ordering
EQ -> (CharCol -> CharCol -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (CharCol -> CharCol -> Ordering)
-> (CellTrace -> CharCol) -> CellTrace -> CellTrace -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` CellTrace -> CharCol
cellTraceLeft) CellTrace
x CellTrace
y
      Ordering
o  -> Ordering
o

-- | Create a final grid table from line scanning data.
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 = Set CharRow -> [CharRow]
forall a. Set a -> [a]
Set.toAscList (Set CharRow -> [CharRow]) -> Set CharRow -> [CharRow]
forall a b. (a -> b) -> a -> b
$ TraceInfo -> Set CharRow
gridRowSeps TraceInfo
traceInfo
      colseps :: [CharCol]
colseps = Set CharCol -> [CharCol]
forall a. Set a -> [a]
Set.toAscList (Set CharCol -> [CharCol]) -> Set CharCol -> [CharCol]
forall a b. (a -> b) -> a -> b
$ TraceInfo -> Set CharCol
gridColSeps TraceInfo
traceInfo
      rowindex :: Map CharRow RowIndex
rowindex = [(CharRow, RowIndex)] -> Map CharRow RowIndex
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(CharRow, RowIndex)] -> Map CharRow RowIndex)
-> [(CharRow, RowIndex)] -> Map CharRow RowIndex
forall a b. (a -> b) -> a -> b
$ [CharRow] -> [RowIndex] -> [(CharRow, RowIndex)]
forall a b. [a] -> [b] -> [(a, b)]
zip [CharRow]
rowseps [RowIndex
1..]
      colindex :: Map CharCol ColIndex
colindex = [(CharCol, ColIndex)] -> Map CharCol ColIndex
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(CharCol, ColIndex)] -> Map CharCol ColIndex)
-> [(CharCol, ColIndex)] -> Map CharCol ColIndex
forall a b. (a -> b) -> a -> b
$ [CharCol] -> [ColIndex] -> [(CharCol, ColIndex)]
forall a b. [a] -> [b] -> [(a, b)]
zip [CharCol]
colseps [ColIndex
1..]
      colwidths :: [CharCol]
colwidths = [ CharCol
b CharCol -> CharCol -> CharCol
forall a. Num a => a -> a -> a
- CharCol
a CharCol -> CharCol -> CharCol
forall a. Num a => a -> a -> a
- CharCol
1 | (CharCol
b, CharCol
a) <- [CharCol] -> [CharCol] -> [(CharCol, CharCol)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([CharCol] -> [CharCol]
forall a. [a] -> [a]
tail [CharCol]
colseps) [CharCol]
colseps ]
      colSpecs :: [(Alignment, Int)]
colSpecs = [Alignment] -> [Int] -> [(Alignment, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip
                 ((ColSpec -> Alignment) -> [ColSpec] -> [Alignment]
forall a b. (a -> b) -> [a] -> [b]
map ColSpec -> Alignment
colAlign
                   (case [PartSeparator]
partSeps of
                       PartSeparator
partSep:[PartSeparator]
_ -> PartSeparator -> [ColSpec]
partSepColSpec PartSeparator
partSep
                       []        -> [ColSpec] -> Maybe [ColSpec] -> [ColSpec]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [ColSpec]
colSpecsFirstLine)
                   [Alignment] -> [Alignment] -> [Alignment]
forall a. [a] -> [a] -> [a]
++ Alignment -> [Alignment]
forall a. a -> [a]
repeat Alignment
AlignDefault)
                 ((CharCol -> Int) -> [CharCol] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map CharCol -> Int
fromCharCol [CharCol]
colwidths)
      lastCol :: ColIndex
lastCol = Int -> ColIndex
ColIndex ([CharCol] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CharCol]
colwidths)
      tableHead :: Maybe RowIndex
tableHead = RowIndex -> RowIndex -> RowIndex
forall a. Num a => a -> a -> a
subtract RowIndex
1 (RowIndex -> RowIndex) -> Maybe RowIndex -> Maybe RowIndex
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                  (PartSeparator -> Maybe RowIndex -> Maybe RowIndex)
-> Maybe RowIndex -> [PartSeparator] -> Maybe RowIndex
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Maybe RowIndex -> Maybe RowIndex -> Maybe RowIndex
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) (Maybe RowIndex -> Maybe RowIndex -> Maybe RowIndex)
-> (PartSeparator -> Maybe RowIndex)
-> PartSeparator
-> Maybe RowIndex
-> Maybe RowIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CharRow -> Map CharRow RowIndex -> Maybe RowIndex
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map CharRow RowIndex
rowindex) (CharRow -> Maybe RowIndex)
-> (PartSeparator -> CharRow) -> PartSeparator -> Maybe RowIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PartSeparator -> CharRow
partSepLine)
                        Maybe RowIndex
forall a. Maybe a
Nothing
                        [PartSeparator]
partSeps
  in ArrayTable :: forall a.
Array CellIndex (GridCell a)
-> Maybe RowIndex
-> Array ColIndex (Alignment, Int)
-> ArrayTable a
ArrayTable
     { arrayTableCells :: Array CellIndex (GridCell [Text])
arrayTableCells = (forall s. ST s (STArray s CellIndex (GridCell [Text])))
-> Array CellIndex (GridCell [Text])
forall i e. (forall s. ST s (STArray s i e)) -> Array i e
runSTArray (TraceInfo
-> Map CharRow RowIndex
-> Map CharCol ColIndex
-> ST s (STArray s CellIndex (GridCell [Text]))
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
     , arrayTableColSpecs :: Array ColIndex (Alignment, Int)
arrayTableColSpecs = (ColIndex, ColIndex)
-> [(Alignment, Int)] -> Array ColIndex (Alignment, Int)
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (ColIndex
1, ColIndex
lastCol) [(Alignment, Int)]
colSpecs
     }

-- | Create a mutable cell array from the scanning data.
toMutableArray :: TraceInfo
               -> Map.Map CharRow RowIndex
               -> Map.Map CharCol ColIndex
               -> ST s (STArray s CellIndex (GridCell [Text]))
toMutableArray :: 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 = Map CharRow RowIndex -> Int
forall k a. Map k a -> Int
Map.size Map CharRow RowIndex
rowindex Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
  let ncols :: Int
ncols = Map CharCol ColIndex -> Int
forall k a. Map k a -> Int
Map.size Map CharCol ColIndex
colindex Int -> Int -> Int
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 <- (CellIndex, CellIndex)
-> BuilderCell -> ST s (STArray s CellIndex BuilderCell)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (CellIndex, CellIndex)
gbounds BuilderCell
FreeCell
  [CellTrace] -> (CellTrace -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Set CellTrace -> [CellTrace]
forall a. Set a -> [a]
Set.toAscList (Set CellTrace -> [CellTrace]) -> Set CellTrace -> [CellTrace]
forall a b. (a -> b) -> a -> b
$ TraceInfo -> Set CellTrace
gridCells TraceInfo
traceInfo) ((CellTrace -> ST s ()) -> ST s ())
-> (CellTrace -> ST s ()) -> ST s ()
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 <- CharRow -> Map CharRow RowIndex -> Maybe RowIndex
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup CharRow
top Map CharRow RowIndex
rowindex
            ColIndex
cnum <- CharCol -> Map CharCol ColIndex -> Maybe ColIndex
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup CharCol
left Map CharCol ColIndex
colindex
            RowSpan
rs   <- Int -> RowSpan
RowSpan (Int -> RowSpan) -> (RowIndex -> Int) -> RowIndex -> RowSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RowIndex -> Int
fromRowIndex (RowIndex -> Int) -> (RowIndex -> RowIndex) -> RowIndex -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RowIndex -> RowIndex -> RowIndex
forall a. Num a => a -> a -> a
subtract RowIndex
rnum (RowIndex -> RowSpan) -> Maybe RowIndex -> Maybe RowSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                    CharRow -> Map CharRow RowIndex -> Maybe RowIndex
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup CharRow
bottom Map CharRow RowIndex
rowindex
            ColSpan
cs   <- Int -> ColSpan
ColSpan (Int -> ColSpan) -> (ColIndex -> Int) -> ColIndex -> ColSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColIndex -> Int
fromColIndex (ColIndex -> Int) -> (ColIndex -> ColIndex) -> ColIndex -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColIndex -> ColIndex -> ColIndex
forall a. Num a => a -> a -> a
subtract ColIndex
cnum (ColIndex -> ColSpan) -> Maybe ColIndex -> Maybe ColSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                    CharCol -> Map CharCol ColIndex -> Maybe ColIndex
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup CharCol
right Map CharCol ColIndex
colindex
            (CellIndex, RowSpan, ColSpan)
-> Maybe (CellIndex, RowSpan, ColSpan)
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 -> String -> (CellIndex, RowSpan, ColSpan)
forall a. HasCallStack => String -> a
error String
"A cell or row index was not found"
      STArray s CellIndex BuilderCell
-> CellIndex -> BuilderCell -> ST s ()
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 (BuilderCell -> ST s ())
-> (GridCell [Text] -> BuilderCell) -> GridCell [Text] -> ST s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GridCell [Text] -> BuilderCell
FilledCell (GridCell [Text] -> ST s ()) -> GridCell [Text] -> ST s ()
forall a b. (a -> b) -> a -> b
$
        RowSpan -> ColSpan -> [Text] -> GridCell [Text]
forall a. RowSpan -> ColSpan -> a -> GridCell a
ContentCell RowSpan
rowspan ColSpan
colspan [Text]
content
      [CellIndex] -> (CellIndex -> ST s ()) -> ST s ()
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) ((CellIndex -> ST s ()) -> ST s ())
-> (CellIndex -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \CellIndex
contIdx -> do
        -- FIXME: ensure that the cell has not been filled yet
        STArray s CellIndex BuilderCell
-> CellIndex -> BuilderCell -> ST s ()
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 (BuilderCell -> ST s ()) -> BuilderCell -> ST s ()
forall a b. (a -> b) -> a -> b
$
          GridCell [Text] -> BuilderCell
FilledCell (CellIndex -> GridCell [Text]
forall a. CellIndex -> GridCell a
ContinuationCell CellIndex
idx)
      -- Swap BuilderCells with normal GridCells.
  let fromBuilderCell :: BuilderCell -> GridCell [Text]
      fromBuilderCell :: BuilderCell -> GridCell [Text]
fromBuilderCell = \case
        FilledCell GridCell [Text]
c -> GridCell [Text]
c
        BuilderCell
FreeCell     -> String -> GridCell [Text]
forall a. HasCallStack => String -> a
error String
"Found an unassigned cell."
  STArray s CellIndex BuilderCell -> ST s [(CellIndex, BuilderCell)]
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> m [(i, e)]
getAssocs STArray s CellIndex BuilderCell
tblgrid ST s [(CellIndex, BuilderCell)]
-> ([(CellIndex, BuilderCell)] -> ST s ()) -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\[(CellIndex, BuilderCell)]
kvs -> [(CellIndex, BuilderCell)]
-> ((CellIndex, BuilderCell) -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(CellIndex, BuilderCell)]
kvs (((CellIndex, BuilderCell) -> ST s ()) -> ST s ())
-> ((CellIndex, BuilderCell) -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \(CellIndex
idx, BuilderCell
bc) ->
    case BuilderCell
bc of
      BuilderCell
FreeCell -> String -> ST s ()
forall a. HasCallStack => String -> a
error (String -> ST s ()) -> String -> ST s ()
forall a b. (a -> b) -> a -> b
$ String
"unassigned: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CellIndex -> String
forall a. Show a => a -> String
show CellIndex
idx
      BuilderCell
_ -> () -> ST s ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
  (BuilderCell -> GridCell [Text])
-> STArray s CellIndex BuilderCell
-> ST s (STArray s CellIndex (GridCell [Text]))
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

-- | Calculate the array indices that are spanned by a cell.
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)]
                                , Int
c <- [Int
cidx..(Int
cidx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
cs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)]
                                , (Int
r, Int
c) (Int, Int) -> (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
/= (Int
ridx, Int
cidx)]

-- | Helper type used to track which indices have been already been
-- filled in a mutable cell array.
data BuilderCell
  = FilledCell (GridCell [Text])
  | FreeCell