{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}

module Language.Ltml.Parser.Table
    ( tableP
    )
where

import Data.Array (Array, array, bounds, (!), (//))
import Data.Text (pack)
import qualified Data.Text as T
import Language.Lsd.AST.Common (Keyword (Keyword))
import Language.Lsd.AST.SimpleRegex (Disjunction (Disjunction), Star (Star))
import Language.Lsd.AST.Type.Table
    ( CellFormat
    , CellType (CellType)
    , DefaultCellType (DefaultCellType)
    , RowType (RowType)
    , TableType (TableType)
    )
import Language.Ltml.AST.Table
    ( Cell (..)
    , Row (..)
    , Table (..)
    )
import Language.Ltml.AST.Text (TableTextTree, TextTree (Word))
import Language.Ltml.Parser (Parser)
import Language.Ltml.Parser.Common.Lexeme (nLexeme)
import Language.Ltml.Parser.Text (textForestP)
import Text.Megaparsec
    ( MonadParsec (hidden, takeWhileP, try)
    , choice
    , errorBundlePretty
    , manyTill
    , optional
    , runParser
    , some
    , (<|>)
    )
import Text.Megaparsec.Char (space, string)
import Text.Megaparsec.Char.Lexer (decimal)

cellP :: Keyword -> CellType -> Parser Cell'
cellP :: Keyword -> CellType -> Parser Cell'
cellP (Keyword Text
tkw) (CellType (Keyword Text
ckw) CellFormat
fmt TextType Void
tt) = do
    Tokens Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (Text
tkw Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ckw)
    ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
    -- Take everything until we *see* a table boundary
    Text
chunk <- Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP (String -> Maybe String
forall a. a -> Maybe a
Just String
"cell text") (Token Text -> [Token Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char
'|'])
    if
        | Text -> Bool
T.null Text
chunk -> Cell' -> Parser Cell'
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Cell' -> Parser Cell') -> Cell' -> Parser Cell'
forall a b. (a -> b) -> a -> b
$ CellFormat -> Cell'' -> Cell'
Cell' CellFormat
fmt ([TableTextTree] -> Cell''
Cell'' [])
        | Text -> Text
T.strip Text
chunk Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"<" -> Cell' -> Parser Cell'
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Cell' -> Parser Cell') -> Cell' -> Parser Cell'
forall a b. (a -> b) -> a -> b
$ CellFormat -> Cell'' -> Cell'
Cell' CellFormat
fmt Cell''
MergeLeft
        | Text -> Text
T.strip Text
chunk Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"^" -> Cell' -> Parser Cell'
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Cell' -> Parser Cell') -> Cell' -> Parser Cell'
forall a b. (a -> b) -> a -> b
$ CellFormat -> Cell'' -> Cell'
Cell' CellFormat
fmt Cell''
MergeUp
        | Bool
otherwise ->
            case Parsec Void Text [TableTextTree]
-> String
-> Text
-> Either (ParseErrorBundle Text Void) [TableTextTree]
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser (TextType Void -> Parsec Void Text [TableTextTree]
forall (m :: * -> *) lbrk fnref style enumType enum special.
(ParserWrapper m, LineBreakP lbrk, FootnoteRefP fnref,
 StyleP style, EnumP enumType enum, SpecialP m special) =>
TextType enumType -> m [TextTree lbrk fnref style enum special]
textForestP TextType Void
tt) String
"" (Text
chunk Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n") of
                Left ParseErrorBundle Text Void
err -> Cell' -> Parser Cell'
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Cell' -> Parser Cell') -> Cell' -> Parser Cell'
forall a b. (a -> b) -> a -> b
$ CellFormat -> Cell'' -> Cell'
Cell' CellFormat
fmt ([TableTextTree] -> Cell''
Cell'' [Text -> TableTextTree
forall lbrk fnref style enum special.
Text -> TextTree lbrk fnref style enum special
Word (Text -> TableTextTree) -> Text -> TableTextTree
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle Text Void
err])
                Right [TableTextTree]
forest -> Cell' -> Parser Cell'
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Cell' -> Parser Cell') -> Cell' -> Parser Cell'
forall a b. (a -> b) -> a -> b
$ CellFormat -> Cell'' -> Cell'
Cell' CellFormat
fmt ([TableTextTree] -> Cell''
Cell'' [TableTextTree]
forest)

