{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts   #-}
{- |
Module      : Text.GridTable
Copyright   : © 2022 Albert Krewinkel
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 :: 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
  [Char]
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 (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 (m :: * -> *) t u a.
Stream s m t =>
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 (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 (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
  [Text]
lines <- ParsecT s u m Text -> ParsecT s u m [Text]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT s u m Text
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Text
tableLine
  case [Text] -> Maybe (ArrayTable [Text])
traceLines ([Char] -> Text
T.pack [Char]
firstLine Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
lines) of
    Maybe (ArrayTable [Text])
Nothing -> [Char] -> ParsecT s u m (ArrayTable [Text])
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 (m :: * -> *) a. Monad m => a -> m a
return ArrayTable [Text]
gt

skipSpaces :: Stream s m Char => ParsecT s u m ()
skipSpaces :: 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 :: 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
'|'
  Char
firstChar <- ParsecT s u m Char
forall u. ParsecT s u m Char
borderChar
  [Char]
rest <- ParsecT s u m Char -> ParsecT s u m Char -> ParsecT s u m [Char]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ([Char] -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"\n\r") ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
  Text -> ParsecT s u m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ParsecT s u m Text) -> Text -> ParsecT s u m Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.stripEnd (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack (Char
firstChar Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
rest)

gridPart :: Stream s m Char
         => Char -> ParsecT s u m String
gridPart :: Char -> ParsecT s u m [Char]
gridPart Char
ch = do
  [Char] -> [Char]
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
':')
  [Char]
dashes <- ParsecT s u m Char -> ParsecT s u m [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
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
char Char
ch)
  [Char] -> [Char]
rightColon <- ([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
':')
  Char
plus <- Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+'
  [Char] -> ParsecT s u m [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ParsecT s u m [Char])
-> ([Char] -> [Char]) -> [Char] -> ParsecT s u m [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
leftColon ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
dashes [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
rightColon ([Char] -> ParsecT s u m [Char]) -> [Char] -> ParsecT s u m [Char]
forall a b. (a -> b) -> a -> b
$ [Char
plus]