parsec-permutation (empty) → 0.1.0.0
raw patch · 6 files changed
+447/−0 lines, 6 filesdep +QuickCheckdep +basedep +parsecsetup-changed
Dependencies added: QuickCheck, base, parsec, parsec-permutation
Files
- LICENSE +30/−0
- README +16/−0
- Setup.hs +2/−0
- Text/Parsec/Permutation.hs +111/−0
- parsec-permutation.cabal +31/−0
- tests/PermutationTest.hs +257/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2013, Bitbase LLC++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 of Samuel Hoffstaetter nor the names of other+ 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 AND CONTRIBUTORS+"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+OWNER OR CONTRIBUTORS 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.
+ README view
@@ -0,0 +1,16 @@+Text.Parsec.Permutation is a permutation parser for parsec intended as+a generalized replacement for Text.Parsec.Perm in parsec.++Example usage:++ > import Text.Parsec.Permutation+ >+ > fooParser :: ParsecT s u m a -> ParsecT s u m [a]+ > fooParser = runPermParser $+ > (,,) <$> oncePerm (char 'A')+ > <*> manyPerm (char 'B')+ > <*> optionMaybePerm (char 'C' >> char 'D')++This parser will return ('A', "BBB", Just 'D') when parsing for example+the strings "BCDABB", "CDBBAB", &etc.+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Text/Parsec/Permutation.hs view
@@ -0,0 +1,111 @@+{-# LANGUAGE UndecidableInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module : Text.Parsec.Permutation+-- Copyright : (C) 2013 Bitbase, LLC+-- License : BSD3+-- Maintainer : Samuel Hoffstaetter (samuel@hoffstaetter.com)+-- Stability : provisional+-- Portability : portable+--+-- Text.Parsec.Permutation is a permutation parser for parsec intended as+-- a generalized replacement for Text.Parsec.Perm in parsec.+--+-- Example usage:+--+-- > import Text.Parsec.Permutation+-- >+-- > fooParser :: ParsecT s u m a -> ParsecT s u m [a]+-- > fooParser = runPermParser $+-- > (,,) <$> oncePerm (char 'A')+-- > <*> manyPerm (char 'B')+-- > <*> optionMaybePerm (char 'C' >> char 'D')+--+-- This parser will return ('A', \"BBB\", Just 'D') when parsing for example+-- the strings \"BCDABB\", \"CDBBAB\", &etc.+--+----------------------------------------------------------------------------++module Text.Parsec.Permutation+ (PermParser, runPermParser, oncePerm, manyPerm, many1Perm,+ optionPerm, optionMaybePerm)+where++import Control.Applicative ((<*>), (<$>), Applicative, pure)+import Text.Parsec ((<|>), ParsecT, Stream, parserZero, optionMaybe, unexpected)++data PermParser s u m a =+ PermParser {+ permValue :: Maybe a -- potential intermediate value parsed so far+ , permParser :: ParsecT s u m (PermParser s u m a)+ }++instance Functor (PermParser s u m) where+ fmap f (PermParser value parser) =+ PermParser (f <$> value) (fmap f <$> parser)++instance Stream s m t => Applicative (PermParser s u m) where+ parser1 <*> parser2 =+ PermParser (permValue parser1 <*> permValue parser2)+ (attemptParser1 <|> attemptParser2)+ where attemptParser1 = do parser1 <- permParser parser1+ return $ parser1 <*> parser2+ attemptParser2 = do parser2 <- permParser parser2+ return $ parser1 <*> parser2++ pure value = PermParser (Just value) parserZero++-- | Turns a permutation parser into a regular parsec parser.+runPermParser :: Stream s m t => PermParser s u m a -> ParsecT s u m a+runPermParser (PermParser value parser) =+ do result <- optionMaybe parser+ case result of+ Nothing -> maybe (fail "Could not parse all permutations") return value+ Just permParser -> runPermParser permParser++-- | Attempt parsing a value once. Fails if parsing the value succeeds multiple+-- times.+oncePerm :: (Stream s m t) => ParsecT s u m a -> PermParser s u m a+oncePerm parser =+ PermParser Nothing $+ do value <- parser+ return $ PermParser (Just value) $+ parser >> unexpected "duplicate occurrence.\+ \ Expected only one occurrence."++-- | Attempt parsing a value at most once. Fails when parsing the value+-- succeeds multiple times. The first argument is the default value to be+-- used when parsing never succeeds.+optionPerm :: (Stream s m t)+ => a -> ParsecT s u m a -> PermParser s u m a+optionPerm defaultValue parser =+ PermParser (Just defaultValue) $+ do value <- parser+ return $ PermParser (Just value) $+ parser >> unexpected "duplicate optional occurrence.\+ \ Expected at most one occurrence."++-- | Similar to "optionPerm", but uses Nothing as the default value.+optionMaybePerm :: (Stream s m t)+ => ParsecT s u m a -> PermParser s u m (Maybe a)+optionMaybePerm parser = optionPerm Nothing (Just <$> parser)++-- | Parses a given value as many times as possible in the permutation. As with+-- Parsec.Prim.many in parsec, you need to make sure that the provided parser+-- consumes input when succeeding to prevent infinite recursion.+manyPerm :: ParsecT s u m a -> PermParser s u m [a]+manyPerm parser = manyPermAccum (Just []) parser++-- | Same as "manyPerm", but fails when the parsing doesn't succeed at least+-- once.+many1Perm :: ParsecT s u m a -> PermParser s u m [a]+many1Perm parser = manyPermAccum Nothing parser++-- helper function for manyPerm / many1Perm+manyPermAccum :: Maybe [a] -> ParsecT s u m a -> PermParser s u m [a]+manyPermAccum accumValue parser =+ PermParser (reverse <$> accumValue) $+ do value <- parser+ let combinedValue = maybe [value] (value:) accumValue+ return $ manyPermAccum (Just combinedValue) parser+
+ parsec-permutation.cabal view
@@ -0,0 +1,31 @@+name: parsec-permutation+version: 0.1.0.0+synopsis: Applicative permutation parser for Parsec intended as+ a replacement for Text.Parsec.Perm.+license: BSD3+license-file: LICENSE+author: Samuel Hoffstaetter+maintainer: samuel@hoffstaetter.com+copyright: Bitbase, LLC+category: Parsing+build-type: Simple+cabal-version: >=1.8+extra-source-files: tests/PermutationTest.hs README++library+ exposed-modules: Text.Parsec.Permutation+ build-depends: base >= 4 && < 5, parsec >= 3+ ghc-options: -Wall -fwarn-tabs -fno-warn-name-shadowing++test-suite tests+ type: exitcode-stdio-1.0+ build-depends: parsec-permutation, base >= 4 && < 5, parsec >= 3,+ QuickCheck >= 2.4+ hs-source-dirs: tests+ main-is: PermutationTest.hs+ ghc-options: -Wall -fwarn-tabs -fno-warn-name-shadowing++source-repository head+ type: git+ location: https://github.com/bitbasenyc/parsec-permutation.git+
+ tests/PermutationTest.hs view
@@ -0,0 +1,257 @@+{-# LANGUAGE TemplateHaskell, TupleSections, FlexibleContexts #-}+module Main where++import System.Exit+import Test.QuickCheck+import Test.QuickCheck.All+import Text.Parsec+import Control.Applicative+import Data.List++import Text.Parsec.Permutation++requireParse :: String -> Parsec String () a -> a+requireParse str parser =+ case parse (parser <* eof) str str of+ Left err -> error $ "Unsuccessful parse: " ++ show err+ Right value -> value++prop_purePerm :: Property+prop_purePerm = once $+ (requireParse "" $ runPermParser $ pure "test") == "test"++prop_purePerm2 :: Property+prop_purePerm2 = once $+ case parse (runPermParser $ pure (, "asdf") <*> pure "qwer") "" "" of+ Left _ -> False+ Right x -> x == ("qwer", "asdf")++prop_oncePerm :: Property+prop_oncePerm = once $+ case parse (runPermParser $ oncePerm $ char 'A') "" "A" of+ Left _ -> False+ Right x -> x == 'A'++prop_oncePerm2 :: Property+prop_oncePerm2 = once $+ (requireParse "asdf" $ runPermParser $+ (,,,,) <$> pure 'x'+ <*> oncePerm (char 's')+ <*> oncePerm (char 'a')+ <*> oncePerm (char 'f')+ <*> oncePerm (char 'd')) == ('x','s','a','f','d')++prop_oncePerm3 :: Property+prop_oncePerm3 = once $+ (requireParse "a" $ runPermParser $+ (,) <$> pure 'x'+ <*> oncePerm (char 'a')) == ('x','a')++prop_oncePerm4 :: Property+prop_oncePerm4 = once $+ (requireParse "as" $ runPermParser $+ (,,) <$> pure 'x'+ <*> oncePerm (char 's')+ <*> oncePerm (char 'a')) == ('x','s','a')++prop_oncePerm5 :: Property+prop_oncePerm5 = once $+ (requireParse "asf" $ runPermParser $+ (,,,) <$> pure 'x'+ <*> oncePerm (char 's')+ <*> oncePerm (char 'a')+ <*> oncePerm (char 'f')) == ('x','s','a','f')++prop_oncePerm6 :: Property+prop_oncePerm6 = once $+ (requireParse "ab" $ runPermParser $+ oncePerm (char 'a' >> return ('a',)) <*>+ oncePerm (char 'b')) == ('a','b')++prop_oncePerm7 :: Property+prop_oncePerm7 = once $+ (requireParse "ba" $ runPermParser $+ oncePerm (char 'a' >> return ('a',)) <*>+ oncePerm (char 'b')) == ('a','b')++prop_oncePerm8 :: Property+prop_oncePerm8 = once $+ (requireParse "ba" $ runPermParser $+ oncePerm (char 'a' >> return ('a',)) <*>+ (oncePerm (char 'b' >> return ('b',)) <*> pure 'c')) == ('a',('b','c'))++prop_oncePerm9 :: Property+prop_oncePerm9 = once $+ (requireParse "bac" $ runPermParser $+ oncePerm (char 'a' >> return ('a',)) <*>+ (oncePerm (char 'b' >> return ('b',)) <*>+ oncePerm (char 'c'))) == ('a',('b','c'))++prop_oncePerm10 :: Property+prop_oncePerm10 = once $+ (requireParse "" $ runPermParser $+ pure ('a',) <*>+ (pure ('b',) <*> pure 'c')) == ('a',('b','c'))++prop_oncePermAll' :: Property+prop_oncePermAll' = once $ all helper ["", "a", "ab", "bb", "abc", "abcb",+ "abcdefg", "abccefaoeifjalasdfie"] where+ helper str =+ (requireParse str $ runPermParser $+ foldr (\c parser ->+ oncePerm (char c >> return (c:)) <*> parser)+ (pure "Q") str+ ) == str ++ "Q"++prop_oncePermAll :: String -> Property+prop_oncePermAll str = property $+ (requireParse (nub $ sort str) $ runPermParser $+ foldr (\c parser ->+ oncePerm (char c >> return (c:)) <*> parser)+ (pure "Q") (nub $ sort str)+ ) == (nub $ sort str) ++ "Q"++prop_oncePermAllReverse :: String -> Property+prop_oncePermAllReverse str = property $+ (requireParse (reverse $ nub $ sort str) $ runPermParser $+ foldr (\c parser ->+ oncePerm (char c >> return (c:)) <*> parser)+ (pure "Q") (nub $ sort str)+ ) == (nub $ sort str) ++ "Q"++prop_oncePermMixedOrder1 :: Property+prop_oncePermMixedOrder1 = once $ expectFailure $+ (requireParse "abcc" $ runPermParser $+ oncePerm (char 'c' >> return ('c',,)) <*>+ (oncePerm (char 'b' >> return ('b',)) <*>+ oncePerm (char 'c')) <*>+ oncePerm (char 'a')) == ('c',('b','c'),'a')++prop_oncePermMixedOrder1' :: Property+prop_oncePermMixedOrder1' = once $ expectFailure $+ (requireParse "abc" $ runPermParser $+ oncePerm (char 'c' >> return ('c',,)) <*>+ oncePerm (char 'b') <*>+ oncePerm (char 'a')) == ('c','b','a')++prop_oncePermMixedOrder2 :: Property+prop_oncePermMixedOrder2 = once $ expectFailure $+ (requireParse "abbc" $ runPermParser $+ oncePerm (char 'c' >> return ('c',,)) <*>+ (oncePerm (char 'b' >> return ('b',)) <*>+ oncePerm (char 'c')) <*>+ oncePerm (char 'a')) == ('c',('b','c'),'a')++prop_oncePermMixedOrder3 :: Property+prop_oncePermMixedOrder3 = once $+ (requireParse "axcb" $ runPermParser $+ oncePerm (char 'b' >> return ('b',,)) <*>+ (oncePerm (char 'x' >> return ('x',)) <*>+ oncePerm (char 'c')) <*>+ oncePerm (char 'a')) == ('b',('x','c'),'a')++prop_manyPermMixedOrder1 :: Property+prop_manyPermMixedOrder1 = once $+ (requireParse "abcc" $ runPermParser $+ (,,) <$>+ manyPerm (char 'c') <*>+ ((,) <$>+ manyPerm (char 'b') <*>+ manyPerm (char 'c')) <*>+ manyPerm (char 'a')) == ("cc",("b",""),"a")++prop_manyPermMixedOrder1' :: Property+prop_manyPermMixedOrder1' = once $ expectFailure $+ (requireParse "abcc" $ runPermParser $+ (,,) <$>+ manyPerm (char 'c') <*>+ ((,) <$>+ manyPerm (char 'b') <*>+ many1Perm (char 'c')) <*>+ manyPerm (char 'a')) == ("cc",("b",""),"a")++prop_manyPermMixedOrder2 :: Property+prop_manyPermMixedOrder2 = once $+ (requireParse "abbc" $ runPermParser $+ (,,) <$>+ manyPerm (char 'c') <*>+ ((,) <$>+ manyPerm (char 'b') <*>+ manyPerm (char 'c')) <*>+ manyPerm (char 'a')) == ("c",("bb",""),"a")++prop_manyPermMixedOrder3 :: Property+prop_manyPermMixedOrder3 = once $+ (requireParse "abcb" $ runPermParser $+ (,,) <$>+ manyPerm (char 'b') <*>+ ((,) <$>+ manyPerm (char 'b') <*>+ manyPerm (char 'c')) <*>+ manyPerm (char 'a')) == ("bb",("","c"),"a")++prop_manyPermMixedOrder4 :: Property+prop_manyPermMixedOrder4 = once $ expectFailure $+ (requireParse "abcbxb" $ runPermParser $+ (,,) <$>+ oncePerm (char 'x') <*>+ ((,) <$>+ optionMaybePerm (char 'b') <*>+ manyPerm (anyChar)) <*>+ manyPerm (char 'a')) /= ('q',(Just 'q',"qqq"),"qq")++prop_manyPermMixedOrder4' :: Property+prop_manyPermMixedOrder4' = once $+ (requireParse "abczxb" $ runPermParser $+ (,,) <$>+ oncePerm (char 'x') <*>+ ((,) <$>+ optionMaybePerm (char 'z') <*>+ manyPerm (anyChar)) <*>+ manyPerm (char 'a')) == ('x',(Just 'z',"cbb"),"a")++prop_manyPermAnyChar :: Property+prop_manyPermAnyChar = once $+ (requireParse "abcbdef" $ runPermParser $+ (,,) <$>+ manyPerm (char 'b') <*>+ manyPerm (anyChar) <*>+ manyPerm (anyChar)) == ("bb","acdef","")++prop_optionPermAll :: String -> String -> Property+prop_optionPermAll str' optionalStr = property $+ whenFail (putStrLn $ "str: " ++ show str) $+ whenFail (putStrLn $ "optional: " ++ show optionalStr) $+ whenFail (putStrLn $ "remainder: " ++ show (str \\ optionalStr)) $+ whenFail (putStrLn $ "values: " ++ show ((map snd $+ tail $ scanl (\(str, _) c ->+ if c `elem` str+ then (str \\ [c], Just c)+ else (str, Nothing)) (str, Just 'Q')+ optionalStr) ++ [Just 'Q'])) $+ whenFail (putStrLn $ "actual: " ++ show (requireParse str $ runPermParser $+ (,) <$>+ foldr (\c parser ->+ (:) <$> optionMaybePerm (char c) <*> parser)+ (pure $ [Just 'Q']) optionalStr <*>+ manyPerm anyChar)) $+ (requireParse str $ runPermParser $+ (,) <$>+ foldr (\c parser ->+ (:) <$> optionMaybePerm (char c) <*> parser)+ (pure $ [Just 'Q']) optionalStr <*>+ manyPerm anyChar+ ) == ( (map snd $+ tail $ scanl (\(str, _) c ->+ if c `elem` str+ then (str \\ [c], Just c)+ else (str, Nothing)) (str, Just 'Q')+ optionalStr) ++ [Just 'Q']+ , str \\ optionalStr)+ where str = nub $ sort str'++main :: IO ()+main = do+ success <- $quickCheckAll+ if success then exitSuccess else exitFailure+