-- parse a row ending with |&
rowP :: Keyword -> DefaultCellType -> RowType -> Parser Row'
rowP :: Keyword -> DefaultCellType -> RowType -> Parser Row'
rowP k :: Keyword
k@(Keyword Text
tkw) (DefaultCellType CellType
defaultCellT) (RowType (Keyword Text
rkw) (Star (Disjunction [CellType]
t))) = do
    [Cell']
cells <-
        ParsecT Void Text Identity [Cell']
-> ParsecT Void Text Identity [Cell']
forall (m :: * -> *) a. MonadParser m => m a -> m a
nLexeme (ParsecT Void Text Identity [Cell']
 -> ParsecT Void Text Identity [Cell'])
-> ParsecT Void Text Identity [Cell']
-> ParsecT Void Text Identity [Cell']
forall a b. (a -> b) -> a -> b
$
            Parser Cell'
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity [Cell']
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill
                ( [Parser Cell'] -> Parser Cell'
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
                    ((CellType -> Parser Cell') -> [CellType] -> [Parser Cell']
forall a b. (a -> b) -> [a] -> [b]
map (Keyword -> CellType -> Parser Cell'
cellP Keyword
k) [CellType]
t)
                    Parser Cell' -> Parser Cell' -> Parser Cell'
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Keyword -> CellType -> Parser Cell'
cellP Keyword
k CellType
defaultCellT
                )
                (ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (Text
tkw Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rkw)))
    -- _ <- string (tkw <> rkw)
    Row' -> Parser Row'
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Cell'] -> Row'
Row' [Cell']
cells)

-- parse an entire table
tableP :: TableType -> Parser Table
tableP :: TableType -> Parser Table
tableP (TableType Keyword
kw DefaultCellType
defaultCellT (Star RowType
t)) = do
    ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
    Maybe [Int]
mProps <- ParsecT Void Text Identity [Int]
-> ParsecT Void Text Identity (Maybe [Int])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text Identity [Int]
 -> ParsecT Void Text Identity (Maybe [Int]))
-> ParsecT Void Text Identity [Int]
-> ParsecT Void Text Identity (Maybe [Int])
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity [Int]
-> ParsecT Void Text Identity [Int]
forall (m :: * -> *) a. MonadParser m => m a -> m a
nLexeme (ParsecT Void Text Identity [Int]
 -> ParsecT Void Text Identity [Int])
-> ParsecT Void Text Identity [Int]
-> ParsecT Void Text Identity [Int]
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity Int -> ParsecT Void Text Identity [Int]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT Void Text Identity Int
propP
    [Row']
nRows <- ParsecT Void Text Identity [Row']
-> ParsecT Void Text Identity [Row']
forall (m :: * -> *) a. MonadParser m => m a -> m a
nLexeme (ParsecT Void Text Identity [Row']
 -> ParsecT Void Text Identity [Row'])
-> ParsecT Void Text Identity [Row']
-> ParsecT Void Text Identity [Row']
forall a b. (a -> b) -> a -> b
$ Parser Row' -> ParsecT Void Text Identity [Row']
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (Keyword -> DefaultCellType -> RowType -> Parser Row'
rowP Keyword
kw DefaultCellType
defaultCellT RowType
t)
    ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
    -- _ <- char '&'
    Table -> Parser Table
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [Int] -> DefaultCellType -> Table' -> Table
mergeCells Maybe [Int]
mProps DefaultCellType
defaultCellT (Table' -> Table) -> Table' -> Table
forall a b. (a -> b) -> a -> b
$ [Row'] -> Table'
Table' [Row']
nRows)
  where
    propP :: Parser Int
    propP :: ParsecT Void Text Identity Int
propP = do
        Tokens Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"|="
        ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
        Int
n <- ParsecT Void Text Identity Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal
        ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
        Int -> ParsecT Void Text Identity Int
forall a. a -> ParsecT Void Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n

-- the rawly parsed representation of a table
newtype Table' = Table' {Table' -> [Row']
unTable' :: [Row']}

newtype Row' = Row' {Row' -> [Cell']
unRow' :: [Cell']}

data Cell' = Cell' CellFormat Cell''

data Cell'' = Cell'' [TableTextTree] | MergeLeft | MergeUp
    deriving (Int -> Cell'' -> ShowS
[Cell''] -> ShowS
Cell'' -> String
(Int -> Cell'' -> ShowS)
-> (Cell'' -> String) -> ([Cell''] -> ShowS) -> Show Cell''
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Cell'' -> ShowS
showsPrec :: Int -> Cell'' -> ShowS
$cshow :: Cell'' -> String
show :: Cell'' -> String
$cshowList :: [Cell''] -> ShowS
showList :: [Cell''] -> ShowS
Show)

instance Eq Cell'' where
    (Cell'' [TableTextTree]
_) == :: Cell'' -> Cell'' -> Bool
== (Cell'' [TableTextTree]
_) = Bool
True
    Cell''
MergeLeft == Cell''
MergeLeft = Bool
True
    Cell''
MergeUp == Cell''
MergeUp = Bool
True
    Cell''
_ == Cell''
_ = Bool
False

-- everything to merge cells and compute spans

type Matrix a = Array (Int, Int) a
type Visited = Array (Int, Int) VisitedCell
type Position = (Int, Int)
data VisitedCell = Unvisited | Visited | InSpan Int deriving (Int -> VisitedCell -> ShowS
[VisitedCell] -> ShowS
VisitedCell -> String
(Int -> VisitedCell -> ShowS)
-> (VisitedCell -> String)
-> ([VisitedCell] -> ShowS)
-> Show VisitedCell
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VisitedCell -> ShowS
showsPrec :: Int -> VisitedCell -> ShowS
$cshow :: VisitedCell -> String
show :: VisitedCell -> String
$cshowList :: [VisitedCell] -> ShowS
showList :: [VisitedCell] -> ShowS
Show)

instance Eq VisitedCell where
    VisitedCell
Unvisited == :: VisitedCell -> VisitedCell -> Bool
== VisitedCell
Unvisited = Bool
True
    VisitedCell
Visited == VisitedCell
Visited = Bool
True
    (InSpan {}) == (InSpan {}) = Bool
True
    VisitedCell
_ == VisitedCell
_ = Bool
False

mergeCells :: Maybe [Int] -> DefaultCellType -> Table' -> Table
mergeCells :: Maybe [Int] -> DefaultCellType -> Table' -> Table
mergeCells Maybe [Int]
mProps (DefaultCellType CellType
defaultCellT) Table'
table =
    let matrix' :: Array (Int, Int) Cell
matrix' =
            ((Int, Int), (Int, Int))
-> [((Int, Int), Cell)] -> Array (Int, Int) Cell
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array
                ((Int
0, Int
0), (Int
nRows, Int
mCols))
                [((Int
row, Int
col), Cell
emptyEntry) | Int
row <- [Int
0 .. Int
nRows], Int
col <- [Int
0 .. Int
mCols]]
        visited0 :: Array (Int, Int) VisitedCell
visited0 =
            ((Int, Int), (Int, Int))
-> [((Int, Int), VisitedCell)] -> Array (Int, Int) VisitedCell
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array
                ((Int
0, Int
0), (Int
nRows, Int
mCols))
                [((Int
row, Int
col), VisitedCell
Unvisited) | Int
row <- [Int
0 .. Int
nRows], Int
col <- [Int
0 .. Int
mCols]]
     in Maybe [Int] -> [Row] -> Table
Table Maybe [Int]
mProps ([Row] -> Table) -> [Row] -> Table
forall a b. (a -> b) -> a -> b
$ Array (Int, Int) Cell -> [Row]
arrayToTable (Array (Int, Int) Cell -> [Row]) -> Array (Int, Int) Cell -> [Row]
forall a b. (a -> b) -> a -> b
$ (Array (Int, Int) VisitedCell, Array (Int, Int) Cell)
-> Array (Int, Int) Cell
forall a b. (a, b) -> b
snd ((Array (Int, Int) VisitedCell, Array (Int, Int) Cell)
 -> Array (Int, Int) Cell)
-> (Array (Int, Int) VisitedCell, Array (Int, Int) Cell)
-> Array (Int, Int) Cell
forall a b. (a -> b) -> a -> b
$ (Int, Int)
-> (Array (Int, Int) VisitedCell, Array (Int, Int) Cell)
-> (Array (Int, Int) VisitedCell, Array (Int, Int) Cell)
process (Int
0, Int
0) (Array (Int, Int) VisitedCell
visited0, Array (Int, Int) Cell
matrix')
  where
    table' :: Table'
table' = CellType -> Table' -> Table'
padTable CellType
defaultCellT Table'
table
    rawMatrix :: Matrix Cell'
rawMatrix = Table' -> Matrix Cell'
tableToArray Table'
table'
    ((Int
0, Int
0), (Int
nRows, Int
mCols)) = Matrix Cell' -> ((Int, Int), (Int, Int))
forall i e. Array i e -> (i, i)
bounds Matrix Cell'
rawMatrix
    emptyEntry :: Cell
emptyEntry = Cell
HSpannedCell

    unpackCell' :: Cell' -> Cell''
unpackCell' (Cell' CellFormat
_ Cell''
c) = Cell''
c

    maxWidth :: Position -> Int
    maxWidth :: (Int, Int) -> Int
maxWidth (Int
row, Int
col) =
        (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$
            [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$
                (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile
                    (\Int
col' -> Int
col' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
mCols Bool -> Bool -> Bool
&& Cell' -> Cell''
unpackCell' (Matrix Cell'
rawMatrix Matrix Cell' -> (Int, Int) -> Cell'
forall i e. Ix i => Array i e -> i -> e
! (Int
row, Int
col')) Cell'' -> Cell'' -> Bool
forall a. Eq a => a -> a -> Bool
== Cell''
MergeLeft)
                    [Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 .. Int
mCols]

    maxHeight :: Position -> Int -> Int
    maxHeight :: (Int, Int) -> Int -> Int
maxHeight (Int
row, Int
col) Int
w =
        (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$
            [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$
                (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile
                    ( \Int
row' ->
                        Int
row' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
nRows
                            Bool -> Bool -> Bool
&& Cell' -> Cell''
unpackCell' (Matrix Cell'
rawMatrix Matrix Cell' -> (Int, Int) -> Cell'
forall i e. Ix i => Array i e -> i -> e
! (Int
row', Int
col)) Cell'' -> Cell'' -> Bool
forall a. Eq a => a -> a -> Bool
== Cell''
MergeUp
                            Bool -> Bool -> Bool
&& (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all
                                ( \Int
col' ->
                                    let val :: Cell''
val = Cell' -> Cell''
unpackCell' (Matrix Cell'
rawMatrix Matrix Cell' -> (Int, Int) -> Cell'
forall i e. Ix i => Array i e -> i -> e
! (Int
row', Int
col'))
                                     in Cell''
val Cell'' -> Cell'' -> Bool
forall a. Eq a => a -> a -> Bool
== Cell''
MergeLeft Bool -> Bool -> Bool
|| Cell''
val Cell'' -> Cell'' -> Bool
forall a. Eq a => a -> a -> Bool
== Cell''
MergeUp
                                )
                                [Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 .. Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
                    )
                    [Int
row Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 .. Int
nRows]

    -- updateVisited :: Position -> (Visited, Matrix Cell) -> (Visited, Matrix Cell)
    -- updateVisited p0 (visited, mat) = (\p -> p == p0 || visited p, mat)
    -- updateVisited :: Position -> (Visited, Matrix Cell) -> (Visited, Matrix Cell)
    -- updateVisited p0 (visited, mat) = (\p -> p == p0 || visited p, mat)

    updateMatrix
        :: Position -> Cell -> (Visited, Matrix Cell) -> (Visited, Matrix Cell)
    updateMatrix :: (Int, Int)
-> Cell
-> (Array (Int, Int) VisitedCell, Array (Int, Int) Cell)
-> (Array (Int, Int) VisitedCell, Array (Int, Int) Cell)
updateMatrix (Int, Int)
pos Cell
val (Array (Int, Int) VisitedCell
visited, Array (Int, Int) Cell
mat) = (Array (Int, Int) VisitedCell
visited, Array (Int, Int) Cell
mat Array (Int, Int) Cell
-> [((Int, Int), Cell)] -> Array (Int, Int) Cell
forall i e. Ix i => Array i e -> [(i, e)] -> Array i e
// [((Int, Int)
pos, Cell
val)])

    process :: Position -> (Visited, Matrix Cell) -> (Visited, Matrix Cell)
    process :: (Int, Int)
-> (Array (Int, Int) VisitedCell, Array (Int, Int) Cell)
-> (Array (Int, Int) VisitedCell, Array (Int, Int) Cell)
process (Int
row, Int
col) s :: (Array (Int, Int) VisitedCell, Array (Int, Int) Cell)
s@(Array (Int, Int) VisitedCell
visited, Array (Int, Int) Cell
matrix)
        | Int
row Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
nRows = (Array (Int, Int) VisitedCell, Array (Int, Int) Cell)
s
        | Int
col Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mCols = (Int, Int)
-> (Array (Int, Int) VisitedCell, Array (Int, Int) Cell)
-> (Array (Int, Int) VisitedCell, Array (Int, Int) Cell)
process (Int
row Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
0) (Array (Int, Int) VisitedCell, Array (Int, Int) Cell)
s
        | Array (Int, Int) VisitedCell
visited Array (Int, Int) VisitedCell -> (Int, Int) -> VisitedCell
forall i e. Ix i => Array i e -> i -> e
! (Int
row, Int
col) VisitedCell -> VisitedCell -> Bool
forall a. Eq a => a -> a -> Bool
== VisitedCell
Visited = (Int, Int)
-> (Array (Int, Int) VisitedCell, Array (Int, Int) Cell)
-> (Array (Int, Int) VisitedCell, Array (Int, Int) Cell)
process (Int
row, Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Array (Int, Int) VisitedCell, Array (Int, Int) Cell)
s
        | Array (Int, Int) VisitedCell
visited Array (Int, Int) VisitedCell -> (Int, Int) -> VisitedCell
forall i e. Ix i => Array i e -> i -> e
! (Int
row, Int
col) VisitedCell -> VisitedCell -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> VisitedCell
InSpan Int
0 -- this is safe, regard the def of Eq VisitedCell. (even though maybe a little dirty...)
            =
            let InSpan Int
w = Array (Int, Int) VisitedCell
visited Array (Int, Int) VisitedCell -> (Int, Int) -> VisitedCell
forall i e. Ix i => Array i e -> i -> e
! (Int
row, Int
col)
                matrix' :: Array (Int, Int) Cell
matrix' = Array (Int, Int) Cell
matrix Array (Int, Int) Cell
-> [((Int, Int), Cell)] -> Array (Int, Int) Cell
forall i e. Ix i => Array i e -> [(i, e)] -> Array i e
// [((Int
row, Int
col), Int -> Cell
VSpannedCell Int
w)]
             in (Int, Int)
-> (Array (Int, Int) VisitedCell, Array (Int, Int) Cell)
-> (Array (Int, Int) VisitedCell, Array (Int, Int) Cell)
process (Int
row, Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Array (Int, Int) VisitedCell
visited, Array (Int, Int) Cell
matrix')
        | Bool
otherwise =
            let createCell :: CellFormat
-> [TableTextTree]
-> (Array (Int, Int) VisitedCell, Array (Int, Int) Cell)
createCell CellFormat
fmt [TableTextTree]
content =
                    let w :: Int
w = (Int, Int) -> Int
maxWidth (Int
row, Int
col)
                        h :: Int
h = (Int, Int) -> Int -> Int
maxHeight (Int
row, Int
col) Int
w
                        s' :: (Array (Int, Int) VisitedCell, Array (Int, Int) Cell)
s' =
                            ((Array (Int, Int) VisitedCell, Array (Int, Int) Cell)
 -> (Int, Int)
 -> (Array (Int, Int) VisitedCell, Array (Int, Int) Cell))
-> (Array (Int, Int) VisitedCell, Array (Int, Int) Cell)
-> [(Int, Int)]
-> (Array (Int, Int) VisitedCell, Array (Int, Int) Cell)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl
                                ( \(Array (Int, Int) VisitedCell
v, Array (Int, Int) Cell
m) (Int
x, Int
y) ->
                                    ( if Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
col Bool -> Bool -> Bool
&& Int
row Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
x
                                        then Array (Int, Int) VisitedCell
v Array (Int, Int) VisitedCell
-> [((Int, Int), VisitedCell)] -> Array (Int, Int) VisitedCell
forall i e. Ix i => Array i e -> [(i, e)] -> Array i e
// [((Int
x, Int
y), Int -> VisitedCell
InSpan Int
w)]
                                        else Array (Int, Int) VisitedCell
v Array (Int, Int) VisitedCell
-> [((Int, Int), VisitedCell)] -> Array (Int, Int) VisitedCell
forall i e. Ix i => Array i e -> [(i, e)] -> Array i e
// [((Int
x, Int
y), VisitedCell
Visited)]
                                    , Array (Int, Int) Cell
m
                                    )
                                )
                                (Array (Int, Int) VisitedCell, Array (Int, Int) Cell)
s
                                [ (Int
row', Int
col')
                                | Int
col' <- [Int
col .. Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
                                , Int
row' <- [Int
row .. Int
row Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
                                ]
                     in (Int, Int)
-> Cell
-> (Array (Int, Int) VisitedCell, Array (Int, Int) Cell)
-> (Array (Int, Int) VisitedCell, Array (Int, Int) Cell)
updateMatrix (Int
row, Int
col) (CellFormat -> [TableTextTree] -> Int -> Int -> Cell
Cell CellFormat
fmt [TableTextTree]
content Int
w Int
h) (Array (Int, Int) VisitedCell, Array (Int, Int) Cell)
s'
                res :: (Array (Int, Int) VisitedCell, Array (Int, Int) Cell)
res = case Matrix Cell'
rawMatrix Matrix Cell' -> (Int, Int) -> Cell'
forall i e. Ix i => Array i e -> i -> e
! (Int
row, Int
col) of
                    Cell' CellFormat
fmt Cell''
MergeLeft -> CellFormat
-> [TableTextTree]
-> (Array (Int, Int) VisitedCell, Array (Int, Int) Cell)
createCell CellFormat
fmt [Text -> TableTextTree
forall lbrk fnref style enum special.
Text -> TextTree lbrk fnref style enum special
Word Text
"<"]
                    Cell' CellFormat
fmt Cell''
MergeUp -> CellFormat
-> [TableTextTree]
-> (Array (Int, Int) VisitedCell, Array (Int, Int) Cell)
createCell CellFormat
fmt [Text -> TableTextTree
forall lbrk fnref style enum special.
Text -> TextTree lbrk fnref style enum special
Word Text
"^"]
                    Cell' CellFormat
fmt (Cell'' [TableTextTree]
content) -> CellFormat
-> [TableTextTree]
-> (Array (Int, Int) VisitedCell, Array (Int, Int) Cell)
createCell CellFormat
fmt [TableTextTree]
content
             in (Int, Int)
-> (Array (Int, Int) VisitedCell, Array (Int, Int) Cell)
-> (Array (Int, Int) VisitedCell, Array (Int, Int) Cell)
process (Int
row, Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Array (Int, Int) VisitedCell, Array (Int, Int) Cell)
res

    -- Convert array back to list of lists (optional)
    arrayToTable :: Matrix Cell -> [Row]
    arrayToTable :: Array (Int, Int) Cell -> [Row]
arrayToTable Array (Int, Int) Cell
arr =
        let ((Int
i0, Int
j0), (Int
in_, Int
jn)) = Array (Int, Int) Cell -> ((Int, Int), (Int, Int))
forall i e. Array i e -> (i, i)
bounds Array (Int, Int) Cell
arr
         in [[Cell] -> Row
Row [Array (Int, Int) Cell
arr Array (Int, Int) Cell -> (Int, Int) -> Cell
forall i e. Ix i => Array i e -> i -> e
! (Int
row, Int
col) | Int
col <- [Int
j0 .. Int
jn]] | Int
row <- [Int
i0 .. Int
in_]]

-- Convert a list of lists to an array
tableToArray :: Table' -> Matrix Cell'
tableToArray :: Table' -> Matrix Cell'
tableToArray Table'
t =
    let nRows :: Int
nRows = [Row'] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Table' -> [Row']
unTable' Table'
t) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        mCols :: Int
mCols = if Int
nRows Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Int
0 else [Cell'] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Row' -> [Cell']
unRow' ([Row'] -> Row'
forall a. HasCallStack => [a] -> a
head (Table' -> [Row']
unTable' Table'
t))) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
     in ((Int, Int), (Int, Int)) -> [((Int, Int), Cell')] -> Matrix Cell'
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array
            ((Int
0, Int
0), (Int
nRows, Int
mCols))
            [((Int
row, Int
col), Int -> Int -> Cell'
getCell Int
row Int
col) | Int
row <- [Int
0 .. Int
nRows], Int
col <- [Int
0 .. Int
mCols]]
  where
    rows :: [Row']
rows = Table' -> [Row']
unTable' Table'
t
    getCell :: Int -> Int -> Cell'
getCell Int
row Int
col = Row' -> [Cell']
unRow' ([Row']
rows [Row'] -> Int -> Row'
forall a. HasCallStack => [a] -> Int -> a
!! Int
row) [Cell'] -> Int -> Cell'
forall a. HasCallStack => [a] -> Int -> a
!! Int
col

-- pad nRows to equal length
padTable :: CellType -> Table' -> Table'
padTable :: CellType -> Table' -> Table'
padTable (CellType Keyword
_ CellFormat
fmt TextType Void
_) (Table' [Row']
rows) =
    let maxLen :: Int
maxLen = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((Row' -> Int) -> [Row'] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Row' -> Int
rowLen [Row']
rows)
     in [Row'] -> Table'
Table' ((Row' -> Row') -> [Row'] -> [Row']
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Row' -> Row'
padRow Int
maxLen) [Row']
rows)
  where
    rowLen :: Row' -> Int
rowLen (Row' [Cell']
cs) = [Cell'] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Cell']
cs
    padRow :: Int -> Row' -> Row'
padRow Int
row (Row' [Cell']
cs) =
        [Cell'] -> Row'
Row' ([Cell']
cs [Cell'] -> [Cell'] -> [Cell']
forall a. [a] -> [a] -> [a]
++ Int -> Cell' -> [Cell']
forall a. Int -> a -> [a]
replicate (Int
row Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Cell'] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Cell']
cs) (CellFormat -> Cell'' -> Cell'
Cell' CellFormat
fmt ([TableTextTree] -> Cell''
Cell'' [])))

{-
Example table Ltml representation:
\|* <*PHF-phil-BA1>         |* <*Philosophische Fach- und Vermittlungskompetenzen>                                    |<|<|<|<|<|<|&
\| <*Semesterlage>          | <*Dauer>                 |<|<| <*Status> | <*Zugangsvoraussetzung> | <*LP/Workload>               |<|&
\| 1. und 2. Semester       | 2 Semester               |<|<| Pflicht   | -                       | 9 LP / 270 Stunden           |<|&
\| <*Lehrveranstaltunge(n)> | <*Lehrform> | <*SWS> | <*LP> | <*Status> | <*Prüfungsleistungen>   | <*Bewertungsart> | <*Wichtung> |&
\| Einführung in die
  Philosophie              | Vorlesung   | 2      | 2     | Pflicht   | -                       | -                | -           |&
\| Logik, Argumentation,
  Sprache                  | *Seminar    | 2      | 4     | Pflicht   | Take-home-Klausur (ca.
                                                                        5 Seiten) oder Klausur
                                                                        (3 Std.)                | unbenotet        | -           |&
\| Einführung in das
  Verfassen
  wissenschaftlicher
  Texte im Fach
  Philosophie              | *Übung      | 2      | 3     | Wahl-
                                                            pflicht   | Portfolio-Leistungen    | unbenotet        | -           |&
\| Einführung in die
  Interpretation
  philosophischer Texte    | *Übung      | 2      | 3     | Wahl-
                                                            pflicht   | Portfolio-Leistungen    | unbenotet        | -           |&
\| <*Weitere Angaben> {nl}
  Die Studierenden wählen eine der beiden Übungen. {nl}
  *=Anwesenheitspflicht                                                                                             |<|<|<|<|<|<|<|&
\|* <*PHF-phil-BA2>         |* <*Geschichte der Philosophie>                                                           |<|<|<|<|<|<|&
\| <*Semesterlage>          | <*Dauer>                 |<|<| <*Status> | <*Zugangsvoraussetzung>| <*LP/Workload>                 |<|&
\| 1. und 2. Semester       | 2 Semester               |<|<| Pflicht   | -                      | 6 LP / 180 Stunden             |<|&
\| <*Lehrveranstaltunge(n)> | <*Lehrform> | <*SWS> | <*LP> | <*Status> | <*Prüfungsleistungen>  | <*Bewertungsart>   | <*Wichtung> |&
\| Zentrale Themen der
  Philosophie der Antike
  / des Mittelalters       |Seminar      | 2      | 2     | Pflicht   | Protokoll              | unbenotet          | -           |&
\| Zentrale Themen der
  Philosophie der Neuzeit
  / des 20. Jahrhunderts   |Seminar      | 2      | 2     | Pflicht   | Protokoll              | unbenotet          | -           |&
\| <*Weitere Angaben> {nl}
  Die Wahl der Epoche ist mit der Anmeldung zu den Prüfungen verbindlich.                                           |<|<|<|<|<|<|<|&
\|* <*PHF-phil-BA3>         |* <*Einführung in die Theoretische Philosophie>                                           |<|<|<|<|<|<|&
\| <*Semesterlage>          | <*Dauer>                 |<|<| <*Status> | <*Zugangsvoraussetzung>| <*LP/Workload>                 |<|&
\| 1. und 2. Semester       | 1 Semester               |<|<| Pflicht   | -                      | 5 LP / 150 Stunden             |<|&
\| <*Lehrveranstaltunge(n)> | <*Lehrform> | <*SWS> | <*LP> | <*Status> | <*Prüfungsleistungen>  | <*Bewertungsart>   | <*Wichtung> |&
\| Einführung in die
  theoretische Philosophie |Vorlesung    | 2      | 2     | Pflicht   | Take-home-Klausur (ca.
                                                                        5 Seiten) im Rahmen
                                                                        des Seminars           | unbenotet          | -           |&
\| Einführung in die
  theoretische Philosophie |Seminar      | 2      | 3     | Pflicht   | ^                      | ^                  | ^           |&

Example 2:

// headings
\|*
\|* <*Bereich>
\|* <*Modul~(Modulcode)>~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
\|* <*SWS und Veranstaltungs-form>
\|* <*Prüfungs-leistung>{^:fn1}
\|* <*LP {nl} Modul>
\|* <*LP Bereich>
\|&
// Pflicht
// VWL
\|* Pflicht-bereich
\| VWL
\| EInführung in die Volkswirtschaftslehre (VWL-EVWL)
\| 4V+2Ü
\| K
\| 10
\| 35
\|&
\| ^
\| ^
\| Grundzüge der mikroökonomischen Theorie I (VWLvwlMikro1-01a)
\| 2V+ 1-2Ü
\| K
\| 5
\| ^
\|&
\| ^
\| ^
\| Grundzüge der mikroökonomischen Theorie II (VWLvwlMikro1-02a)
\| 2V+ 1-2Ü
\| K
\| 5
\| ^
\|&
\| ^
\| ^
\| Grundzüge der makroökonomischen Theorie I (VWLvwlMakro1-01a)
\| 2V+ 1-2Ü
\| K
\| 5
\| ^
\|&
\| ^
\| ^
\| Grundzüge der makroökonomischen Theorie II (VWLvwlMakro1-02a)
\| 2V+ 1-2Ü
\| K
\| 5
\| ^
\|&
\| ^
\| ^
\| Einführung in die Wirtschaftspolitik (VWLvwlEiWiPo-01a)
\| 2V
\| K
\| 5
\| ^
\|&
// BWL
\| ^
\| BWL
\| Grundlagen der Betriebswirtschaftslehre (BWL-GrundBWL)
\| 2V+1Ü
\| K
\| 5
\| 20
\|&
\| ^
\| ^
\| Buchführung und Abschnluss (BWL-BA)
\| 2V+ 1Ü
\| K
\| 5
\| ^
\|&
\| ^
\| ^
\| Jahresabschluss (BWL-JA)
\| 2V+ 1Ü
\| K
\| 5
\| ^
\|&
\| ^
\| ^
\| Grundlagen der Finanzwirtschaft (BWL-Fiwi1)
\| 2V+ 1Ü
\| K
\| 5
\| ^
\|&
// Mathe etc
\| ^
\| Mathematik, Statistik und Ökonometrie
\| Mathematik I (VWL-MATH1)
\| 2V+2Ü
\| K
\| 5
\| 35
\|&
\| ^
\| ^
\| Mathematik II (VWL-MATH2)
\| 2V+ 2Ü
\| K
\| 5
\| ^
\|&
\| ^
\| ^
\| Methodenlehre der Statistik I (VWL-STAT1)
\| 4V+ 2Ü
\| K
\| 10
\| ^
\|&
\| ^
\| ^
\| Methodenlehre der Statistik II (VWL-STAT2)
\| 4V + 2Ü + 1PC
\| K
\| 10
\| ^
\|&
\| ^
\| ^
\| Einführung in die Ökonometrie (VWL-EIÖK)
\| 2V + 1Ü + 1PC
\| K
\| 5
\| ^
\|&
// Wiss. Arbeiten
\| ^
\| Wiss. Arbeiten
\| Wissenschaftliches Arbeiten (VWLwiWiAr-01a)
\| 2Ü
\| MP
\| 5
\| 5
\|&
// Wahlfplichtbereich
// VWL
\|* Wahl-pflicht-bereich
\| VWL
\| Wahlpflichtmodul 1
\| 2V + 0-2Ü
\| MP
\| 5
\| 40 bis 60
\|&
\| ^
\| ^
\| Wahlpflichtmodul 2
\| 2V + 0-2Ü
\| MP
\| 5
\| ^
\|&
\| ^
\| ^
\| Wahlpflichtmodul 3
\| 2V + 0-2Ü
\| MP
\| 5
\| ^
\|&
\| ^
\| ^
\| Wahlpflichtmodul 4
\| 2V + 0-2Ü
\| MP
\| 5
\| ^
\|&
\| ^
\| ^
\| Wahlpflichtmodul 5
\| 2V + 0-2Ü
\| MP
\| 5
\| ^
\|&
\| ^
\| ^
\| Wahlpflichtmodul 6 oder Seminar 3
\| 2V + 0-2Ü oder 2 S{^:fn2}
\| MP oder S
\| 5
\| ^
\|&
\| ^
\| ^
\| Seminar 1
\| 2 S{^:fn2}
\| S
\| 5
\| ^
\|&
\| ^
\| ^
\| Seminar 2
\| 2 S{^:fn2}
\| S
\| 5
\| ^
\|&
// BWL
\| ^
\| BWL
\| Wahlpflichtmodul 1
\| 2V + 0-2Ü
\| MP
\| 5
\| 10 bis 20{^:fn4}
\|&
\| ^
\| ^
\| Wahlpflichtmodul 2
\| 2V + 0-2Ü
\| MP
\| 5
\| ^
\|&
// Datenanalyse
\| ^
\| Datenanalyse
\| Wahlpflichtmodul
\| 2V + 0-2Ü + 0-1PC
\| MP
\| 5
\| 5 bist 10
\|&
// Ergänzungsbereich
\| ^
\| Ergänzungsbereich
\| Die wählbaren Module werden rechtzeitig und in geeigneter Weise bekannt gemacht.
\| <
\| <
\| verschieden
\| 0 bis 20{^:fn4}
\|&
\| Bachelorarbeit {^:fn3}
\| <
\| <
\| <
\| <
\| <
\| 10
\|&
\| Summe
\| <
\| <
\| <
\| <
\| <
\| 180
\|&

\^{fn1:} Die am schlechtesten bewerteten Module im Umfang von maximal 10 Leistungspunkten, mit Ausnahme der  Bachelorarbeit, werden in unbenotete Module umgewandelt, gemäß § 15 Abs. 3.

\^{fn2:} Regelmäßige Teilnahme gemäß § 12 Abs. 1 ist erforderlich

\^{fn3:} Für Zulassungsvoraussetzungen zur Bachelorarbeit siehe §14.

\^{fn4:} In Wahlfplichtbereich und Ergänzungsbereich dürfen insgesamt nicht mehr als 20 LP an BWL-Modulen erbracht werden.

-}