{-# 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

-- $setup
-- >>> :set -XOverloadedStrings
-- >>> import Data.Attoparsec.Text


-- | Parses '{{foo}}' blocks in CommonMark Code, such that:
--
-- * `ls {{foo}} bar` -> `[Left "ls ", Right "foo", Left " bar"]`
--
-- >>> parseOnly codeParser ""
-- Right []
-- >>> parseOnly codeParser "tar"
-- Right [Left "tar"]
-- >>> parseOnly codeParser "tar{"
-- Right [Left "tar{"]
-- >>> parseOnly codeParser "tar{{"
-- Right [Left "tar{{"]
-- >>> parseOnly codeParser "tar{{{"
-- Right [Left "tar{{{"]
-- >>> parseOnly codeParser "tar}"
-- Right [Left "tar}"]
-- >>> parseOnly codeParser "tar{{{b}"
-- Right [Left "tar{{{b}"]
-- >>> parseOnly codeParser "tar{{{b}}"
-- Right [Left "tar",Right "{b"]
-- >>> parseOnly codeParser "tar{{b}}}"
-- Right [Left "tar",Right "b}"]
-- >>> parseOnly codeParser "tar xf {{source.tar[.gz|.bz2|.xz]}} --directory={{directory}}"
-- Right [Left "tar xf ",Right "source.tar[.gz|.bz2|.xz]",Left " --directory=",Right "directory"]
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]


-- | Collect both Lefts and Rights, mappending them to zore or one item per connected sublist.
--
-- >>> collectEither []
-- []
-- >>> collectEither [Right "abc", Right "def", Left "x", Left "z", Right "end"]
-- [Right "abcdef",Left "xz",Right "end"]
-- >>> collectEither [Right "", Right "def", Left "x", Left "", Right ""]
-- [Right "def",Left "x"]
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


-- | Peek 2 characters, not consuming any input.
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)