{-# LANGUAGE DeriveDataTypeable #-}

module Language.Docker.Parser.Prelude
  (
    DockerfileError (..),
    Error,
    Parser,
    anyUnless,
    brackets,
    caseInsensitiveString,
    commaSep,
    comment,
    customError,
    doubleQuotedString,
    doubleQuotedStringEscaped,
    eol,
    escapedLineBreaks',
    fractional,
    heredoc,
    heredocContent,
    heredocMarker,
    isNl,
    isSpaceNl,
    lexeme',
    lexeme,
    natural,
    onlySpaces,
    onlyWhitespaces,
    requiredWhitespace,
    reserved,
    singleQuotedString,
    singleQuotedStringEscaped,
    someUnless,
    spaceSep1,
    stringWithEscaped,
    symbol,
    untilEol,
    untilHeredoc,
    whitespace,
    module Megaparsec,
    char,
    L.charLiteral,
    string,
    string',
    void,
    when,
    Text,
    module Data.Default.Class
  )
where

import Control.Monad (void, when)
import Data.Data
import Data.Maybe (fromMaybe)
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as T
import Text.Megaparsec as Megaparsec hiding (Label)
import Text.Megaparsec.Char hiding (eol)
import qualified Text.Megaparsec.Char.Lexer as L
import Data.Default.Class (Default(def))

data DockerfileError
  = DuplicateFlagError String
  | NoValueFlagError String
  | InvalidFlagError String
  | FileListError String
  | MissingArgument [Text]
  | DuplicateArgument Text
  | UnexpectedArgument Text Text
  | QuoteError
      String
      String
  deriving (DockerfileError -> DockerfileError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DockerfileError -> DockerfileError -> Bool
$c/= :: DockerfileError -> DockerfileError -> Bool
== :: DockerfileError -> DockerfileError -> Bool
$c== :: DockerfileError -> DockerfileError -> Bool
Eq, Typeable DockerfileError
DockerfileError -> DataType
DockerfileError -> Constr
(forall b. Data b => b -> b) -> DockerfileError -> DockerfileError
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> DockerfileError -> u
forall u. (forall d. Data d => d -> u) -> DockerfileError -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DockerfileError -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DockerfileError -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DockerfileError -> m DockerfileError
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DockerfileError -> m DockerfileError
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DockerfileError
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DockerfileError -> c DockerfileError
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DockerfileError)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DockerfileError)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DockerfileError -> m DockerfileError
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DockerfileError -> m DockerfileError
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DockerfileError -> m DockerfileError
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DockerfileError -> m DockerfileError
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DockerfileError -> m DockerfileError
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DockerfileError -> m DockerfileError
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DockerfileError -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DockerfileError -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> DockerfileError -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DockerfileError -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DockerfileError -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DockerfileError -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DockerfileError -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DockerfileError -> r
gmapT :: (forall b. Data b => b -> b) -> DockerfileError -> DockerfileError
$cgmapT :: (forall b. Data b => b -> b) -> DockerfileError -> DockerfileError
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DockerfileError)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DockerfileError)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DockerfileError)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DockerfileError)
dataTypeOf :: DockerfileError -> DataType
$cdataTypeOf :: DockerfileError -> DataType
toConstr :: DockerfileError -> Constr
$ctoConstr :: DockerfileError -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DockerfileError
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DockerfileError
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DockerfileError -> c DockerfileError
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DockerfileError -> c DockerfileError
Data, Typeable, Eq DockerfileError
DockerfileError -> DockerfileError -> Bool
DockerfileError -> DockerfileError -> Ordering
DockerfileError -> DockerfileError -> DockerfileError
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DockerfileError -> DockerfileError -> DockerfileError
$cmin :: DockerfileError -> DockerfileError -> DockerfileError
max :: DockerfileError -> DockerfileError -> DockerfileError
$cmax :: DockerfileError -> DockerfileError -> DockerfileError
>= :: DockerfileError -> DockerfileError -> Bool
$c>= :: DockerfileError -> DockerfileError -> Bool
> :: DockerfileError -> DockerfileError -> Bool
$c> :: DockerfileError -> DockerfileError -> Bool
<= :: DockerfileError -> DockerfileError -> Bool
$c<= :: DockerfileError -> DockerfileError -> Bool
< :: DockerfileError -> DockerfileError -> Bool
$c< :: DockerfileError -> DockerfileError -> Bool
compare :: DockerfileError -> DockerfileError -> Ordering
$ccompare :: DockerfileError -> DockerfileError -> Ordering
Ord, ReadPrec [DockerfileError]
ReadPrec DockerfileError
Int -> ReadS DockerfileError
ReadS [DockerfileError]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DockerfileError]
$creadListPrec :: ReadPrec [DockerfileError]
readPrec :: ReadPrec DockerfileError
$creadPrec :: ReadPrec DockerfileError
readList :: ReadS [DockerfileError]
$creadList :: ReadS [DockerfileError]
readsPrec :: Int -> ReadS DockerfileError
$creadsPrec :: Int -> ReadS DockerfileError
Read, Int -> DockerfileError -> ShowS
[DockerfileError] -> ShowS
DockerfileError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DockerfileError] -> ShowS
$cshowList :: [DockerfileError] -> ShowS
show :: DockerfileError -> String
$cshow :: DockerfileError -> String
showsPrec :: Int -> DockerfileError -> ShowS
$cshowsPrec :: Int -> DockerfileError -> ShowS
Show)

