| 
 Module       :   Data .  .  .  . Util .       :   © 2017 Parnell Springmeyer 
 License      :   All Rights Reserved 
 Maintainer   :   Parnell Springmeyer <  > 
 Stability    :   stable 

 Attoparsec utilities 

Module      :  Data.OrgMode.Parse.Attoparsec.Util.ParseLinesTill
Copyright   :  © 2017 Parnell Springmeyer
License     :  All Rights Reserved
Maintainer  :  Parnell Springmeyer <>
Stability   :  stable

Attoparsec utilities
-}

# LANGUAGE CPP                  #
# LANGUAGE ScopedTypeVariables #

module Data.OrgMode.Parse.Attoparsec.Util.ParseLinesTill
( takeALine
, ParseLinesTill (..)
, takeContentBreak
, skipEmptyLines
)
where


import           Control.Arrow        ((&&&))
import           Control.Monad        (guard)
#if __GLASGOW_HASKELL__ >= 810
import           Data.Bifoldable      (bifoldMap)
#endif
import           Data.Attoparsec.Text (Parser, anyChar, atEnd, char, endOfLine,
                                       isEndOfLine, isHorizontalSpace, many1,
                                       parseOnly, takeTill, (<?>))
import           Data.Foldable        (Foldable (..))
import           Data.Functor         (($>))
import           Data.Semigroup       ((<>))
import           Data.Text            (Text, snoc)

import qualified Control.Monad
import qualified Data.Attoparsec.Text as Attoparsec.Text
import qualified Data.Text            as Text

takeALine :: Parser Text
takeALine = do
  content <- takeTill isEndOfLine
  Attoparsec.Text.option content (snoc content <$> anyChar)

-- | Match only if there are more content to be consumed.
--
  Opposite of @Attoparsec . Text.endOfInput@
hasMoreInput :: Parser ()
hasMoreInput = do
  x <- atEnd
  Control.Monad.when x $ fail "reached the end of input"

-- | Matches only if the incoming text line consists nothing or only spaces
--
-- A empty line always ends a SectionContent
takeEmptyLine :: Parser Text
takeEmptyLine = Attoparsec.Text.takeWhile isHorizontalSpace <* endOfLine

-- | Succeed if it is a headline
headline :: Parser ()
headline = hasHeadlinePrefix *> atLeastOneSpace
  where
    hasHeadlinePrefix = many1 (char '*')

    atLeastOneSpace :: Parser ()
    atLeastOneSpace = do
      z <- anyChar
      guard (isHorizontalSpace z) <?> "A space must follow the last * of a headline"

  | Is the current line a @SectionContent@ break .   A Line is a break
takeContentBreak ::  Parser ()
takeContentBreak = breakByEmptyLine <> headline
  where
    breakByEmptyLine = takeEmptyLine $> ()

-- | Transform a text content as block to work with current parser state
feedParserText :: Parser s -> Text -> Parser s

#if __GLASGOW_HASKELL__ >= 810
feedParserText = bifoldMap fail return . parseOnly
#else
feedParserText  p t =
  case parseOnly p t of
    Left s  -> fail s
    Right s -> return s
#endif

type Recursive m b a = b -> (b, Parser (m a))

