{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}

module Data.Makefile.Parse.Internal where

import Control.Monad
import Data.Foldable
import           Data.Attoparsec.Text
import           Data.Makefile
import Control.Applicative

import qualified Data.Attoparsec.Text as Atto
import qualified Data.Text as T
import qualified Data.Text.IO as T

-- $setup
-- >>> :set -XOverloadedStrings

-- | Parse makefile.
--
-- Tries to open and parse a file name @Makefile@ in the current directory.
parseMakefile :: IO (Either String Makefile)
parseMakefile :: IO (Either String Makefile)
parseMakefile = Parser Makefile -> Text -> Either String Makefile
forall a. Parser a -> Text -> Either String a
Atto.parseOnly Parser Makefile
makefile (Text -> Either String Makefile)
-> IO Text -> IO (Either String Makefile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Text
T.readFile String
"Makefile"

-- | Parse the specified file as a makefile.
parseAsMakefile :: FilePath -> IO (Either String Makefile)
parseAsMakefile :: String -> IO (Either String Makefile)
parseAsMakefile String
f = Parser Makefile -> Text -> Either String Makefile
forall a. Parser a -> Text -> Either String a
Atto.parseOnly Parser Makefile
makefile (Text -> Either String Makefile)
-> IO Text -> IO (Either String Makefile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Text
T.readFile String
f

parseMakefileContents :: T.Text -> Either String Makefile
parseMakefileContents :: Text -> Either String Makefile
parseMakefileContents = Parser Makefile -> Text -> Either String Makefile
forall a. Parser a -> Text -> Either String a
Atto.parseOnly Parser Makefile
makefile

-- | Similar to 'Atto.parseOnly' but fails if all input has not been consumed.
parseAll :: Parser a -> T.Text -> Either String a
parseAll :: forall a. Parser a -> Text -> Either String a
parseAll Parser a
p = Parser a -> Text -> Either String a
forall a. Parser a -> Text -> Either String a
Atto.parseOnly (Parser a
p Parser a -> Parser Text () -> Parser a
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
Atto.endOfInput)
--------------------------------------------------------------------------------
-- Parsers


-- | Parser for a makefile
makefile :: Parser Makefile
makefile :: Parser Makefile
makefile = [Entry] -> Makefile
Makefile ([Entry] -> Makefile) -> Parser Text [Entry] -> Parser Makefile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Entry -> Parser Text [Entry]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' Parser Text Entry
entry

-- | Parser for a makefile entry (either a rule or a variable assignment)
entry :: Parser Entry
entry :: Parser Text Entry
entry = Parser Text Entry
assignment Parser Text Entry -> Parser Text Entry -> Parser Text Entry
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Entry
rule Parser Text Entry -> Parser Text Entry -> Parser Text Entry
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Entry
otherLine

-- | Parser of variable assignment (see 'Assignment'). Note that leading and
-- trailing whitespaces will be stripped both from the variable name and
-- assigned value.
--
-- Note that this tries to follow GNU make's (crazy) behavior when it comes to
-- variable names and assignment operators.
--
-- >>> parseAll assignment "foo = bar "
-- Right (Assignment RecursiveAssign "foo" "bar")
--
-- >>> parseAll assignment "foo := bar "
-- Right (Assignment SimpleAssign "foo" "bar")
--
-- >>> parseAll assignment "foo ::= bar "
-- Right (Assignment SimplePosixAssign "foo" "bar")
--
-- >>> parseAll assignment "foo?= bar "
-- Right (Assignment ConditionalAssign "foo" "bar")
--
-- >>> parseAll assignment "foo??= bar "
-- Right (Assignment ConditionalAssign "foo?" "bar")
--
-- >>> parseAll assignment "foo!?!= bar "
-- Right (Assignment ShellAssign "foo!?" "bar")
assignment :: Parser Entry
assignment :: Parser Text Entry
assignment = do
  Text
varName <- Parser Text Text
variableName
  AssignmentType
assType <- Parser AssignmentType
assignmentType
  Text
varVal <- Parser Text Text
toEscapedLineEnd
  Entry -> Parser Text Entry
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (AssignmentType -> Text -> Text -> Entry
Assignment AssignmentType
assType Text
varName Text
varVal)

-- | Read chars while some ('Parser', monadic) predicate is 'True'.
--
-- XXX: extremely inefficient.
takeWhileM :: (Char -> Parser Bool) -> Parser T.Text
takeWhileM :: (Char -> Parser Bool) -> Parser Text Text
takeWhileM Char -> Parser Bool
a = (String -> Text
T.pack (String -> Text) -> (String -> String) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse) (String -> Text) -> Parser Text String -> Parser Text Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Parser Text String
go []
  where
    go :: String -> Parser Text String
go String
cs = do
      Char
c <- Parser Char
Atto.anyChar
      Bool
True <- Char -> Parser Bool
a Char
c
      String -> Parser Text String
go (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
cs) Parser Text String -> Parser Text String -> Parser Text String
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser Text String
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
cs)


-- | Parse a variable name, not consuming any of the assignment operator. See
-- also 'assignment'.
--
-- >>> Atto.parseOnly variableName "foo!?!= bar "
-- Right "foo!?"
variableName :: Parser T.Text
variableName :: Parser Text Text
variableName = Parser Text Text -> Parser Text Text
stripped (Parser Text Text -> Parser Text Text)
-> Parser Text Text -> Parser Text Text
forall a b. (a -> b) -> a -> b
$ (Char -> Parser Bool) -> Parser Text Text
takeWhileM Char -> Parser Bool
go
  where
    go :: Char -> Parser Bool
go Char
'+' = Parser Char
Atto.peekChar' Parser Char -> (Char -> Parser Bool) -> Parser Bool
forall a b. Parser Text a -> (a -> Parser Text b) -> Parser Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                  Char
'=' -> Bool -> Parser Bool
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                  Char
_c -> Bool -> Parser Bool
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    go Char
'?' = Parser Char
Atto.peekChar' Parser Char -> (Char -> Parser Bool) -> Parser Bool
forall a b. Parser Text a -> (a -> Parser Text b) -> Parser Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                  Char
'=' -> Bool -> Parser Bool
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                  Char
_c -> Bool -> Parser Bool
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    go Char
'!' = Parser Char
Atto.peekChar' Parser Char -> (Char -> Parser Bool) -> Parser Bool
forall a b. Parser Text a -> (a -> Parser Text b) -> Parser Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                  Char
'=' -> Bool -> Parser Bool
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                  Char
_c -> Bool -> Parser Bool
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    -- those chars are not allowed in variable names
    go Char
':' = Bool -> Parser Bool
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    go Char
'#' = Bool -> Parser Bool
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    go Char
'=' = Bool -> Parser Bool
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    go (Char -> Bool
Atto.isEndOfLine -> Bool
True) = Bool -> Parser Bool
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    go Char
_c = Bool -> Parser Bool
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

-- | Parse an assignment type, not consuming any of the assigned value. See
-- also 'assignment'.
--
-- >>> Atto.parseOnly assignmentType "!= bar "
-- Right ShellAssign
assignmentType :: Parser AssignmentType
assignmentType :: Parser AssignmentType
assignmentType =
  (Parser Text Text
"=" Parser Text Text -> Parser AssignmentType -> Parser AssignmentType
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> AssignmentType -> Parser AssignmentType
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AssignmentType
RecursiveAssign)
  Parser AssignmentType
-> Parser AssignmentType -> Parser AssignmentType
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser Text Text
"+=" Parser Text Text -> Parser AssignmentType -> Parser AssignmentType
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> AssignmentType -> Parser AssignmentType
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AssignmentType
AppendAssign)
  Parser AssignmentType
