module NeatInterpolation.Parsing where

import NeatInterpolation.Prelude hiding (many, some, try, (<|>))
import Data.Text (Text, pack)
import Text.Megaparsec hiding (Line)
import Text.Megaparsec.Char

data Line =
  Line {Line -> Int
lineIndent :: Int, Line -> [LineContent]
lineContents :: [LineContent]}
  deriving (Int -> Line -> ShowS
[Line] -> ShowS
Line -> String
(Int -> Line -> ShowS)
-> (Line -> String) -> ([Line] -> ShowS) -> Show Line
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Line] -> ShowS
$cshowList :: [Line] -> ShowS
show :: Line -> String
$cshow :: Line -> String
showsPrec :: Int -> Line -> ShowS
$cshowsPrec :: Int -> Line -> ShowS
Show)

data LineContent =
  LineContentText [Char] |
  LineContentIdentifier [Char]
  deriving (Int -> LineContent -> ShowS
[LineContent] -> ShowS
LineContent -> String
(Int -> LineContent -> ShowS)
-> (LineContent -> String)
-> ([LineContent] -> ShowS)
-> Show LineContent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineContent] -> ShowS
$cshowList :: [LineContent] -> ShowS
show :: LineContent -> String
$cshow :: LineContent -> String
showsPrec :: Int -> LineContent -> ShowS
$cshowsPrec :: Int -> LineContent -> ShowS
Show)

type Parser = Parsec Void String

-- | Pretty parse exception for parsing lines.
newtype ParseException = ParseException Text
    deriving (Int -> ParseException -> ShowS
[ParseException] -> ShowS
ParseException -> String
(Int -> ParseException -> ShowS)
-> (ParseException -> String)
-> ([ParseException] -> ShowS)
-> Show ParseException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseException] -> ShowS
$cshowList :: [ParseException] -> ShowS
show :: ParseException -> String
$cshow :: ParseException -> String
showsPrec :: Int -> ParseException -> ShowS
$cshowsPrec :: Int -> ParseException -> ShowS
Show, ParseException -> ParseException -> Bool
(ParseException -> ParseException -> Bool)
-> (ParseException -> ParseException -> Bool) -> Eq ParseException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParseException -> ParseException -> Bool
$c/= :: ParseException -> ParseException -> Bool
== :: ParseException -> ParseException -> Bool
$c== :: ParseException -> ParseException -> Bool
Eq)

parseLines :: [Char] -> Either ParseException [Line]
parseLines :: String -> Either ParseException [Line]
parseLines String
input = case Parsec Void String [Line]
-> String -> String -> Either (ParseErrorBundle String Void) [Line]
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse Parsec Void String [Line]
lines String
"NeatInterpolation.Parsing.parseLines" String
input of
    Left ParseErrorBundle String Void
err -> ParseException -> Either ParseException [Line]
forall a b. a -> Either a b
Left (ParseException -> Either ParseException [Line])
-> ParseException -> Either ParseException [Line]
forall a b. (a -> b) -> a -> b
$ Text -> ParseException
ParseException (Text -> ParseException) -> Text -> ParseException
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle String Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle String Void
err
    Right [Line]
output -> [Line] -> Either ParseException [Line]
forall a b. b -> Either a b
Right [Line]
output
  where
    lines :: Parser [Line]
    lines :: Parsec Void String [Line]
lines = ParsecT Void String Identity Line
-> ParsecT Void String Identity Char -> Parsec Void String [Line]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy ParsecT Void String Identity Line
forall e s (f :: * -> *).
(MonadParsec e s f, MonadFail f, Token s ~ Char) =>
f Line
line ParsecT Void String Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline Parsec Void String [Line]
-> ParsecT Void String Identity () -> Parsec Void String [Line]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void String Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
    line :: f Line
line = Int -> [LineContent] -> Line
Line (Int -> [LineContent] -> Line)
-> f Int -> f ([LineContent] -> Line)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Int
forall (f :: * -> *) e s.
(MonadParsec e s f, Token s ~ Char) =>
f Int
countIndent f ([LineContent] -> Line) -> f [LineContent] -> f Line
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f LineContent -> f [LineContent]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many f LineContent
forall e s (f :: * -> *).
(MonadParsec e s f, MonadFail f, Token s ~ Char) =>
f LineContent
content
    countIndent :: f Int
