diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,3 @@ +## Hspec Megaparsec 0.1.0 + +* Initial release. diff --git a/LICENSE.md b/LICENSE.md new file mode 100644 --- /dev/null +++ b/LICENSE.md @@ -0,0 +1,28 @@ +Copyright © 2016 Mark Karpov + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +* Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + +* Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +* Neither the name Mark Karpov nor the names of contributors may be used to + endorse or promote products derived from this software without specific + prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY EXPRESS +OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES +OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN +NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT, +INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, +OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, +EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,20 @@ +# Hspec Megaparsec + +[![License BSD3](https://img.shields.io/badge/license-BSD3-brightgreen.svg)](http://opensource.org/licenses/BSD-3-Clause) +[![Hackage](https://img.shields.io/hackage/v/hspec-megaparsec.svg?style=flat)](https://hackage.haskell.org/package/hspec-megaparsec) +[![Stackage Nightly](http://stackage.org/package/hspec-megaparsec/badge/nightly)](http://stackage.org/nightly/package/hspec-megaparsec) +[![Build Status](https://travis-ci.org/mrkkrp/hspec-megaparsec.svg?branch=master)](https://travis-ci.org/mrkkrp/hspec-megaparsec) +[![Coverage Status](https://coveralls.io/repos/mrkkrp/hspec-megaparsec/badge.svg?branch=master&service=github)](https://coveralls.io/github/mrkkrp/hspec-megaparsec?branch=master) + +The package provides utilities for testing +[`Megaparsec`](https://hackage.haskell.org/package/megaparsec) parsers with with +[`Hspec`](https://hackage.haskell.org/package/hspec). + +Consult Haddocks for usage, which should be trivial. Also see test suite of +this package. + +## License + +Copyright © 2016 Mark Karpov + +Distributed under BSD 3 clause license. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,6 @@ +module Main (main) where + +import Distribution.Simple + +main :: IO () +main = defaultMain diff --git a/Test/Hspec/Megaparsec.hs b/Test/Hspec/Megaparsec.hs new file mode 100644 --- /dev/null +++ b/Test/Hspec/Megaparsec.hs @@ -0,0 +1,190 @@ +-- | +-- Module : Test.Hspec.Megaparsec +-- Copyright : © 2016 Mark Karpov +-- License : BSD 3 clause +-- +-- Maintainer : Mark Karpov +-- Stability : experimental +-- Portability : portable +-- +-- Utility functions for testing Megaparsec parsers with Hspec. + +module Test.Hspec.Megaparsec + ( -- * Basic expectations + shouldParse + , parseSatisfies + , shouldSucceedOn + , shouldFailOn + -- * Testing of error messages + , shouldFailWith + -- * Incremental parsing + , failsLeaving + , succeedsLeaving + , initialState ) +where + +import Control.Monad (unless) +import Test.Hspec.Expectations +import Text.Megaparsec +import Text.Megaparsec.Pos (initialPos, defaultTabWidth) + +---------------------------------------------------------------------------- +-- Basic expectations + +-- | Create an expectation by saying what the result should be. +-- +-- > parse letterChar "" "x" `shouldParse` 'x' + +shouldParse :: (Eq a, Show a) + => Either ParseError a + -- ^ Result of parsing as returned by function like 'parse' + -> a -- ^ Desired result + -> Expectation +r `shouldParse` v = case r of + Left e -> expectationFailure $ "expected: " ++ show v ++ + "\nbut parsing failed with error:\n" ++ showParseError e + Right x -> unless (x == v) . expectationFailure $ + "expected: " ++ show v ++ "\nbut got: " ++ show x + +-- | Create an expectation by saying that the parser should successfully +-- parse a value and that the value should satisfy some predicate. +-- +-- > parse (many punctuationChar) "" "?!!" `parseSatisfies` ((== 3) . length) + +parseSatisfies :: Show a + => Either ParseError a + -- ^ Result of parsing as returned by function like 'parse' + -> (a -> Bool) -- ^ Predicate + -> Expectation +r `parseSatisfies` p = case r of + Left e -> expectationFailure $ + "expected a parsed value to check against the predicate" ++ + "\nbut parsing failed with error:\n" ++ showParseError e + Right x -> unless (p x) . expectationFailure $ + "the value did not satisfy the predicate: " ++ show x + +-- | Check that a parser fails on some given input. +-- +-- > parse (char 'x') "" `shouldFailOn` "a" + +shouldFailOn :: (Show a, Stream s t) + => (s -> Either ParseError a) + -- ^ Parser that takes stream and produces result or error message + -> s -- ^ Input that the parser should fail on + -> Expectation +p `shouldFailOn` s = shouldFail (p s) + +-- | Check that a parser succeeds on some given input. +-- +-- > parse (char 'x') "" `shouldSucceedOn` "x" + +shouldSucceedOn :: (Show a, Stream s t) + => (s -> Either ParseError a) + -- ^ Parser that takes stream and produces result or error message + -> s -- ^ Input that the parser should succeed on + -> Expectation +p `shouldSucceedOn` s = shouldSucceed (p s) + +---------------------------------------------------------------------------- +-- Testing of error messages + +-- | Create an expectation that parser should fail producing certain +-- 'ParseError'. Use functions from "Text.Megaparsec.Error" to construct +-- parse errors to check against. See "Text.Megaparsec.Pos" for functions to +-- construct textual positions. +-- +-- > parse (char 'x') "" "b" `shouldFailWith` +-- > newErrorMessages [Unexpected "'b'", Expected "'x'"] (initialPos "") + +shouldFailWith :: Show a + => Either ParseError a + -> ParseError + -> Expectation +r `shouldFailWith` e = case r of + Left e' -> unless (e == e') . expectationFailure $ + "the parser is expected to fail with:\n" ++ showParseError e ++ + "but it failed with:\n" ++ showParseError e + Right v -> expectationFailure $ + "the parser is expected to fail, but it parsed: " ++ show v + +---------------------------------------------------------------------------- +-- Incremental parsing + +-- | Check that a parser fails and leaves certain part of input +-- unconsumed. Use it with functions like 'runParser'' and 'runParserT'' +-- that support incremental parsing. +-- +-- > runParser' (many (char 'x') <* eof) (initialState "xxa") +-- > `failsLeaving` "xxa" +-- +-- See also: 'initialState'. + +failsLeaving :: (Show a, Eq s, Show s, Stream s t) + => (State s, Either ParseError a) + -- ^ Parser that takes stream and produces result along with actual + -- state information + -> s -- ^ Part of input that should be left unconsumed + -> Expectation +(st,r) `failsLeaving` s = + shouldFail r >> checkUnconsumed s (stateInput st) + +-- | Check that a parser succeeds and leaves certain part of input +-- unconsumed. Use it with functions like 'runParser'' and 'runParserT'' +-- that support incremental parsing. +-- +-- > runParser' (many (char 'x')) (initialState "xxa") +-- > `succeedsLeaving` "a" +-- +-- See also: 'initialState'. + +succeedsLeaving :: (Show a, Eq s, Show s, Stream s t) + => (State s, Either ParseError a) + -- ^ Parser that takes stream and produces result along with actual + -- state information + -> s -- ^ Part of input that should be left unconsumed + -> Expectation +(st,r) `succeedsLeaving` s = + shouldSucceed r >> checkUnconsumed s (stateInput st) + +-- | Given input for parsing, construct initial state for parser (that is, +-- with empty file name, default tab width and position at 1 line and 1 +-- column). + +initialState :: Stream s t => s -> State s +initialState s = State s (initialPos "") defaultTabWidth + +---------------------------------------------------------------------------- +-- Helpers + +-- | Expectation that argument is result of a failed parser. + +shouldFail :: Show a => Either ParseError a -> Expectation +shouldFail r = case r of + Left _ -> return () + Right v -> expectationFailure $ + "the parser is expected to fail, but it parsed: " ++ show v + +-- | Expectation that argument is result of a succeeded parser. + +shouldSucceed :: Show a => Either ParseError a -> Expectation +shouldSucceed r = case r of + Left e -> expectationFailure $ + "the parser is expected to succeed, but it failed with:\n" ++ + showParseError e + Right _ -> return () + +-- | Compare two streams for equality and in the case of mismatch report it. + +checkUnconsumed :: (Eq s, Show s, Stream s t) + => s -- ^ Expected unconsumed input + -> s -- ^ Actual unconsumed input + -> Expectation +checkUnconsumed e a = unless (e == a) . expectationFailure $ + "the parser is expected to leave unconsumed input: " ++ show e ++ + "\nbut it left this: " ++ show a + +-- | Render parse error in a way that is suitable for inserting it in test +-- suite report. + +showParseError :: ParseError -> String +showParseError = unlines . fmap (" " ++) . lines . show diff --git a/hspec-megaparsec.cabal b/hspec-megaparsec.cabal new file mode 100644 --- /dev/null +++ b/hspec-megaparsec.cabal @@ -0,0 +1,82 @@ +-- +-- Cabal configuration for ‘hspec-megaparsec’. +-- +-- Copyright © 2016 Mark Karpov +-- +-- Redistribution and use in source and binary forms, with or without +-- modification, are permitted provided that the following conditions are +-- met: +-- +-- * Redistributions of source code must retain the above copyright notice, +-- this list of conditions and the following disclaimer. +-- +-- * Redistributions in binary form must reproduce the above copyright +-- notice, this list of conditions and the following disclaimer in the +-- documentation and/or other materials provided with the distribution. +-- +-- * Neither the name Mark Karpov nor the names of contributors may be used +-- to endorse or promote products derived from this software without +-- specific prior written permission. +-- +-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY +-- EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY +-- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, +-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN +-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +-- POSSIBILITY OF SUCH DAMAGE. + +name: hspec-megaparsec +version: 0.1.0 +cabal-version: >= 1.10 +license: BSD3 +license-file: LICENSE.md +author: Mark Karpov +maintainer: Mark Karpov +homepage: https://github.com/mrkkrp/hspec-megaparsec +bug-reports: https://github.com/mrkkrp/hspec-megaparsec/issues +category: Testing, Parsing +synopsis: Utility functions for testing Megaparsec parsers with Hspec +build-type: Simple +description: Utility functions for testing Megaparsec parsers with Hspec. +extra-source-files: CHANGELOG.md + , README.md + +flag dev + description: Turn on development settings. + manual: True + default: False + +library + build-depends: base >= 4.6 && < 5 + , hspec-expectations >= 0.5 + , megaparsec >= 4.2 + exposed-modules: Test.Hspec.Megaparsec + if flag(dev) + ghc-options: -Wall -Werror + else + ghc-options: -Wall + default-language: Haskell2010 + +test-suite tests + main-is: Main.hs + hs-source-dirs: tests + type: exitcode-stdio-1.0 + if flag(dev) + ghc-options: -Wall -Werror + else + ghc-options: -Wall + build-depends: base >= 4.6 && < 5 + , hspec >= 2.0 + , hspec-expectations >= 0.5 + , hspec-megaparsec >= 0.1 + , megaparsec >= 4.2 + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/mrkkrp/hspec-megaparsec.git diff --git a/tests/Main.hs b/tests/Main.hs new file mode 100644 --- /dev/null +++ b/tests/Main.hs @@ -0,0 +1,74 @@ +-- +-- Hspec Megaparsec tests. +-- +-- Copyright © 2016 Mark Karpov +-- +-- Redistribution and use in source and binary forms, with or without +-- modification, are permitted provided that the following conditions are +-- met: +-- +-- * Redistributions of source code must retain the above copyright notice, +-- this list of conditions and the following disclaimer. +-- +-- * Redistributions in binary form must reproduce the above copyright +-- notice, this list of conditions and the following disclaimer in the +-- documentation and/or other materials provided with the distribution. +-- +-- * Neither the name Mark Karpov nor the names of contributors may be used +-- to endorse or promote products derived from this software without +-- specific prior written permission. +-- +-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY +-- EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY +-- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, +-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN +-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +-- POSSIBILITY OF SUCH DAMAGE. + +{-# LANGUAGE CPP #-} + +module Main (main) where + +import Test.Hspec +import Test.Hspec.Megaparsec +import Text.Megaparsec +import Text.Megaparsec.Error (newErrorMessages) +import Text.Megaparsec.Pos (initialPos) + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative ((<*)) +#endif + +-- | Toy tests, just an example of usage. + +main :: IO () +main = hspec $ do + describe "shouldParse" $ + it "works" $ + parse letterChar "" "x" `shouldParse` 'x' + describe "parseSatisfies" $ + it "works" $ + parse (many punctuationChar) "" "?!!" `parseSatisfies` ((== 3) . length) + describe "shouldFailOn" $ + it "works" $ + parse (char 'x') "" `shouldFailOn` "a" + describe "shouldSucceedOn" $ + it "works" $ + parse (char 'x') "" `shouldSucceedOn` "x" + describe "shouldFailWith" $ + it "works" $ + parse (char 'x') "" "b" `shouldFailWith` + newErrorMessages [Unexpected "'b'", Expected "'x'"] (initialPos "") + describe "failsLeaving" $ + it "works" $ + runParser' (many (char 'x') <* eof) (initialState "xxa") + `failsLeaving` "xxa" + describe "succeedsLeaving" $ + it "works" $ + runParser' (many (char 'x')) (initialState "xxa") + `succeedsLeaving` "a"