-> Parser AssignmentType -> Parser AssignmentType
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser Text Text
"?=" Parser Text Text -> Parser AssignmentType -> Parser AssignmentType
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> AssignmentType -> Parser AssignmentType
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AssignmentType
ConditionalAssign)
  Parser AssignmentType
-> Parser AssignmentType -> Parser AssignmentType
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser Text Text
"!=" Parser Text Text -> Parser AssignmentType -> Parser AssignmentType
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> AssignmentType -> Parser AssignmentType
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AssignmentType
ShellAssign)
  Parser AssignmentType
-> Parser AssignmentType -> Parser AssignmentType
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser Text Text
":=" Parser Text Text -> Parser AssignmentType -> Parser AssignmentType
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> AssignmentType -> Parser AssignmentType
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AssignmentType
SimpleAssign)
  Parser AssignmentType
-> Parser AssignmentType -> Parser AssignmentType
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser Text Text
"::=" Parser Text Text -> Parser AssignmentType -> Parser AssignmentType
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> AssignmentType -> Parser AssignmentType
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AssignmentType
SimplePosixAssign)

-- | Parser for an entire rule
rule :: Parser Entry
rule :: Parser Text Entry
rule =
  Target -> [Dependency] -> [Command] -> Entry
Rule
    (Target -> [Dependency] -> [Command] -> Entry)
-> Parser Text Target
-> Parser Text ([Dependency] -> [Command] -> Entry)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Target
target
    Parser Text ([Dependency] -> [Command] -> Entry)
