    {-# LANGUAGE DerivingStrategies #-}
    {-# LANGUAGE FlexibleContexts   #-}
    {- |
    Module      : Text.GridTable
    Copyright   : © 2022-2023 Posit Software, PBC
    License     : MIT
    Maintainer  : Albert Krewinkel <albert@zeitkraut.de>

    Parse reStructuredText-style grid tables.
    -}

    module Text.GridTable.Parse
      ( gridTable
      , tableLine
      ) where

    import Prelude hiding (lines)
    import Data.Text (Text)
    import Text.GridTable.ArrayTable
    import Text.GridTable.Trace (traceLines)
    import Text.Parsec
    import qualified Data.Text as T

    -- | Parses a grid table.
    gridTable :: Stream s m Char => ParsecT s u m (ArrayTable [Text])
    gridTable :: forall s (m :: * -> *) u.
    Stream s m Char =>
    ParsecT s u m (ArrayTable [Text])
    gridTable = ParsecT s u m (ArrayTable [Text])
    -> ParsecT s u m (ArrayTable [Text])
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
    try (ParsecT s u m (ArrayTable [Text])
     -> ParsecT s u m (ArrayTable [Text]))
    -> ParsecT s u m (ArrayTable [Text])
    -> ParsecT s u m (ArrayTable [Text])
    forall a b. (a -> b) -> a -> b
    $ do
      firstLine <- (:) (Char -> [Char] -> [Char])
    -> ParsecT s u m Char -> ParsecT s u m ([Char] -> [Char])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Char -> ParsecT s u m Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    char Char
    '+'
                       ParsecT s u m ([Char] -> [Char])
    -> ParsecT s u m [Char] -> ParsecT s u m [Char]
    forall a b.
    ParsecT s u m (a -> b) -> ParsecT s u m a -> ParsecT s u m b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> ([[Char]] -> [Char]
    forall a. Monoid a => [a] -> a
    mconcat ([[Char]] -> [Char])
    -> ParsecT s u m [[Char]] -> ParsecT s u m [Char]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParsecT s u m [Char] -> ParsecT s u m [[Char]]
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
    many1 (Char -> ParsecT s u m [Char]
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m [Char]
    gridPart Char
    '-'))
                       ParsecT s u m [Char] -> ParsecT s u m () -> ParsecT s u m [Char]
    forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* ParsecT s u m ()
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
    skipSpaces
                       ParsecT s u m [Char] -> ParsecT s u m Char -> ParsecT s u m [Char]
    forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* ParsecT s u m Char
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    newline
      lines <- many1 tableLine
      case traceLines (T.pack firstLine : lines) of
        Maybe (ArrayTable [Text])
    Nothing -> [Char] -> ParsecT s u m (ArrayTable [Text])
    forall a. [Char] -> ParsecT s u m a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail [Char]
    "tracing failed"
        Just ArrayTable [Text]
    gt -> ArrayTable [Text] -> ParsecT s u m (ArrayTable [Text])
    forall a. a -> ParsecT s u m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ArrayTable [Text]
    gt

    skipSpaces :: Stream s m Char => ParsecT s u m ()
    skipSpaces :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
    skipSpaces = ParsecT s u m Char -> ParsecT s u m ()
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
    skipMany ((Char -> Bool) -> ParsecT s u m Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    (Char -> Bool) -> ParsecT s u m Char
    satisfy ((Char -> Bool) -> ParsecT s u m Char)
    -> (Char -> Bool) -> ParsecT s u m Char
    forall a b. (a -> b) -> a -> b
    $ \Char
    c -> Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '\t' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ' ')

    -- | Parses a line that's part of a table. The line must start with
    -- either a plus @+@ or a pipe @|@.
    tableLine :: Stream s m Char
              => ParsecT s u m Text
    tableLine :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Text
    tableLine = ParsecT s u m Text -> ParsecT s u m Text
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
    try (ParsecT s u m Text -> ParsecT s u m Text)
    -> ParsecT s u m Text -> ParsecT s u m Text
    forall a b. (a -> b) -> a -> b
    $ do
      let borderChar :: ParsecT s u m Char
    borderChar = Char -> ParsecT s u m Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    char Char
    '+' ParsecT s u m Char -> ParsecT s u m Char -> ParsecT s u m Char
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
    <|> Char -> ParsecT s u m Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    char Char
    '|'
      firstChar <- ParsecT s u m Char
    forall {u}. ParsecT s u m Char
    borderChar
      rest <- manyTill (noneOf "\n\r") newline
      return $ T.stripEnd $ T.pack (firstChar : rest)

    gridPart :: Stream s m Char
             => Char -> ParsecT s u m String
    gridPart :: forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m [Char]
    gridPart Char
    ch = do
      leftColon <- ([Char] -> [Char])
    -> ParsecT s u m ([Char] -> [Char])
    -> ParsecT s u m ([Char] -> [Char])
    forall s (m :: * -> *) t a u.
    Stream s m t =>
    a -> ParsecT s u m a -> ParsecT s u m a
    option [Char] -> [Char]
    forall a. a -> a
    id ((:) (Char -> [Char] -> [Char])
    -> ParsecT s u m Char -> ParsecT s u m ([Char] -> [Char])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Char -> ParsecT s u m Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    char Char
    ':')
      dashes <- many1 (char ch)
      rightColon <- option id ((:) <$> char ':')
      plus <- char '+'
      return . leftColon . (dashes ++) . rightColon $ [plus]