class (Foldable m) => ParseLinesTill m
  where
    -- | Fail and reset position when a breaker is found
    stop :: forall a. Parser (m a) -> Parser (Either () [a])
    stop p' = hasMoreInput *> do
      z <- (Right <$> p') <> (return . Left) ()
      case z of
        Left _  -> return (Left ())
        Right x -> guard ((not . null) x) $> (Right . toList $ x)

    takeContent :: forall a b. Recursive m b a -> b -> Parser (Text, [a])
    takeContent next c = tContent <> return (Text.empty, [])
      where
        (c', p) = next c
        tContent = do
          z <- stop p
          case z of
            Left _   -> (\l -> (Text.append l . fst) &&& snd) <$>  takeALine <*> takeContent next c'
            Right as -> return (Text.empty, as)


    -- | Save the content and parse as the default Plain Text or default Section Paragraph
    -- and try to parse the new block if the new block exists under the same node
    parseLinesContextuallyTill :: forall a b. Parser a -> Recursive m b a -> b -> Parser [a]
    parseLinesContextuallyTill pD next c= skipEmptyLines *> hasMoreInput *> do
      (content, blocks ) <- takeContent next c
      guard (not $ Text.null content && null blocks) *> ((: blocks) <$> feedParserText pD content)

    parseLinesTill :: forall a. Parser a -> Parser (m a) -> Parser [a]
    parseLinesTill pDefault pBreaker = parseLinesContextuallyTill pDefault  (const (0 :: Integer , pBreaker)) 0

instance ParseLinesTill (Either a)

skipEmptyLines :: Parser ()
skipEmptyLines = Attoparsec.Text.many' takeEmptyLine $> ()

 | Match only if there are more content to be consumed.

 | Matches only if the incoming text line consists nothing or only spaces

 A empty line always ends a SectionContent
 | Succeed if it is a headline
 | Transform a text content as block to work with current parser state
 | Fail and reset position when a breaker is found
 | Save the content and parse as the default Plain Text or default Section Paragraph
 and try to parse the new block if the new block exists under the same node
| 
 Module       :   Data .  .  .  . Util .       :   © 2017 Parnell Springmeyer 
 License      :   All Rights Reserved 
 Maintainer   :   Parnell Springmeyer <  > 
 Stability    :   stable 

 Attoparsec utilities 

Module      :  Data.OrgMode.Parse.Attoparsec.Util.ParseLinesTill
Copyright   :  © 2017 Parnell Springmeyer
License     :  All Rights Reserved
Maintainer  :  Parnell Springmeyer <>
Stability   :  stable

Attoparsec utilities
-}

# LANGUAGE CPP                  #
# LANGUAGE ScopedTypeVariables #

module Data.OrgMode.Parse.Attoparsec.Util.ParseLinesTill
( takeALine
, ParseLinesTill (..)
, takeContentBreak
, skipEmptyLines
)
where


import           Control.Arrow        ((&&&))
import           Control.Monad        (guard)
#if __GLASGOW_HASKELL__ >= 810
import           Data.Bifoldable      (bifoldMap)
#endif
import           Data.Attoparsec.Text (Parser, anyChar, atEnd, char, endOfLine,
                                       isEndOfLine, isHorizontalSpace, many1,
                                       parseOnly, takeTill, (<?>))
import           Data.Foldable        (Foldable (..))
import           Data.Functor         (($>))
import           Data.Semigroup       ((<>))
import           Data.Text            (Text, snoc)

import qualified Control.Monad
import qualified Data.Attoparsec.Text as Attoparsec.Text
import qualified Data.Text            as Text

takeALine :: Parser Text
takeALine = do
  content <- takeTill isEndOfLine
  Attoparsec.Text.option content (snoc content <$> anyChar)

  Opposite of @Attoparsec . Text.endOfInput@
hasMoreInput :: Parser ()
hasMoreInput = do
  x <- atEnd
  Control.Monad.when x $ fail "reached the end of input"

takeEmptyLine :: Parser Text
takeEmptyLine = Attoparsec.Text.takeWhile isHorizontalSpace <* endOfLine

headline :: Parser ()
headline = hasHeadlinePrefix *> atLeastOneSpace
  where
    hasHeadlinePrefix = many1 (char '*')

    atLeastOneSpace :: Parser ()
    atLeastOneSpace = do
      z <- anyChar
      guard (isHorizontalSpace z) <?> "A space must follow the last * of a headline"

  | Is the current line a @SectionContent@ break .   A Line is a break
takeContentBreak ::  Parser ()
takeContentBreak = breakByEmptyLine <> headline
  where
    breakByEmptyLine = takeEmptyLine $> ()

feedParserText :: Parser s -> Text -> Parser s

#if __GLASGOW_HASKELL__ >= 810
feedParserText = bifoldMap fail return . parseOnly
#else
feedParserText  p t =
  case parseOnly p t of
    Left s  -> fail s
    Right s -> return s
#endif

type Recursive m b a = b -> (b, Parser (m a))

class (Foldable m) => ParseLinesTill m
  where
    stop :: forall a. Parser (m a) -> Parser (Either () [a])
    stop p' = hasMoreInput *> do
      z <- (Right <$> p') <> (return . Left) ()
      case z of
        Left _  -> return (Left ())
        Right x -> guard ((not . null) x) $> (Right . toList $ x)

    takeContent :: forall a b. Recursive m b a -> b -> Parser (Text, [a])
    takeContent next c = tContent <> return (Text.empty, [])
      where
        (c', p) = next c
        tContent = do
          z <- stop p
          case z of
            Left _   -> (\l -> (Text.append l . fst) &&& snd) <$>  takeALine <*> takeContent next c'
            Right as -> return (Text.empty, as)


    parseLinesContextuallyTill :: forall a b. Parser a -> Recursive m b a -> b -> Parser [a]
    parseLinesContextuallyTill pD next c= skipEmptyLines *> hasMoreInput *> do
      (content, blocks ) <- takeContent next c
      guard (not $ Text.null content && null blocks) *> ((: blocks) <$> feedParserText pD content)

    parseLinesTill :: forall a. Parser a -> Parser (m a) -> Parser [a]
    parseLinesTill pDefault pBreaker = parseLinesContextuallyTill pDefault  (const (0 :: Integer , pBreaker)) 0

instance ParseLinesTill (Either a)

skipEmptyLines :: Parser ()
skipEmptyLines = Attoparsec.Text.many' takeEmptyLine $> ()