-> Parser Text [Dependency] -> Parser Text ([Command] -> Entry)
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser Text Dependency -> Parser Text [Dependency]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' Parser Text Dependency
dependency Parser Text [Dependency]
-> Parser Text Text -> Parser Text [Dependency]
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ((Char -> Bool) -> Parser Text Text
Atto.takeWhile (Bool -> Bool
not(Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Char -> Bool
Atto.isEndOfLine) Parser Text Text -> Parser Text () -> Parser Text Text
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
endOfLine'))
    Parser Text ([Command] -> Entry)
-> Parser Text [Command] -> Parser Text Entry
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Command -> Parser Text [Command]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' Parser Text Command
command

-- | Succeeds on 'Atto.endOfLine' (line end) or if the end of input is reached.
endOfLine' :: Parser ()
endOfLine' :: Parser Text ()
endOfLine' =
    Parser Text ()
Atto.endOfLine Parser Text () -> Parser Text () -> Parser Text ()
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser Bool
forall t. Chunk t => Parser t Bool
Atto.atEnd Parser Bool -> (Bool -> Parser Text ()) -> Parser Text ()
forall a b. Parser Text a -> (a -> Parser Text b) -> Parser Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> Parser Text ()
forall {f :: * -> *}. MonadPlus f => Bool -> f ()
check)
  where
    check :: Bool -> f ()
check Bool
True = () -> f ()
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    check Bool
False = f ()
forall a. f a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

-- | Parser for a command
command :: Parser Command
command :: Parser Text Command
command = Text -> Command
Command (Text -> Command) -> Parser Text Text -> Parser Text Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
recipeLine

recipeLine :: Parser T.Text
recipeLine :: Parser Text Text
recipeLine =
    Char -> Parser Char
Atto.char Char
'\t' Parser Char -> Parser Text Text -> Parser Text Text
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Parser Text Text
recipeLineContents Text
""
  where
    recipeLineContents :: Text -> Parser Text Text
recipeLineContents Text
pre = do
      Text
cur <- (Char -> Bool) -> Parser Text Text
Atto.takeWhile ((Char -> Bool) -> Parser Text Text)
-> (Char -> Bool) -> Parser Text Text
forall a b. (a -> b) -> a -> b
$ \Char
c ->
          Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\\' Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
Atto.isEndOfLine Char
c)
      [Parser Text Text] -> Parser Text Text
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
        [ -- Multi-line
          Char -> Parser Char
Atto.char Char
'\\'
            Parser Char -> Parser Text () -> Parser Text ()
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
Atto.endOfLine
            Parser Text () -> Parser Text () -> Parser Text ()
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser Char -> Parser Text ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Char -> Parser Char
Atto.char Char
'\t') Parser Text () -> Parser Text () -> Parser Text ()
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> () -> Parser Text ()
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
            Parser Text () -> Parser Text Text -> Parser Text Text
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Parser Text Text
recipeLineContents (Text
pre Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cur Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\\\n")
        , -- Just EOL or EOF
          Parser Text ()
endOfLine' Parser Text () -> Parser Text Text -> Parser Text Text
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Parser Text Text
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
pre Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cur)
        , -- It was just a backslash within a recipe line, we're not doing
          -- anything particular
          Char -> Parser Char
Atto.char Char
'\\' Parser Char -> Parser Text Text -> Parser Text Text
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Parser Text Text
recipeLineContents (Text
pre Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cur Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\\")
        ]

-- | Parser for a (rule) target
target :: Parser Target
target :: Parser Text Target
target = Text -> Target
Target (Text -> Target) -> Parser Text Text -> Parser Text Target
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Text Text -> Parser Text Text
forall a. Parser a -> Parser a
go (Parser Text Text -> Parser Text Text)
-> Parser Text Text -> Parser Text Text
forall a b. (a -> b) -> a -> b
$ Parser Text Text -> Parser Text Text
stripped ((Char -> Bool) -> Parser Text Text
Atto.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':') Parser Text Text -> Parser Char -> Parser Text Text
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
Atto.char Char
':'))
  where
    -- takes care of some makefile target quirks
    go :: Parser a -> Parser a
    go :: forall a. Parser a -> Parser a
go Parser a
p =
        (Char -> Bool) -> Parser Text Text