countIndent = (String -> Int) -> f String -> f Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (f String -> f Int) -> f String -> f Int
forall a b. (a -> b) -> a -> b
$ f String -> f String
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (f String -> f String) -> f String -> f String
forall a b. (a -> b) -> a -> b
$ f String -> f String
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (f String -> f String) -> f String -> f String
forall a b. (a -> b) -> a -> b
$ f Char -> f String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (f Char -> f String) -> f Char -> f String
forall a b. (a -> b) -> a -> b
$ Token s -> f (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
' '
    content :: f LineContent
content = f LineContent -> f LineContent
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try f LineContent
forall e s (f :: * -> *).
(MonadParsec e s f, Token s ~ Char) =>
f LineContent
escapedDollar f LineContent -> f LineContent -> f LineContent
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> f LineContent -> f LineContent
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try f LineContent
forall e s (f :: * -> *).
(MonadParsec e s f, Token s ~ Char) =>
f LineContent
identifier f LineContent -> f LineContent -> f LineContent
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> f LineContent
forall e s (f :: * -> *).
(MonadParsec e s f, MonadFail f, Token s ~ Char) =>
f LineContent
contentText
    identifier :: f LineContent
identifier = (String -> LineContent) -> f String -> f LineContent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> LineContent
LineContentIdentifier (f String -> f LineContent) -> f String -> f LineContent
forall a b. (a -> b) -> a -> b
$
      Token s -> f (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'$' f Char -> f String -> f String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (f String -> f String
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try f String
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m String
identifier' f String -> f String -> f String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> f Char -> f Char -> f String -> f String
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token s -> f (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'{') (Token s -> f (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'}') f String
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m String
identifier')
    escapedDollar :: f LineContent
escapedDollar = (String -> LineContent) -> f String -> f LineContent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> LineContent
LineContentText (f String -> f LineContent) -> f String -> f LineContent
forall a b. (a -> b) -> a -> b
$ Token s -> f (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'$' f Char -> f String -> f String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> f Char -> f String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
1 (Token s -> f (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'$')
    identifier' :: m String
identifier' = m Char -> m String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar m Char -> m Char -> m Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'\'' m Char -> m Char -> m Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'_')
    contentText :: m LineContent
contentText = do
      String
text <- m Char -> m () -> m String
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
manyTill m Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle m ()
forall (f :: * -> *) e s.
(MonadParsec e s f, Token s ~ Char) =>
f ()
end
      if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
text
        then String -> m LineContent
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Empty text"
        else LineContent -> m LineContent
forall (m :: * -> *) a. Monad m => a -> m a
return (LineContent -> m LineContent) -> LineContent -> m LineContent
forall a b. (a -> b) -> a -> b
$ String -> LineContent
LineContentText (String -> LineContent) -> String -> LineContent
forall a b. (a -> b) -> a -> b
$ String
text
      where
        end :: f ()
end =
          (f LineContent -> f ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (f LineContent -> f ()) -> f LineContent -> f ()
forall a b. (a -> b) -> a -> b
$ f LineContent -> f LineContent
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (f LineContent -> f LineContent) -> f LineContent -> f LineContent
forall a b. (a -> b) -> a -> b
$ f LineContent -> f LineContent
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead f LineContent
forall e s (f :: * -> *).
(MonadParsec e s f, Token s ~ Char) =>
f LineContent
escapedDollar) f () -> f () -> f ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
          (f LineContent -> f ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (f LineContent -> f ()) -> f LineContent -> f ()
forall a b. (a -> b) -> a -> b
$ f LineContent -> f LineContent
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (f LineContent -> f LineContent) -> f LineContent -> f LineContent
forall a b. (a -> b) -> a -> b
$ f LineContent -> f LineContent
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead f LineContent
forall e s (f :: * -> *).
(MonadParsec e s f, Token s ~ Char) =>
f LineContent
identifier) f () -> f () -> f ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
          (f Char -> f ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (f Char -> f ()) -> f Char -> f ()
forall a b. (a -> b) -> a -> b
$ f Char -> f Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (f Char -> f Char) -> f Char -> f Char
forall a b. (a -> b) -> a -> b
$ f Char -> f Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead f Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline) f () -> f () -> f ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
          f ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof