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

Parse reStructuredText-style grid tables.
-}

module Text.GridTable
  ( module Text.GridTable.ArrayTable
    -- * Parse from character stream
  , gridTable
    -- * List-based representation
  , Cell (..)
  , rows
  ) where

import Prelude hiding (lines)
import Data.Array (Array, elems, bounds)
import Data.Bifunctor (bimap)
import Data.Maybe (mapMaybe)
import Text.GridTable.ArrayTable
import Text.GridTable.Parse (gridTable)

colBounds :: Array CellIndex a -> (ColIndex, ColIndex)
colBounds :: Array CellIndex a -> (ColIndex, ColIndex)
colBounds = (CellIndex -> ColIndex)
-> (CellIndex -> ColIndex)
-> (CellIndex, CellIndex)
-> (ColIndex, ColIndex)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap CellIndex -> ColIndex
forall a b. (a, b) -> b
snd CellIndex -> ColIndex
forall a b. (a, b) -> b
snd ((CellIndex, CellIndex) -> (ColIndex, ColIndex))
-> (Array CellIndex a -> (CellIndex, CellIndex))
-> Array CellIndex a
-> (ColIndex, ColIndex)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array CellIndex a -> (CellIndex, CellIndex)
forall i e. Array i e -> (i, i)
bounds

-- | Returns the rows of a grid table as lists of simple cells.
rows :: ArrayTable a -> [[Cell a]]
rows :: ArrayTable a -> [[Cell a]]
rows ArrayTable a
gt =
  let tarr :: Array CellIndex (GridCell a)
tarr = ArrayTable a -> Array CellIndex (GridCell a)
forall a. ArrayTable a -> Array CellIndex (GridCell a)
arrayTableCells ArrayTable a
gt
      ncols :: Int
ncols = ColIndex -> Int
fromColIndex (ColIndex -> Int)
-> ((ColIndex, ColIndex) -> ColIndex)
-> (ColIndex, ColIndex)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ColIndex -> ColIndex -> ColIndex)
-> (ColIndex, ColIndex) -> ColIndex
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((ColIndex -> ColIndex -> ColIndex)
-> ColIndex -> ColIndex -> ColIndex
forall a b c. (a -> b -> c) -> b -> a -> c
flip (-)) ((ColIndex, ColIndex) -> Int) -> (ColIndex, ColIndex) -> Int
forall a b. (a -> b) -> a -> b
$ Array CellIndex (GridCell a) -> (ColIndex, ColIndex)
forall a. Array CellIndex a -> (ColIndex, ColIndex)
colBounds Array CellIndex (GridCell a)
tarr
      toSimpleCell :: GridCell a -> Maybe (Cell a)
toSimpleCell = \case
        ContentCell RowSpan
rs ColSpan
cs a
c -> Cell a -> Maybe (Cell a)
forall a. a -> Maybe a
Just (Cell a -> Maybe (Cell a)) -> Cell a -> Maybe (Cell a)
forall a b. (a -> b) -> a -> b
$ a -> RowSpan -> ColSpan -> Cell a
forall a. a -> RowSpan -> ColSpan -> Cell a
Cell a
c RowSpan
rs ColSpan
cs
        ContinuationCell {} -> Maybe (Cell a)
forall a. Maybe a
Nothing
      mkRows :: [[Cell a]] -> [GridCell a] -> [[Cell a]]
      mkRows :: [[Cell a]] -> [GridCell a] -> [[Cell a]]
mkRows [[Cell a]]
rs = \case
        [] -> [[Cell a]] -> [[Cell a]]
forall a. [a] -> [a]
reverse [[Cell a]]
rs
        [GridCell a]