type Parser = Parsec DockerfileError Text

type Error = ParseErrorBundle Text DockerfileError

instance ShowErrorComponent DockerfileError where
  showErrorComponent :: DockerfileError -> String
showErrorComponent (DuplicateFlagError String
f) = String
"duplicate flag: " forall a. [a] -> [a] -> [a]
++ String
f
  showErrorComponent (FileListError String
f) =
    String
"unexpected end of line. At least two arguments are required for " forall a. [a] -> [a] -> [a]
++ String
f
  showErrorComponent (NoValueFlagError String
f) = String
"unexpected flag " forall a. [a] -> [a] -> [a]
++ String
f forall a. [a] -> [a] -> [a]
++ String
" with no value"
  showErrorComponent (InvalidFlagError String
f) = String
"invalid flag: " forall a. [a] -> [a] -> [a]
++ String
f
  showErrorComponent (MissingArgument [Text]
f) = String
"missing required argument(s) for mount flag: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [Text]
f
  showErrorComponent (DuplicateArgument Text
f) = String
"duplicate argument for mount flag: " forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
f
  showErrorComponent (UnexpectedArgument Text
a Text
b) = String
"unexpected argument '" forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
a forall a. [a] -> [a] -> [a]
++ String
"' for mount of type '" forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
b forall a. [a] -> [a] -> [a]
++ String
"'"
  showErrorComponent (QuoteError String
t String
str) =
    String
"unexpected end of " forall a. [a] -> [a] -> [a]
++ String
t forall a. [a] -> [a] -> [a]
++ String
" quoted string " forall a. [a] -> [a] -> [a]
++ String
str forall a. [a] -> [a] -> [a]
++ String
" (unmatched quote)"

-- Spaces are sometimes significant information in a dockerfile, this type records
-- thee presence of lack of such whitespace in certain lines.
data FoundWhitespace
  = FoundWhitespace
  | MissingWhitespace
  deriving (FoundWhitespace -> FoundWhitespace -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FoundWhitespace -> FoundWhitespace -> Bool
$c/= :: FoundWhitespace -> FoundWhitespace -> Bool
== :: FoundWhitespace -> FoundWhitespace -> Bool
$c== :: FoundWhitespace -> FoundWhitespace -> Bool
Eq, Int -> FoundWhitespace -> ShowS
[FoundWhitespace] -> ShowS
FoundWhitespace -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FoundWhitespace] -> ShowS
$cshowList :: [FoundWhitespace] -> ShowS
show :: FoundWhitespace -> String
$cshow :: FoundWhitespace -> String
showsPrec :: Int -> FoundWhitespace -> ShowS
$cshowsPrec :: Int -> FoundWhitespace -> ShowS
Show)

