{-# LANGUAGE OverloadedStrings #-}
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)
horizontalSpace :: [Char]
horizontalSpace :: [Char]
horizontalSpace = [Char]
" \t\f\v\r"
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)
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)
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
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