xs -> let ([GridCell a]
r, [GridCell a]
xs') = Int -> [GridCell a] -> ([GridCell a], [GridCell a])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
ncols Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [GridCell a]
xs
              in [[Cell a]] -> [GridCell a] -> [[Cell a]]
forall a. [[Cell a]] -> [GridCell a] -> [[Cell a]]
mkRows ((GridCell a -> Maybe (Cell a)) -> [GridCell a] -> [Cell a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe GridCell a -> Maybe (Cell a)
forall a. GridCell a -> Maybe (Cell a)
toSimpleCell [GridCell a]
r[Cell a] -> [[Cell a]] -> [[Cell a]]
forall a. a -> [a] -> [a]
:[[Cell a]]
rs) [GridCell a]
xs'
  in [[Cell a]] -> [GridCell a] -> [[Cell a]]
forall a. [[Cell a]] -> [GridCell a] -> [[Cell a]]
mkRows [] ([GridCell a] -> [[Cell a]]) -> [GridCell a] -> [[Cell a]]
forall a b. (a -> b) -> a -> b
$ Array CellIndex (GridCell a) -> [GridCell a]
forall i e. Array i e -> [e]
elems Array CellIndex (GridCell a)
tarr

-- | Raw grid table cell
data Cell a = Cell
  { Cell a -> a
cellContent :: a
  , Cell a -> RowSpan
cellRowSpan :: RowSpan
  , Cell a -> ColSpan
cellColSpan :: ColSpan
  }
  deriving stock (Cell a -> Cell a -> Bool
(Cell a -> Cell a -> Bool)
-> (Cell a -> Cell a -> Bool) -> Eq (Cell a)
forall a. Eq a => Cell a -> Cell a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cell a -> Cell a -> Bool
$c/= :: forall a. Eq a => Cell a -> Cell a -> Bool
== :: Cell a -> Cell a -> Bool
$c== :: forall a. Eq a => Cell a -> Cell a -> Bool
Eq, Eq (Cell a)
Eq (Cell a)
-> (Cell a -> Cell a -> Ordering)
-> (Cell a -> Cell a -> Bool)
-> (Cell a -> Cell a -> Bool)
-> (Cell a -> Cell a -> Bool)
-> (Cell a -> Cell a -> Bool)
-> (Cell a -> Cell a -> Cell a)
-> (Cell a -> Cell a -> Cell a)
-> Ord (Cell a)
Cell a -> Cell a -> Bool
Cell a -> Cell a -> Ordering
Cell a -> Cell a -> Cell a
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
forall a. Ord a => Eq (Cell a)
forall a. Ord a => Cell a -> Cell a -> Bool
forall a. Ord a => Cell a -> Cell a -> Ordering
forall a. Ord a => Cell a -> Cell a -> Cell a
min :: Cell a -> Cell a -> Cell a
$cmin :: forall a. Ord a => Cell a -> Cell a -> Cell a
max :: Cell a -> Cell a -> Cell a
$cmax :: forall a. Ord a => Cell a -> Cell a -> Cell a
>= :: Cell a -> Cell a -> Bool
$c>= :: forall a. Ord a => Cell a -> Cell a -> Bool
> :: Cell a -> Cell a -> Bool
$c> :: forall a. Ord a => Cell a -> Cell a -> Bool
<= :: Cell a -> Cell a -> Bool
$c<= :: forall a. Ord a => Cell a -> Cell a -> Bool
< :: Cell a -> Cell a -> Bool
$c< :: forall a. Ord a => Cell a -> Cell a -> Bool
compare :: Cell a -> Cell a -> Ordering
$ccompare :: forall a. Ord a => Cell a -> Cell a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Cell a)
Ord, Int -> Cell a -> ShowS
[Cell a] -> ShowS
Cell a -> String
(Int -> Cell a -> ShowS)
-> (Cell a -> String) -> ([Cell a] -> ShowS) -> Show (Cell a)
forall a. Show a => Int -> Cell a -> ShowS
forall a. Show a => [Cell a] -> ShowS
forall a. Show a => Cell a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cell a] -> ShowS
$cshowList :: forall a. Show a => [Cell a] -> ShowS
show :: Cell a -> String
$cshow :: forall a. Show a => Cell a -> String
showsPrec :: Int -> Cell a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Cell a -> ShowS
Show)