From cc269e6b0b615e9e237c35a985e4ace7b9ab0dd9 Mon Sep 17 00:00:00 2001
From: Mateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk>
Date: Mon, 5 May 2014 09:01:03 +0200
Subject: Move parser + parser tests out to own package.

We move some types out that are necessary as well and then
re-export and specialise them in the core Haddock.

Reason for moving out spec tests is that if we're working on the parser,
we can simply work on that and we can ignore the rest of Haddock. The
downside is that it's a little inconvenient if at the end of the day we
want to see that everything passes.
---
 .../src/Documentation/Haddock/Parser/Util.hs       | 61 ++++++++++++++++++++++
 1 file changed, 61 insertions(+)
 create mode 100644 haddock-library/src/Documentation/Haddock/Parser/Util.hs

(limited to 'haddock-library/src/Documentation/Haddock/Parser')

diff --git a/haddock-library/src/Documentation/Haddock/Parser/Util.hs b/haddock-library/src/Documentation/Haddock/Parser/Util.hs
new file mode 100644
index 00000000..25dba2d5
--- /dev/null
+++ b/haddock-library/src/Documentation/Haddock/Parser/Util.hs
@@ -0,0 +1,61 @@
+-- |
+-- 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 where
+
+import           Control.Applicative
+import           Control.Monad (mfilter)
+import           Data.Attoparsec.ByteString.Char8 hiding (parse, take, endOfLine)
+import           Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as BS
+import           Prelude hiding (takeWhile)
+
+-- | Remove all leading and trailing whitespace
+strip :: String -> String
+strip = (\f -> f . f) $ dropWhile isSpace . reverse
+
+skipHorizontalSpace :: Parser ()
+skipHorizontalSpace = skipWhile (`elem` " \t\f\v\r")
+
+takeHorizontalSpace :: Parser BS.ByteString
+takeHorizontalSpace = takeWhile (`elem` " \t\f\v\r")
+
+makeLabeled :: (String -> Maybe String -> a) -> String -> a
+makeLabeled f input = case break isSpace $ removeEscapes $ strip input of
+  (uri, "")    -> f uri Nothing
+  (uri, label) -> f uri (Just $ dropWhile isSpace label)
+  where
+    -- As we don't parse these any further, we don't do any processing to the
+    -- string so we at least remove escape character here. Perhaps we should
+    -- actually be parsing the label at the very least?
+    removeEscapes "" = ""
+    removeEscapes ('\\':'\\':xs) = '\\' : removeEscapes xs
+    removeEscapes ('\\':xs) = removeEscapes xs
+    removeEscapes (x:xs) = x : removeEscapes xs
+
+takeUntil :: ByteString -> Parser ByteString
+takeUntil end_ = dropEnd <$> requireEnd (scan (False, end) p) >>= gotSome
+  where
+    end = BS.unpack end_
+
+    p :: (Bool, String) -> Char -> Maybe (Bool, String)
+    p acc c = case acc of
+      (True, _) -> Just (False, end)
+      (_, []) -> Nothing
+      (_, x:xs) | x == c -> Just (False, xs)
+      _ -> Just (c == '\\', end)
+
+    dropEnd = BS.reverse . BS.drop (length end) . BS.reverse
+    requireEnd = mfilter (BS.isSuffixOf end_)
+
+    gotSome xs
+      | BS.null xs = fail "didn't get any content"
+      | otherwise = return xs
-- 
cgit v1.2.3