From b4b25f5b5777939584aa3c548a855490d5791f73 Mon Sep 17 00:00:00 2001 From: Simon Hengel Date: Sat, 8 Nov 2014 17:28:33 +0800 Subject: newtype-wrap parser monad --- .../src/Documentation/Haddock/Parser.hs | 2 +- .../src/Documentation/Haddock/Parser/Monad.hs | 128 +++++++++++++++++++++ .../src/Documentation/Haddock/Parser/Util.hs | 2 +- .../test/Documentation/Haddock/Parser/UtilSpec.hs | 2 +- 4 files changed, 131 insertions(+), 3 deletions(-) create mode 100644 haddock-library/src/Documentation/Haddock/Parser/Monad.hs (limited to 'haddock-library') diff --git a/haddock-library/src/Documentation/Haddock/Parser.hs b/haddock-library/src/Documentation/Haddock/Parser.hs index b3387f57..8b4ec78f 100644 --- a/haddock-library/src/Documentation/Haddock/Parser.hs +++ b/haddock-library/src/Documentation/Haddock/Parser.hs @@ -22,13 +22,13 @@ module Documentation.Haddock.Parser ( parseString, parseParas import Control.Applicative import Control.Arrow (first) import Control.Monad -import Data.Attoparsec.ByteString.Char8 hiding (parse, take, endOfLine) import qualified Data.ByteString.Char8 as BS import Data.Char (chr, isAsciiUpper) import Data.List (stripPrefix, intercalate, unfoldr) import Data.Maybe (fromMaybe) import Data.Monoid import Documentation.Haddock.Doc +import Documentation.Haddock.Parser.Monad hiding (take, endOfLine) import Documentation.Haddock.Parser.Util import Documentation.Haddock.Types import Documentation.Haddock.Utf8 diff --git a/haddock-library/src/Documentation/Haddock/Parser/Monad.hs b/haddock-library/src/Documentation/Haddock/Parser/Monad.hs new file mode 100644 index 00000000..19edce04 --- /dev/null +++ b/haddock-library/src/Documentation/Haddock/Parser/Monad.hs @@ -0,0 +1,128 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +module Documentation.Haddock.Parser.Monad ( + module Documentation.Haddock.Parser.Monad +, Attoparsec.isDigit +, Attoparsec.isDigit_w8 +, Attoparsec.isAlpha_iso8859_15 +, Attoparsec.isAlpha_ascii +, Attoparsec.isSpace +, Attoparsec.isSpace_w8 +, Attoparsec.inClass +, Attoparsec.notInClass +, Attoparsec.isEndOfLine +, Attoparsec.isHorizontalSpace +, Attoparsec.choice +, Attoparsec.count +, Attoparsec.option +, Attoparsec.many' +, Attoparsec.many1 +, Attoparsec.many1' +, Attoparsec.manyTill +, Attoparsec.manyTill' +, Attoparsec.sepBy +, Attoparsec.sepBy' +, Attoparsec.sepBy1 +, Attoparsec.sepBy1' +, Attoparsec.skipMany +, Attoparsec.skipMany1 +, Attoparsec.eitherP +) where + +import Control.Applicative +import Control.Monad +import Data.String +import Data.ByteString (ByteString) +import qualified Data.ByteString.Lazy as LB +import qualified Data.Attoparsec.ByteString.Char8 as Attoparsec +import Data.Word +import Data.Bits + +newtype Parser a = Parser (Attoparsec.Parser a) + deriving (Functor, Applicative, Alternative, Monad, MonadPlus, IsString) + +parseOnly :: Parser a -> ByteString -> Either String a +parseOnly (Parser p) = Attoparsec.parseOnly p + +lift :: Attoparsec.Parser a -> Parser a +lift = Parser + +char :: Char -> Parser Char +char = lift . Attoparsec.char + +char8 :: Char -> Parser Word8 +char8 = lift . Attoparsec.char8 + +anyChar :: Parser Char +anyChar = lift Attoparsec.anyChar + +notChar :: Char -> Parser Char +notChar = lift . Attoparsec.notChar + +satisfy :: (Char -> Bool) -> Parser Char +satisfy = lift . Attoparsec.satisfy + +peekChar :: Parser (Maybe Char) +peekChar = lift Attoparsec.peekChar + +peekChar' :: Parser Char +peekChar' = lift Attoparsec.peekChar' + +digit :: Parser Char +digit = lift Attoparsec.digit + +letter_iso8859_15 :: Parser Char +letter_iso8859_15 = lift Attoparsec.letter_iso8859_15 + +letter_ascii :: Parser Char +letter_ascii = lift Attoparsec.letter_ascii + +space :: Parser Char +space = lift Attoparsec.space + +string :: ByteString -> Parser ByteString +string = lift . Attoparsec.string + +stringCI :: ByteString -> Parser ByteString +stringCI = lift . Attoparsec.stringCI + +skipSpace :: Parser () +skipSpace = lift Attoparsec.skipSpace + +skipWhile :: (Char -> Bool) -> Parser () +skipWhile = lift . Attoparsec.skipWhile + +take :: Int -> Parser ByteString +take = lift . Attoparsec.take + +scan :: s -> (s -> Char -> Maybe s) -> Parser ByteString +scan s = lift . Attoparsec.scan s + +takeWhile :: (Char -> Bool) -> Parser ByteString +takeWhile = lift . Attoparsec.takeWhile + +takeWhile1 :: (Char -> Bool) -> Parser ByteString +takeWhile1 = lift . Attoparsec.takeWhile1 + +takeTill :: (Char -> Bool) -> Parser ByteString +takeTill = lift . Attoparsec.takeTill + +takeByteString :: Parser ByteString +takeByteString = lift Attoparsec.takeByteString + +takeLazyByteString :: Parser LB.ByteString +takeLazyByteString = lift Attoparsec.takeLazyByteString + +endOfLine :: Parser () +endOfLine = lift Attoparsec.endOfLine + +decimal :: Integral a => Parser a +decimal = lift Attoparsec.decimal + +hexadecimal :: (Integral a, Bits a) => Parser a +hexadecimal = lift Attoparsec.hexadecimal + +endOfInput :: Parser () +endOfInput = lift Attoparsec.endOfInput + +atEnd :: Parser Bool +atEnd = lift Attoparsec.atEnd diff --git a/haddock-library/src/Documentation/Haddock/Parser/Util.hs b/haddock-library/src/Documentation/Haddock/Parser/Util.hs index eff7dfc6..d908ce18 100644 --- a/haddock-library/src/Documentation/Haddock/Parser/Util.hs +++ b/haddock-library/src/Documentation/Haddock/Parser/Util.hs @@ -22,7 +22,7 @@ module Documentation.Haddock.Parser.Util ( import Control.Applicative import Control.Monad (mfilter) -import Data.Attoparsec.ByteString.Char8 hiding (parse, take, endOfLine) +import Documentation.Haddock.Parser.Monad import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as BS import Prelude hiding (takeWhile) diff --git a/haddock-library/test/Documentation/Haddock/Parser/UtilSpec.hs b/haddock-library/test/Documentation/Haddock/Parser/UtilSpec.hs index a6ac49ee..32dd11d4 100644 --- a/haddock-library/test/Documentation/Haddock/Parser/UtilSpec.hs +++ b/haddock-library/test/Documentation/Haddock/Parser/UtilSpec.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} module Documentation.Haddock.Parser.UtilSpec (main, spec) where -import Data.Attoparsec.ByteString.Char8 +import Documentation.Haddock.Parser.Monad import Documentation.Haddock.Parser.Util import Data.Either.Compat (isLeft) import Test.Hspec -- cgit v1.2.3