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 (Result, IResult(Done), parse, feed, many1, digit, string) import Data.Monoid ((<>)) 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 "replaceOnceWithParser" $ do it "replace first matching text by parser" $ replaceOnceWithParser (string "abc" *> pure "def") "--abc-abc-" `shouldBe` "--def-abc-" it "returns the source text if parser doesn't match" $ do 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." $ \(NonDigits s1, Digits ds, NonDigits s2) -> do let input = s1 <> ds <> s2 parse (takeMatch $ many1 digit) input `shouldBeDoneWith` ((s1, Text.unpack ds), s2)