{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
module Tldr.Parser where
import Prelude hiding (takeWhile)
import Control.Applicative
import Data.Attoparsec.Combinator
import Data.Attoparsec.Text
import Data.Text (Text)
import qualified Data.Text as T
codeParser :: Parser [Either Text Text]
codeParser :: Parser [Either Text Text]
codeParser = [Either Text Text] -> [Either Text Text]
forall a b.
(Eq a, Eq b, Monoid a, Monoid b) =>
[Either a b] -> [Either a b]
collectEither ([Either Text Text] -> [Either Text Text])
-> Parser [Either Text Text] -> Parser [Either Text Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [Either Text Text]
outer
where
inner :: Parser [Either Text Text]
inner :: Parser [Either Text Text]
inner = do
Char
_ <- Char -> Parser Char
char Char
'{'
Char
_ <- Char -> Parser Char
char Char
'{'
Text
l <- (Char -> Bool) -> Parser Text
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'}')
Maybe Text
e <- Parser Text -> Parser Text (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Text
findEnd
case Maybe Text
e of
Just Text
e' -> (\[Either Text Text]
o -> [Text -> Either Text Text
forall a b. b -> Either a b
Right (Text
l Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
e') ] [Either Text Text] -> [Either Text Text] -> [Either Text Text]
forall a. Semigroup a => a -> a -> a
<> [Either Text Text]
o) ([Either Text Text] -> [Either Text Text])
-> Parser [Either Text Text] -> Parser [Either Text Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser [Either Text Text]
outer Parser [Either Text Text]
-> Parser [Either Text Text] -> Parser [Either Text Text]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Either Text Text] -> Parser [Either Text Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
Maybe Text
Nothing -> (\[Either Text Text]
o -> [Text -> Either Text Text
forall a b. a -> Either a b
Left (String -> Text
T.pack String
"{{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
l)] [Either Text Text] -> [Either Text Text] -> [Either Text Text]
forall a. Semigroup a => a -> a -> a
<> [Either Text Text]
o) ([Either Text Text] -> [Either Text Text])
-> Parser [Either Text Text] -> Parser [Either Text Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser [Either Text Text]
outer Parser [Either Text Text]
-> Parser [Either Text Text] -> Parser [Either Text Text]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Either Text Text] -> Parser [Either Text Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
where
findEnd :: Parser Text
findEnd :: Parser Text
findEnd = do
Char
c1 <- Parser Char
anyChar
(Maybe Char
p2, Maybe Char
p3) <- Parser (Maybe Char, Maybe Char)
peek2Chars
case (Char
c1, Maybe Char
p2, Maybe Char
p3) of
(Char
'}', Just Char
'}', Just Char
'}') -> (Char -> Text
T.singleton Char
'}' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
findEnd
(Char
'}', Just Char
'}', Maybe Char
_) -> Text
forall a. Monoid a => a
mempty Text -> Parser Char -> Parser Text
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser Char
anyChar
(Char, Maybe Char, Maybe Char)
_ -> String -> Parser Text
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Couldn't find end: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Char, Maybe Char, Maybe Char) -> String
forall a. Show a => a -> String
show (Char
c1, Maybe Char
p2, Maybe Char
p3))
outer :: Parser [Either Text Text]
outer :: Parser [Either Text Text]
outer = do
Text
o <- (Char -> Bool) -> Parser Text
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'{')
(Maybe Char
p1, Maybe Char
p2) <- Parser (Maybe Char, Maybe Char)
peek2Chars
case (Maybe Char
p1, Maybe Char
p2) of
(Just Char
'{', Just Char
'{') -> (\[Either Text Text]
i -> [Text -> Either Text Text
forall a b. a -> Either a b
Left Text
o ] [Either Text Text] -> [Either Text Text] -> [Either Text Text]
forall a. Semigroup a => a -> a -> a
<> [Either Text Text]
i) ([Either Text Text] -> [Either Text Text])
-> Parser [Either Text Text] -> Parser [Either Text Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser [Either Text Text]
inner Parser [Either Text Text]
-> Parser [Either Text Text] -> Parser [Either Text Text]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((\Text
t -> [Text -> Either Text Text
forall a b. a -> Either a b
Left Text
t]) (Text -> [Either Text Text])
-> Parser Text -> Parser [Either Text Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
takeText))
(Just Char
'{', Maybe Char
_) -> (\Char
a [Either Text Text]
b -> [Text -> Either Text Text
forall a b. a -> Either a b
Left (Text
o Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
a)] [Either Text Text] -> [Either Text Text] -> [Either Text Text]
forall a. Semigroup a => a -> a -> a
<> [Either Text Text]
b) (Char -> [Either Text Text] -> [Either Text Text])
-> Parser Char
-> Parser Text ([Either Text Text] -> [Either Text Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char
anyChar Parser Text ([Either Text Text] -> [Either Text Text])
-> Parser [Either Text Text] -> Parser [Either Text Text]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Either Text Text]
outer
(Maybe Char, Maybe Char)
_ -> [Either Text Text] -> Parser [Either Text Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text -> Either Text Text
forall a b. a -> Either a b
Left Text
o]
collectEither :: (Eq a, Eq b, Monoid a, Monoid b) => [Either a b] -> [Either a b]
collectEither :: [Either a b] -> [Either a b]
collectEither = Maybe (Either a b) -> [Either a b] -> [Either a b]
forall a b.
(Eq a, Eq b, Monoid b, Monoid a) =>
Maybe (Either a b) -> [Either a b] -> [Either a b]
go Maybe (Either a b)
forall a. Maybe a
Nothing
where
go :: Maybe (Either a b) -> [Either a b] -> [Either a b]
go Maybe (Either a b)
Nothing [] = []
go (Just !Either a b
x) []
| Either a b
x Either a b -> Either a b -> Bool
forall a. Eq a => a -> a -> Bool
== b -> Either a b
forall a b. b -> Either a b
Right b
forall a. Monoid a => a
mempty Bool -> Bool -> Bool
|| Either a b
x Either a b -> Either a b -> Bool
forall a. Eq a => a -> a -> Bool
== a -> Either a b
forall a b. a -> Either a b
Left a
forall a. Monoid a => a
mempty = []
| Bool
otherwise = [Either a b
x]
go Maybe (Either a b)
Nothing (Left a
b:[Either a b]
br) = Maybe (Either a b) -> [Either a b] -> [Either a b]
go (Either a b -> Maybe (Either a b)
forall a. a -> Maybe a
Just (a -> Either a b
forall a b. a -> Either a b
Left a
b)) [Either a b]
br
go Maybe (Either a b)
Nothing (Right b
b:[Either a b]
br) = Maybe (Either a b) -> [Either a b] -> [Either a b]
go (Either a b -> Maybe (Either a b)
forall a. a -> Maybe a
Just (b -> Either a b
forall a b. b -> Either a b
Right b
b)) [Either a b]
br
go (Just (Left !a
a)) (Left a
b:[Either a b]
br) = Maybe (Either a b) -> [Either a b] -> [Either a b]
go (Either a b -> Maybe (Either a b)
forall a. a -> Maybe a
Just (a -> Either a b
forall a b. a -> Either a b
Left (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b))) [Either a b]
br
go (Just (Right !b
a)) (Right b
b:[Either a b]
br) = Maybe (Either a b) -> [Either a b] -> [Either a b]
go (Either a b -> Maybe (Either a b)
forall a. a -> Maybe a
Just (b -> Either a b
forall a b. b -> Either a b
Right (b
a b -> b -> b
forall a. Semigroup a => a -> a -> a
<> b
b))) [Either a b]
br
go (Just !Either a b
a) [Either a b]
xs
| Either a b
a Either a b -> Either a b -> Bool
forall a. Eq a => a -> a -> Bool
== b -> Either a b
forall a b. b -> Either a b
Right b
forall a. Monoid a => a
mempty Bool -> Bool -> Bool
|| Either a b
a Either a b -> Either a b -> Bool
forall a. Eq a => a -> a -> Bool
== a -> Either a b
forall a b. a -> Either a b
Left a
forall a. Monoid a => a
mempty = Maybe (Either a b) -> [Either a b] -> [Either a b]
go Maybe (Either a b)
forall a. Maybe a
Nothing [Either a b]
xs
| Bool
otherwise = Either a b
aEither a b -> [Either a b] -> [Either a b]
forall a. a -> [a] -> [a]
:Maybe (Either a b) -> [Either a b] -> [Either a b]
go Maybe (Either a b)
forall a. Maybe a
Nothing [Either a b]
xs
peek2Chars :: Parser (Maybe Char, Maybe Char)
peek2Chars :: Parser (Maybe Char, Maybe Char)
peek2Chars = Parser (Maybe Char, Maybe Char) -> Parser (Maybe Char, Maybe Char)
forall i a. Parser i a -> Parser i a
lookAhead ((,) (Maybe Char -> Maybe Char -> (Maybe Char, Maybe Char))
-> Parser Text (Maybe Char)
-> Parser Text (Maybe Char -> (Maybe Char, Maybe Char))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char -> Parser Text (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Char
anyChar Parser Text (Maybe Char -> (Maybe Char, Maybe Char))
-> Parser Text (Maybe Char) -> Parser (Maybe Char, Maybe Char)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Char -> Parser Text (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Char
anyChar)