substring-parser 0.3.0.0 → 0.4.0.0
raw patch · 4 files changed
+100/−26 lines, 4 filesdep +QuickCheckdep +dlistdep −containers
Dependencies added: QuickCheck, dlist
Dependencies removed: containers
Files
- ChangeLog.md +4/−0
- src/Text/Parser/Substring.hs +17/−1
- substring-parser.cabal +15/−10
- test/Spec.hs +64/−15
ChangeLog.md view
@@ -1,3 +1,7 @@+# 0.4.0.0++- Add: `matchAll` function to make the given parser to collect all matching substrings.+ # 0.3.0.0 - Add: `takeMatch` function to make the given parser match partially, by returning the prefixed string with parsed value
src/Text/Parser/Substring.hs view
@@ -1,5 +1,6 @@ module Text.Parser.Substring- ( replaceFileOnceWithParser+ ( matchAll+ , replaceFileOnceWithParser , replaceOnceWithParser , onceReplacify , takeMatch@@ -7,6 +8,7 @@ import Control.Applicative ((<|>), optional) import Data.Attoparsec.Text+import qualified Data.DList as DList import Data.Maybe (isJust) import Data.Monoid ((<>)) import Data.Text (Text)@@ -31,6 +33,20 @@ $ flip feed "" $ traceId "parsed" $ parse (onceReplacify p) t+++-- | ref: https://stackoverflow.com/questions/29549435/parsec-how-to-find-matches-within-a-string+{-# INLINE matchAll #-}+matchAll :: Parser a -> Parser [a]+matchAll p = DList.toList <$> loop DList.empty+ where+ loop xs = do+ mMatched <- optional p+ case mMatched of+ Just matched ->+ loop (xs `DList.snoc` matched)+ _ ->+ (anyChar *> loop xs) <|> pure xs onceReplacify :: Parser Text -> Parser Builder
substring-parser.cabal view
@@ -1,16 +1,18 @@--- This file has been generated from package.yaml by hpack version 0.17.1.+-- This file has been generated from package.yaml by hpack version 0.20.0. -- -- see: https://github.com/sol/hpack+--+-- hash: 2cb8b595a4b640dae99a8172a9c884e27964461afec3041f5cfbadfdf4d648d4 name: substring-parser-version: 0.3.0.0+version: 0.4.0.0 synopsis: Match / replace substrings with a parser combinators. description: See README.md category: Text, Parsing homepage: https://gitlab.com/igrep/substring-parser author: Yuji Yamamoto maintainer: whosekiteneverfly@gmail.com-copyright: 2017 Yuji Yamamoto+copyright: 2018 Yuji Yamamoto license: Apache-2.0 license-file: LICENSE build-type: Simple@@ -25,9 +27,10 @@ src default-extensions: OverloadedStrings build-depends:- base >= 4.7 && < 5- , NoTrace+ NoTrace , attoparsec+ , base >=4.7 && <5+ , dlist , text exposed-modules: Text.Parser.Substring@@ -42,11 +45,13 @@ test default-extensions: OverloadedStrings build-depends:- base >= 4.7 && < 5- , NoTrace+ NoTrace+ , QuickCheck , attoparsec- , text- , substring-parser- , containers+ , base >=4.7 && <5 , hspec+ , substring-parser+ , text+ other-modules:+ Paths_substring_parser default-language: Haskell2010
test/Spec.hs view
@@ -1,19 +1,55 @@ import Test.Hspec import Test.Hspec.QuickCheck+import Test.QuickCheck (Gen, Arbitrary, arbitrary, forAll, vectorOf, elements) import Text.Parser.Substring import Control.Applicative ((*>))-import Data.Attoparsec.Text+import Data.Attoparsec.Text (Result, IResult(Done), parse, feed, many1, digit, string) import Data.Monoid ((<>))-import qualified Data.Set as Set-import Data.Set ((\\))+import Data.Text (Text) import qualified Data.Text as Text +import Debug.NoTrace (traceM) +subsetTextOf :: String -> Gen Text+subsetTextOf = fmap Text.pack . vectorOf 2 . elements+++newtype NonDigits = NonDigits { unNonDigits :: Text } deriving (Eq, Show)++instance Arbitrary NonDigits where+ arbitrary = NonDigits <$> subsetTextOf ['A'..'z']++newtype Digits = Digits { unDigits :: Text } deriving (Eq, Show)++instance Arbitrary Digits where+ arbitrary = Digits <$> subsetTextOf ['0'..'9']+++genSameLength :: Gen a -> Gen b -> Gen ([a], [b])+genSameLength x y =+ (,) <$> (vectorOf 2) x <*> vectorOf 2 y+++-- Ref: https://stackoverflow.com/questions/8470606/haskell-alternating-elements-from-two-lists+alternate :: [Text] -> [Text] -> [Text]+alternate (x:xs) (ys) = x : alternate ys xs+alternate _ ys = [Text.concat ys]+++shouldBeDoneWith :: (Show a, Eq a) => Result a -> (a, Text) -> Expectation+shouldBeDoneWith actual (expected, expectedLeft) =+ case feed actual "" of+ Done left result -> do+ (result, left) `shouldBe` (expected, expectedLeft)+ other ->+ fail $ "Not done: " <> show other++ main :: IO () main = hspec $ do- describe "replaceWithParser" $ do+ describe "replaceOnceWithParser" $ do it "replace first matching text by parser" $ replaceOnceWithParser (string "abc" *> pure "def") "--abc-abc-" `shouldBe` "--def-abc-"@@ -22,16 +58,29 @@ let src = "--abc-abc-" replaceOnceWithParser mempty src `shouldBe` src + describe "matchAll" $+ prop "extract all parsed data in the string" $ forAll (genSameLength arbitrary arbitrary) $ \(ndss', dss') -> do+ let ndss = map unNonDigits ndss'+ dss = map unDigits dss'+ caseStart = Text.concat $ ndss ++ dss+ caseMiddle1 = Text.concat $ alternate ndss dss+ caseMiddle2 = Text.concat $ alternate dss ndss+ caseEnd = Text.concat $ dss ++ ndss+ caseOnly = Text.concat dss+ caseNone = Text.concat ndss+ myDigit = do { d <- digit; traceM $ "d: " ++ show d ; pure d }+ dsString = Text.unpack $ Text.concat dss++ parse (matchAll $ many1 myDigit) caseStart `shouldBeDoneWith` ([dsString], "")+ parse (matchAll $ many1 myDigit) caseMiddle1 `shouldBeDoneWith` (map Text.unpack dss, "")+ parse (matchAll $ many1 myDigit) caseMiddle2 `shouldBeDoneWith` (map Text.unpack dss, "")+ parse (matchAll $ many1 myDigit) caseEnd `shouldBeDoneWith` ([dsString], "")+ parse (matchAll $ many1 myDigit) caseOnly `shouldBeDoneWith` ([dsString], "")+ parse (matchAll $ many1 myDigit) caseNone `shouldBeDoneWith` ([], "")++ describe "takeMatch" $ prop "take any string before the given parser and parse the data with the parser." $- \(cs1, i, cs2) -> do- let s1 = Text.pack $ Set.toList $ cs1 \\ Set.fromList ['0'..'9']- s2 = Text.pack $ Set.toList $ cs2 \\ Set.fromList ['0'..'9']- ds = show (abs i :: Integer)- input = s1 <> Text.pack ds <> s2- case feed (parse (takeMatch $ many1 digit) input) "" of- Done left result -> do- result `shouldBe` (s1, ds)- left `shouldBe` s2- other ->- fail $ "Not done: " <> show other+ \(NonDigits s1, Digits ds, NonDigits s2) -> do+ let input = s1 <> ds <> s2+ parse (takeMatch $ many1 digit) input `shouldBeDoneWith` ((s1, Text.unpack ds), s2)