-- There is no need to remember how many spaces we found in a line, so we can
-- cheaply remmeber that we already whitenessed some significant whitespace while
-- parsing an expression by concatenating smaller results
instance Semigroup FoundWhitespace where
  FoundWhitespace
FoundWhitespace <> :: FoundWhitespace -> FoundWhitespace -> FoundWhitespace
<> FoundWhitespace
_ = FoundWhitespace
FoundWhitespace
  FoundWhitespace
_ <> FoundWhitespace
a = FoundWhitespace
a

instance Monoid FoundWhitespace where
  mempty :: FoundWhitespace
mempty = FoundWhitespace
MissingWhitespace

------------------------------------
-- Utilities
------------------------------------

-- | End parsing signaling a “conversion error”.
customError :: DockerfileError -> Parser a
customError :: forall a. DockerfileError -> Parser a
customError = forall e s (m :: * -> *) a.
MonadParsec e s m =>
Set (ErrorFancy e) -> m a
fancyFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Set a
S.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. e -> ErrorFancy e
ErrorCustom

castToSpace :: FoundWhitespace -> Text
castToSpace :: FoundWhitespace -> Text
castToSpace FoundWhitespace
FoundWhitespace = Text
" "
castToSpace FoundWhitespace
MissingWhitespace = Text
""

eol :: (?esc :: Char) => Parser ()
eol :: (?esc::Char) => Parser ()
eol = forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT DockerfileError Text Identity [()]
ws forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"end of line"
  where
    ws :: ParsecT DockerfileError Text Identity [()]
ws =
      forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some forall a b. (a -> b) -> a -> b
$
        forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
          [ forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser Text
onlySpaces1,
            forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P forall a. Maybe a
Nothing (forall a. Eq a => a -> a -> Bool
== Char
'\n'),
            forall (f :: * -> *) a. Functor f => f a -> f ()
void (?esc::Char) => Parser FoundWhitespace
escapedLineBreaks
          ]

reserved :: (?esc :: Char) => Text -> Parser ()
reserved :: (?esc::Char) => Text -> Parser ()
reserved Text
name = forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall a. (?esc::Char) => Parser a -> Parser a
lexeme (forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
string' Text
name) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> Text -> String
T.unpack Text
name)

natural :: Parser Integer
natural :: Parser Integer
natural = forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"positive number"

fractional :: Parser Float
fractional :: Parser Float
fractional = forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, RealFloat a) =>
m a
L.float forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"fractional number"

commaSep :: (?esc :: Char) => Parser a -> Parser [a]
commaSep :: forall a. (?esc::Char) => Parser a -> Parser [a]
commaSep Parser a
p = forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy (Parser a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (?esc::Char) => Parser ()
whitespace) ((?esc::Char) => Text -> Parser Text
symbol Text
",")

spaceSep1 :: Parser a -> Parser [a]
spaceSep1 :: forall a. Parser a -> Parser [a]
spaceSep1 Parser a
p = forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepEndBy1 Parser a
p Parser Text
onlySpaces

singleQuotedString :: Parser Text
singleQuotedString :: Parser Text
singleQuotedString = Char -> Parser Text
quotedString Char
'\''

doubleQuotedString :: Parser Text
doubleQuotedString :: Parser Text
doubleQuotedString = Char -> Parser Text
quotedString Char
'\"'

-- | Special variants of the string parsers dealing with escaped line breaks
-- and escaped quote characters well.
singleQuotedStringEscaped :: (?esc :: Char) => Parser Text
singleQuotedStringEscaped :: (?esc::Char) => Parser Text
singleQuotedStringEscaped = (?esc::Char) => Char -> Parser Text
quotedStringEscaped Char
'\''

