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

-- | 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
      -- The first separator can never be a part separator line (with
      -- =), but it can contain column alignment markers, so it is
      -- always normalized it as well.
      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 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
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)

-- | Character column
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           -- ^ 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
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)

-- | 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
  { 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
  }

-- | Converts a list of lines into a char array.
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 -- potential overcount
      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)

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

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

-- | 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 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
      -- convert `=` to `-` and remove alignment markers
      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

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

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

-- | 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 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
_ -> -- all but the final column must be terminated
               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

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

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

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

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

-- | 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 = 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
     }

-- | 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 :: 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
        -- FIXME: ensure that the cell has not been filled yet
        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)
      -- 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     ->
          -- Found an unassigned cell; replace with empty cell. TODO: This
          -- should be reported as a warning.
          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

-- | 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 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)]

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