Atto.takeWhile ((Bool -> Bool -> Bool)
-> (Char -> Bool) -> (Char -> Bool) -> Char -> Bool
forall a b c.
(a -> b -> c) -> (Char -> a) -> (Char -> b) -> Char -> c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(||) (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t'))
          Parser Text Text -> Parser a -> Parser a
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser (Maybe Char)
Atto.peekChar Parser (Maybe Char) -> (Maybe Char -> Parser a) -> Parser a
forall a b. Parser Text a -> (a -> Parser Text b) -> Parser Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              Just Char
'#' -> Parser a
forall a. Parser Text a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
              Just Char
'\n' -> Parser a
forall a. Parser Text a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
              Maybe Char
_ -> Parser a
p)

-- | Parser for a (rule) dependency
dependency :: Parser Dependency
dependency :: Parser Text Dependency
dependency = Text -> Dependency
Dependency (Text -> Dependency) -> Parser Text Text -> Parser Text Dependency
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Text Text
sameLine Parser Text Text -> Parser Text Text -> Parser Text Text
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Text
newLine)
  where
    sameLine :: Parser Text Text
sameLine =
      (Char -> Bool) -> Parser Text Text
Atto.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ')
        Parser Text Text -> Parser Text Text -> Parser Text Text
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser Text Text
Atto.takeWhile1 (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char
' ', Char
'\n', Char
'#', Char
'\\'])
    newLine :: Parser Text Text
newLine =
      (Char -> Bool) -> Parser Text Text
Atto.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ')
        Parser Text Text -> Parser Char -> Parser Char
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser Char
Atto.char Char
'\\'
        Parser Char -> Parser Char -> Parser Char
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser Char
Atto.char Char
'\n'
        Parser Char -> Parser Text Text -> Parser Text Text
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser Text Text
sameLine Parser Text Text -> Parser Text Text -> Parser Text Text
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Text
newLine)

-- | Catch all, used for
--    * comments, empty lines
--    * lines that failed to parse
--
-- >>> parseAll otherLine "# I AM A COMMENT\n"
-- Right (OtherLine "# I AM A COMMENT")
--
-- Ensure all 'Entry's consume the end of line:
-- >>> parseAll otherLine "\n"
-- Right (OtherLine "")
--
otherLine :: Parser Entry
otherLine :: Parser Text Entry
otherLine = Text -> Entry
OtherLine (Text -> Entry) -> Parser Text Text -> Parser Text Entry
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
go
  where
    go :: Parser Text Text
go = [Parser Text Text] -> Parser Text Text
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
      [ -- Typical case of empty line
        Parser Text ()
Atto.endOfLine Parser Text () -> Parser Text Text -> Parser Text Text
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Parser Text Text
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
""
      , -- Either a line of spaces and/or comment, or a line that we failed to
        -- parse
        (Char -> Bool) -> Parser Text Text
Atto.takeWhile1 (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
Atto.isEndOfLine) Parser Text Text -> Parser Text () -> Parser Text Text
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
Atto.endOfLine
      ]

toLineEnd :: Parser T.Text
toLineEnd :: Parser Text Text
toLineEnd = (Char -> Bool) -> Parser Text Text
Atto.takeWhile (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char
'\n', Char
'#'])

-- | Get the contents until the end of the (potentially multi) line. Multiple
-- lines are separated by a @\\@ char and individual lines will be stripped and
-- spaces will be interspersed.
--
-- The final @\n@ character is consumed.
--
-- >>> Atto.parseOnly toEscapedLineEnd "foo bar \\\n baz"
-- Right "foo bar baz"
--
-- >>> Atto.parseOnly toEscapedLineEnd "foo \t\\\n bar \\\n baz \\\n \t"
-- Right "foo bar baz"
toEscapedLineEnd :: Parser T.Text
toEscapedLineEnd :: Parser Text Text
toEscapedLineEnd = ([Text] -> Text
T.unwords ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null)) ([Text] -> Text) -> Parser Text [Text] -> Parser Text Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text [Text]
go
  where
    go :: Parser Text [Text]
go = do
      Text
l <- Parser Text Text
toLineEnd Parser Text Text -> Parser Text () -> Parser Text Text
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Parser Char -> Parser Text ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Char -> Parser Char
Atto.char Char
'\n') Parser Text () -> Parser Text () -> Parser Text ()
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> () -> Parser Text ()
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
      case Text -> Text -> Maybe Text
T.stripSuffix Text
"\\" Text
l of
        Maybe Text
Nothing -> [Text] -> Parser Text [Text]
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> Text
T.strip Text
l]
        Just Text
l' -> (Text -> Text
T.strip Text
l'Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:) ([Text] -> [Text]) -> Parser Text [Text] -> Parser Text [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text [Text]
go

-------------------------------------------------------------------------------
-- Helpers
-------------------------------------------------------------------------------

stripped :: Parser T.Text -> Parser T.Text
stripped :: Parser Text Text -> Parser Text Text
stripped = (Text -> Text) -> Parser Text Text -> Parser Text Text
forall a b. (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
T.strip