    {-# LANGUAGE OverloadedStrings #-}

    -- |
    -- Module      :  Documentation.Haddock.Parser.Util
    -- Copyright   :  (c) Mateusz Kowalczyk 2013-2014,
    --                    Simon Hengel      2013
    -- License     :  BSD-like
    --
    -- Maintainer  :  haddock@projects.haskell.org
    -- Stability   :  experimental
    -- Portability :  portable
    --
    -- Various utility functions used by the parser.
    module Documentation.Haddock.Parser.Util
      ( takeUntil
      , removeEscapes
      , makeLabeled
      , takeHorizontalSpace
      , skipHorizontalSpace
      ) where

    import Control.Applicative
    import Control.Monad (mfilter)
    import Data.Char (isSpace)
    import Data.Text (Text)
    import qualified Data.Text as T
    import qualified Text.Parsec as Parsec
    import Prelude hiding (takeWhile)

    import Documentation.Haddock.Parser.Monad

    -- | Characters that count as horizontal space
    horizontalSpace :: Char -> Bool
    horizontalSpace :: Char -> Bool
    horizontalSpace Char
    c = Char -> Bool
    isSpace Char
    c Bool -> Bool -> Bool
    && Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '\n'

    -- | Skip and ignore leading horizontal space
    skipHorizontalSpace :: Parser ()
    skipHorizontalSpace :: Parser ()
    skipHorizontalSpace = ParsecT Text ParserState Identity Char -> Parser ()
    forall s u (m :: Type -> Type) a.
    ParsecT s u m a -> ParsecT s u m ()
    Parsec.skipMany ((Char -> Bool) -> ParsecT Text ParserState Identity Char
    forall s (m :: Type -> Type) u.
    Stream s m Char =>
    (Char -> Bool) -> ParsecT s u m Char
    Parsec.satisfy Char -> Bool
    horizontalSpace)

    -- | Take leading horizontal space
    takeHorizontalSpace :: Parser Text
    takeHorizontalSpace :: Parser Text
    takeHorizontalSpace = (Char -> Bool) -> Parser Text
    takeWhile Char -> Bool
    horizontalSpace

    makeLabeled :: (String -> Maybe String -> a) -> Text -> a
    makeLabeled :: forall a. (String -> Maybe String -> a) -> Text -> a
    makeLabeled String -> Maybe String -> a
    f Text
    input = case (Char -> Bool) -> Text -> (Text, Text)
    T.break Char -> Bool
    isSpace (Text -> (Text, Text)) -> Text -> (Text, Text)
    forall a b. (a -> b) -> a -> b
    $ Text -> Text
    removeEscapes (Text -> Text) -> Text -> Text
    forall a b. (a -> b) -> a -> b
    $ Text -> Text
    T.strip Text
    input of
      (Text
    uri, Text
    "") -> String -> Maybe String -> a
    f (Text -> String
    T.unpack Text
    uri) Maybe String
    forall a. Maybe a
    Nothing
      (Text
    uri, Text
    label) -> String -> Maybe String -> a
    f (Text -> String
    T.unpack Text
    uri) (String -> Maybe String
    forall a. a -> Maybe a
    Just (String -> Maybe String)
    -> (Text -> String) -> Text -> Maybe String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> String
    T.unpack (Text -> Maybe String) -> Text -> Maybe String
    forall a b. (a -> b) -> a -> b
    $ Text -> Text
    T.stripStart Text
    label)

    -- | Remove escapes from given string.
    --
    -- Only do this if you do not process (read: parse) the input any further.
    removeEscapes :: Text -> Text
    removeEscapes :: Text -> Text
    removeEscapes = (Text -> Maybe (Char, Text)) -> Text -> Text
    forall a. (a -> Maybe (Char, a)) -> a -> Text
    T.unfoldr Text -> Maybe (Char, Text)
    go
      where
        go :: Text -> Maybe (Char, Text)
        go :: Text -> Maybe (Char, Text)
    go Text
    xs = case Text -> Maybe (Char, Text)
    T.uncons Text
    xs of
          Just (Char
    '\\', Text
    ys) -> Text -> Maybe (Char, Text)
    T.uncons Text
    ys
          Maybe (Char, Text)
    unconsed -> Maybe (Char, Text)
    unconsed

    -- | Consume characters from the input up to and including the given pattern.
    -- Return everything consumed except for the end pattern itself.
    takeUntil :: Text -> Parser Text
    takeUntil :: Text -> Parser Text
    takeUntil Text
    end_ = Int -> Text -> Text
    T.dropEnd (Text -> Int
    T.length Text
    end_) (Text -> Text) -> Parser Text -> Parser Text
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser Text -> Parser Text
    requireEnd (((Bool, String) -> Char -> Maybe (Bool, String))
    -> (Bool, String) -> Parser Text
    forall s. (s -> Char -> Maybe s) -> s -> Parser Text
    scan (Bool, String) -> Char -> Maybe (Bool, String)
    p (Bool
    False, String
    end)) Parser Text -> (Text -> Parser Text) -> Parser Text
    forall a b.
    ParsecT Text ParserState Identity a
    -> (a -> ParsecT Text ParserState Identity b)
    -> ParsecT Text ParserState Identity b
    forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Text -> Parser Text
    forall {m :: Type -> Type}. MonadFail m => Text -> m Text
    gotSome
      where
        end :: String
    end = Text -> String
    T.unpack Text
    end_

        p :: (Bool, String) -> Char -> Maybe (Bool, String)
        p :: (Bool, String) -> Char -> Maybe (Bool, String)
    p (Bool, String)
    acc Char
    c = case (Bool, String)
    acc of
          (Bool
    True, String
    _) -> (Bool, String) -> Maybe (Bool, String)
    forall a. a -> Maybe a
    Just (Bool
    False, String
    end)
          (Bool
    _, []) -> Maybe (Bool, String)
    forall a. Maybe a
    Nothing
          (Bool
    _, Char
    x : String
    xs) | Char
    x Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    c -> (Bool, String) -> Maybe (Bool, String)
    forall a. a -> Maybe a
    Just (Bool
    False, String
    xs)
          (Bool, String)
    _ -> (Bool, String) -> Maybe (Bool, String)
    forall a. a -> Maybe a
    Just (Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '\\', String
    end)

        requireEnd :: Parser Text -> Parser Text
    requireEnd = (Text -> Bool) -> Parser Text -> Parser Text
    forall (m :: Type -> Type) a.
    MonadPlus m =>
    (a -> Bool) -> m a -> m a
    mfilter (Text -> Text -> Bool
    T.isSuffixOf Text
    end_)

        gotSome :: Text -> m Text
    gotSome Text
    xs
          | Text -> Bool
    T.null Text
    xs = String -> m Text
    forall a. HasCallStack => String -> m a
    forall (m :: Type -> Type) a.
    (MonadFail m, HasCallStack) =>
    String -> m a
    fail String
    "didn't get any content"
          | Bool
    otherwise = Text -> m Text
    forall a. a -> m a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return Text
    xs