substring-parser-0.4.0.0: test/Spec.hs

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)