{-# 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 qualified Text.Parsec as Parsec

import qualified Data.Text as T
import           Data.Text (Text)

import           Control.Applicative
import           Control.Monad (mfilter)
import           Documentation.Haddock.Parser.Monad
import           Prelude hiding (takeWhile)

import           Data.Char (isSpace)

-- | Characters that count as horizontal space
horizontalSpace :: [Char]
horizontalSpace :: [Char]
horizontalSpace = [Char]
" \t\f\v\r"

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

-- | Take leading horizontal space
takeHorizontalSpace :: Parser Text 
takeHorizontalSpace :: Parser Text
takeHorizontalSpace = (Char -> Bool) -> Parser Text
takeWhile (Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
horizontalSpace)

makeLabeled :: (String -> Maybe String -> a) -> Text -> a
makeLabeled :: ([Char] -> Maybe [Char] -> a) -> Text -> a
makeLabeled [Char] -> Maybe [Char] -> 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
"")    -> [Char] -> Maybe [Char] -> a
f (Text -> [Char]
T.unpack Text
uri) Maybe [Char]
forall a. Maybe a
Nothing
  (Text
uri, Text
label) -> [Char] -> Maybe [Char] -> a
f (Text -> [Char]
T.unpack Text
uri) ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char])
-> (Text -> [Char]) -> Text -> Maybe [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> Maybe [Char]) -> Text -> Maybe [Char]
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 :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text -> Parser Text
requireEnd (((Bool, [Char]) -> Char -> Maybe (Bool, [Char]))
-> (Bool, [Char]) -> Parser Text
forall s. (s -> Char -> Maybe s) -> s -> Parser Text
scan (Bool, [Char]) -> Char -> Maybe (Bool, [Char])
p (Bool
False, [Char]
end)) Parser Text -> (Text -> Parser Text) -> Parser Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Parser Text
forall (m :: * -> *). MonadFail m => Text -> m Text
gotSome
  where
    end :: [Char]
end = Text -> [Char]
T.unpack Text
end_ 

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

    requireEnd :: Parser Text -> Parser Text
requireEnd = (Text -> Bool) -> Parser Text -> Parser Text
forall (m :: * -> *) 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 = [Char] -> m Text
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"didn't get any content"
      | Bool
otherwise = Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
xs