{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
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
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 = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
[Char]
firstLine <- (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m [Char]
gridPart Char
'-'))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
skipSpaces
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
[Text]
lines <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 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 forall a. a -> [a] -> [a]
: [Text]
lines) of
Maybe (ArrayTable [Text])
Nothing -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"tracing failed"
Just ArrayTable [Text]
gt -> 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 = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy forall a b. (a -> b) -> a -> b
$ \Char
c -> Char
c forall a. Eq a => a -> a -> Bool
== Char
'\t' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
' ')
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 = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
let borderChar :: ParsecT s u m Char
borderChar = forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+' forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|'
Char
firstChar <- forall {u}. ParsecT s u m Char
borderChar
[Char]
rest <- 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 (forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"\n\r") forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text
T.stripEnd forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack (Char
firstChar forall a. a -> [a] -> [a]
: [Char]
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
[Char] -> [Char]
leftColon <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option forall a. a -> a
id ((:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':')
[Char]
dashes <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
ch)
[Char] -> [Char]
rightColon <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option forall a. a -> a
id ((:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':')
Char
plus <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+'
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
leftColon forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
dashes forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
rightColon forall a b. (a -> b) -> a -> b
$ [Char
plus]