doubleQuotedStringEscaped :: (?esc :: Char) => Parser Text
doubleQuotedStringEscaped :: (?esc::Char) => Parser Text
doubleQuotedStringEscaped = (?esc::Char) => Char -> Parser Text
quotedStringEscaped Char
'\"'

quotedString :: Char -> Parser Text
quotedString :: Char -> Parser Text
quotedString Char
c = do
  String
lit <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
c forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
manyTill forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Char
L.charLiteral (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
c)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
lit

quotedStringEscaped :: (?esc :: Char) => Char -> Parser Text
quotedStringEscaped :: (?esc::Char) => Char -> Parser Text
quotedStringEscaped Char
q =
  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
q) (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
q) forall a b. (a -> b) -> a -> b
$ (?esc::Char) => String -> Maybe (Char -> Bool) -> Parser Text
stringWithEscaped [Char
q] forall a. Maybe a
Nothing

brackets :: (?esc :: Char) => Parser a -> Parser a
brackets :: forall a. (?esc::Char) => Parser a -> Parser a
brackets = forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between ((?esc::Char) => Text -> Parser Text
symbol Text
"[" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (?esc::Char) => Parser ()
whitespace) ((?esc::Char) => Parser ()
whitespace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (?esc::Char) => Text -> Parser Text
symbol Text
"]")

untilWS :: Parser Text
untilWS :: Parser Text
untilWS = do
  String
s <- 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 e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
spaceChar
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s

heredocMarker :: (?esc :: Char) => Parser Text
heredocMarker :: (?esc::Char) => Parser Text
heredocMarker = do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"<<"
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP (forall a. a -> Maybe a
Just String
"dash") (forall a. Eq a => a -> a -> Bool
== Char
'-')
  Text
m <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Text
doubleQuotedString 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 Parser Text
singleQuotedString forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
untilWS
  forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (?esc::Char) => Parser Text
heredocRedirect
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
m

heredocRedirect :: (?esc :: Char) => Parser Text
heredocRedirect :: (?esc::Char) => Parser Text
heredocRedirect = do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ ( forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"|" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
">" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
">>" ) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
onlySpaces
  (?esc::Char) => String -> Parser Text
untilEol String
"heredoc path"

-- | This tries to parse everything until there is the just the heredoc marker
-- on its own on a line. Making provisions for the case that the marker is
-- followed by the end of the file rather than another newline.
heredocContent :: Text -> Parser Text
heredocContent :: Text -> Parser Text
heredocContent Text
marker = do
  Either (ParseError Text DockerfileError) Text
emptyHeredoc <- forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Either (ParseError s e) a)
observing Parser Text
delimiter
  String
doc <- case Either (ParseError Text DockerfileError) Text
emptyHeredoc of
    Left ParseError Text DockerfileError
_ -> 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 Parser Text
termination
    Right Text
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure String
""
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
doc
  where
    termination :: Parser Text
    termination :: Parser Text
termination = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Text
terEOL forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
terEOF

    terEOL :: Parser Text
    terEOL :: Parser Text
terEOL = forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string forall a b. (a -> b) -> a -> b
$ Text
"\n" forall a. Semigroup a => a -> a -> a
<> Text
marker forall a. Semigroup a => a -> a -> a
<> Text
"\n"

    terEOF :: Parser Text
    terEOF :: Parser Text
terEOF = do
      Text
t <- forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string forall a b. (a -> b) -> a -> b
$ Text
"\n" forall a. Semigroup a => a -> a -> a
<> Text
marker
      forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
      forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t

    delimiter :: Parser Text
    delimiter :: Parser Text
delimiter = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Text
delEOL forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
delEOF

    delEOL :: Parser Text
    delEOL :: Parser Text
delEOL = forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string forall a b. (a -> b) -> a -> b
$ Text
marker forall a. Semigroup a => a -> a -> a
<> Text
"\n"

    delEOF :: Parser Text
    delEOF :: Parser Text
