module NeatInterpolation.Parsing where

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

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