{-# 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 -> 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 :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
Parsec.skipMany ((Char -> Bool) -> ParsecT Text ParserState Identity Char
forall s (m :: * -> *) 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 :: (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 :: * -> *) 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 (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 :: 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 :: * -> *) 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 (m :: * -> *) a. MonadFail m => String -> m a
fail String
"didn't get any content"
      | Bool
otherwise = Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
xs