delEOF = do
      Text
t <- forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Text
marker
      forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
      forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t

heredoc :: (?esc :: Char) => Parser Text
heredoc :: (?esc::Char) => Parser Text
heredoc = do
  Text
m <- (?esc::Char) => Parser Text
heredocMarker
  Text -> Parser Text
heredocContent Text
m

-- | Parses text until a heredoc or newline is found. Will also consume the
-- heredoc. It will however respect escaped newlines.
untilHeredoc :: (?esc :: Char) => Parser Text
untilHeredoc :: (?esc::Char) => Parser Text
untilHeredoc = do
  [Text]
txt <- forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
manyTill Parser Text
chars (?esc::Char) => Parser Text
heredoc
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Text]
txt
  where
    chars :: Parser Text
chars =
      forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
        [ FoundWhitespace -> Text
castToSpace forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (?esc::Char) => Parser FoundWhitespace
escapedLineBreaks,
          Char -> Text
charToTxt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
anySingleBut Char
'\n'
        ]
    charToTxt :: Char -> Text
charToTxt Char
c = String -> Text
T.pack [Char
c]

onlySpaces :: Parser Text
onlySpaces :: Parser Text
onlySpaces = forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP (forall a. a -> Maybe a
Just String
"spaces") (\Token Text
c -> Token Text
c forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Token Text
c forall a. Eq a => a -> a -> Bool
== Char
'\t')

onlySpaces1 :: Parser Text
onlySpaces1 :: Parser Text
onlySpaces1 = forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (forall a. a -> Maybe a
Just String
"at least one space") (\Token Text
c -> Token Text
c forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Token Text
c forall a. Eq a => a -> a -> Bool
== Char
'\t')

onlyWhitespaces :: Parser Text
onlyWhitespaces :: Parser Text
onlyWhitespaces = forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP
    (forall a. a -> Maybe a
Just String
"whitespaces")
    (\Token Text
c -> Token Text
c forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Token Text
c forall a. Eq a => a -> a -> Bool
== Char
'\t' Bool -> Bool -> Bool
|| Token Text
c forall a. Eq a => a -> a -> Bool
== Char
'\n' Bool -> Bool -> Bool
|| Token Text
c forall a. Eq a => a -> a -> Bool
== Char
'\r')

escapedLineBreaks :: (?esc :: Char) => Parser FoundWhitespace
escapedLineBreaks :: (?esc::Char) => Parser FoundWhitespace
escapedLineBreaks = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT DockerfileError Text Identity [FoundWhitespace]
breaks
  where
    breaks :: ParsecT DockerfileError Text Identity [FoundWhitespace]
breaks =
      forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some forall a b. (a -> b) -> a -> b
$ do
        forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char ?esc::Char
?esc forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
onlySpaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT DockerfileError Text Identity (Tokens Text)
newlines)
        forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ Parser Text
onlySpaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
comment forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT DockerfileError Text Identity (Tokens Text)
newlines
        -- Spaces before the next '\' have a special significance
        -- so we remembeer the fact that we found some
        FoundWhitespace
FoundWhitespace forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser Text
onlySpaces1 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure FoundWhitespace
MissingWhitespace
    newlines :: ParsecT DockerfileError Text Identity (Tokens Text)
newlines = forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P forall a. Maybe a
Nothing Char -> Bool
isNl

-- | This converts escaped line breaks, but keeps _all_ spaces before and after
escapedLineBreaks' :: (?esc :: Char) => Parser Text
escapedLineBreaks' :: (?esc::Char) => Parser Text
escapedLineBreaks' = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT DockerfileError Text Identity [Text]
breaks
  where
    breaks :: ParsecT DockerfileError Text Identity [Text]
breaks =
      forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some forall a b. (a -> b) -> a -> b
$ do
        forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ( forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char ?esc::Char
?esc forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
onlySpaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT DockerfileError Text Identity (Tokens Text)
newlines )
        forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ Parser Text
onlySpaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
comment forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT DockerfileError Text Identity (Tokens Text)
newlines
        Parser Text
onlySpaces1
    newlines :: ParsecT DockerfileError Text Identity (Tokens Text)
newlines = forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P forall a. Maybe a
Nothing Char -> Bool
isNl

foundWhitespace :: (?esc :: Char) => Parser FoundWhitespace
foundWhitespace :: (?esc::Char) => Parser FoundWhitespace
foundWhitespace = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT DockerfileError Text Identity [FoundWhitespace]
found
  where
    found :: ParsecT DockerfileError Text Identity [FoundWhitespace]
found = forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [FoundWhitespace
FoundWhitespace forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser Text
onlySpaces1, (?esc::Char) => Parser FoundWhitespace
escapedLineBreaks]

whitespace :: (?esc :: Char) => Parser ()
whitespace :: (?esc::Char) => Parser ()
whitespace = forall (f :: * -> *) a. Functor f => f a -> f ()
void (?esc::Char) => Parser FoundWhitespace
foundWhitespace

requiredWhitespace :: (?esc :: Char) => Parser ()
requiredWhitespace :: (?esc::Char) => Parser ()
requiredWhitespace = do
  FoundWhitespace
ws <- (?esc::Char) => Parser FoundWhitespace
foundWhitespace
  case FoundWhitespace
ws of
    FoundWhitespace
FoundWhitespace -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    FoundWhitespace
MissingWhitespace -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"missing whitespace"

-- Parse value until end of line is reached
-- after consuming all escaped newlines
untilEol :: (?esc :: Char) => String -> Parser Text
untilEol :: (?esc::Char) => String -> Parser Text
untilEol String
name = do
  Text
res <- forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT DockerfileError Text Identity [Text]
predicate
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
res forall a. Eq a => a -> a -> Bool
== Text
"") forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"expecting " forall a. [a] -> [a] -> [a]
++ String
name)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
res
  where
    predicate :: ParsecT DockerfileError Text Identity [Text]
predicate =
      forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall a b. (a -> b) -> a -> b
$
        forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
          [ FoundWhitespace -> Text
castToSpace forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (?esc::Char) => Parser FoundWhitespace
escapedLineBreaks,
            forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (forall a. a -> Maybe a
Just String
name) (\Token Text
c -> Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
'\n' Bool -> Bool -> Bool
&& Token Text
c forall a. Eq a => a -> a -> Bool
/= ?esc::Token Text
?esc),
            forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P forall a. Maybe a
Nothing (forall a. Eq a => a -> a -> Bool
== ?esc::Token Text
?esc) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'\n')
          ]

symbol :: (?esc :: Char) => Text -> Parser Text
symbol :: (?esc::Char) => Text -> Parser Text
symbol Text
name = do
  Text
x <- forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Text
name
  (?esc::Char) => Parser ()
whitespace
  forall (m :: * -> *) a. Monad m => a -> m a
return Text
x

caseInsensitiveString :: Text -> Parser Text
caseInsensitiveString :: Text -> Parser Text
caseInsensitiveString = forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
string'

stringWithEscaped :: (?esc :: Char) => [Char] -> Maybe (Char -> Bool) -> Parser Text
stringWithEscaped :: (?esc::Char) => String -> Maybe (Char -> Bool) -> Parser Text
stringWithEscaped String
quoteChars Maybe (Char -> Bool)
maybeAcceptCondition = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT DockerfileError Text Identity [Text]
sequences
  where
    sequences :: ParsecT DockerfileError Text Identity [Text]
sequences =
      forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall a b. (a -> b) -> a -> b
$
        forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
          [ forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT DockerfileError Text Identity [Text]
inner,
            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 :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P forall a. Maybe a
Nothing (forall a. Eq a => a -> a -> Bool
== ?esc::Token Text
?esc) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy Parser Text
quoteParser,
            forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (Char -> Text
T.singleton ?esc::Char
?esc) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
quoteParser
          ]
    inner :: ParsecT DockerfileError Text Identity [Text]
inner =
      forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some forall a b. (a -> b) -> a -> b
$
        forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
          [ FoundWhitespace -> Text
castToSpace forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (?esc::Char) => Parser FoundWhitespace
escapedLineBreaks,
            forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P
              forall a. Maybe a
Nothing
              (\Token Text
c -> Token Text
c forall a. Eq a => a -> a -> Bool
/= ?esc::Token Text
?esc Bool -> Bool -> Bool
&& Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
'\n' Bool -> Bool -> Bool
&& Token Text
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
quoteChars Bool -> Bool -> Bool
&& Char -> Bool
acceptCondition Token Text
c)
          ]
    quoteParser :: Parser Text
quoteParser = Char -> Text
T.singleton forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char String
quoteChars)
    acceptCondition :: Char -> Bool
acceptCondition = forall a. a -> Maybe a -> a
fromMaybe (forall a b. a -> b -> a
const Bool
True) Maybe (Char -> Bool)
maybeAcceptCondition

lexeme :: (?esc :: Char) => Parser a -> Parser a
lexeme :: forall a. (?esc::Char) => Parser a -> Parser a
lexeme Parser a
p = do
  a
x <- Parser a
p
  (?esc::Char) => Parser ()
requiredWhitespace
  forall (m :: * -> *) a. Monad m => a -> m a
return a
x

lexeme' :: Parser a -> Parser a
lexeme' :: forall a. Parser a -> Parser a
lexeme' Parser a
p = do
  a
x <- Parser a
p
  forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser Text
onlySpaces
  forall (m :: * -> *) a. Monad m => a -> m a
return a
x

isNl :: Char -> Bool
isNl :: Char -> Bool
isNl Char
c = Char
c forall a. Eq a => a -> a -> Bool
== Char
'\n'

isSpaceNl :: (?esc :: Char) => Char -> Bool
isSpaceNl :: (?esc::Char) => Char -> Bool
isSpaceNl Char
c = Char
c forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\t' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\n' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== ?esc::Char
?esc

anyUnless :: (?esc :: Char) => (Char -> Bool) -> Parser Text
anyUnless :: (?esc::Char) => (Char -> Bool) -> Parser Text
anyUnless Char -> Bool
predicate = (?esc::Char) => String -> (Char -> Bool) -> Parser Text
someUnless String
"" Char -> Bool
predicate forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
""

someUnless :: (?esc :: Char) => String -> (Char -> Bool) -> Parser Text
someUnless :: (?esc::Char) => String -> (Char -> Bool) -> Parser Text
someUnless String
name Char -> Bool
predicate = do
  [Text]
res <- ParsecT DockerfileError Text Identity [Text]
applyPredicate
  case [Text]
res of
    [] -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"expecting " forall a. [a] -> [a] -> [a]
++ String
name)
    [Text]
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Monoid a => [a] -> a
mconcat [Text]
res)
  where
    applyPredicate :: ParsecT DockerfileError Text Identity [Text]
applyPredicate =
      forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall a b. (a -> b) -> a -> b
$
        forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
          [ FoundWhitespace -> Text
castToSpace forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (?esc::Char) => Parser FoundWhitespace
escapedLineBreaks,
            forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (forall a. a -> Maybe a
Just String
name) (\Token Text
c -> Bool -> Bool
not ((?esc::Char) => Char -> Bool
isSpaceNl Token Text
c Bool -> Bool -> Bool
|| Char -> Bool
predicate Token Text
c)),
            forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P forall a. Maybe a
Nothing (\Token Text
c -> Token Text
c forall a. Eq a => a -> a -> Bool
== ?esc::Token Text
?esc Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
predicate Token Text
c))
              forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'\n')
          ]

comment :: Parser Text
comment :: Parser Text
comment = do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void 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 e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP forall a. Maybe a
Nothing (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isNl)