string-random (empty) → 0.1.0.0
raw patch · 7 files changed
+523/−0 lines, 7 filesdep +QuickCheckdep +attoparsecdep +basesetup-changed
Dependencies added: QuickCheck, attoparsec, base, bytestring, containers, pcre-heavy, random, string-random, tasty, tasty-hunit, tasty-quickcheck, text, transformers
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- src/Text/StringRandom.hs +130/−0
- src/Text/StringRandom/Parser.hs +161/−0
- string-random.cabal +60/−0
- test/string-random-quickcheck.hs +33/−0
- test/string-random-test.hs +107/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright hiratara (c) 2016++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 hiratara nor Masahiro Honma+ 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Text/StringRandom.hs view
@@ -0,0 +1,130 @@+{-|+Module : Text.StringRandom+Description : generating random string from a regexp+Copyright : Copyright (C) 2016- hiratara+License : GPL-3+Maintainer : hiratara@cpan.org+Stability : experimental++Generate a random character string that matches the given regular expression.+This library ported String_random.js to Haskell.++@+ {-# LANGUAGE OverloadedStrings #-}+ import Text.StringRandom++ main = do+ ymd <- stringRandomIO "20\\d\\d-(1[0-2]|0[1-9])-(0[1-9]|1\\d|2[0-8])"+ print ymd -- "2048-12-08" etc.+@++See <https://github.com/cho45/String_random.js/blob/master/lib/String_random.js String_random.js>++As with this package, there are <https://hackage.haskell.org/package/random-strings random-strings>+in packages that generate random strings, but this module is superior in the+following respects.++ * The format of the string to be generated using regular expressions+ * You can change the random number generator (e.g. tf-random package)+ * With pure calculation without using IO monad.+-}++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Strict #-}+module Text.StringRandom+ ( stringRandomIO+ , stringRandom+ , stringRandomWithError+ ) where++import qualified Data.IntMap.Strict as Map+import qualified Data.Text as Text+import qualified System.Random as Random+import qualified Text.StringRandom.Parser as Parser+import qualified Control.Monad.Trans.RWS.Strict as RWS++-- Int: size, g: generater, IntMap: Record backrefs+type GenRWS g = RWS.RWS Int () (g, Map.IntMap Text.Text)++{-|+The 'stringRandomIO' function generates random strings that match the given+regular expression. Regular expression is specified by 'Text' type. This+function internally uses the random number generator generated by 'newStdGen'.+-}+stringRandomIO :: Text.Text -> IO Text.Text+stringRandomIO txt = do+ g <- Random.newStdGen+ return $ stringRandom g txt++{-|+The 'stringRandom' function uses a specified random number generator to+generate a random string that matches a given regular expression.+An exception is raised if the regular expression can not be parsed.+-}+stringRandom :: Random.RandomGen g => g -> Text.Text -> Text.Text+stringRandom g txt = case stringRandomWithError g txt of+ Left l -> error l+ Right r -> r++{-|+The 'stringRandomWithError' function behaves like the 'stringRandom'+function, but notifies the error through the Either monad.+-}+stringRandomWithError :: Random.RandomGen g => g -> Text.Text -> Either String Text.Text+stringRandomWithError g txt = do+ parsed <- Parser.processParse txt+ -- 10 : max length of a* or a++ let (ret, _) = RWS.evalRWS (str parsed) 10 (g, Map.empty)+ return ret++withGen :: Random.RandomGen g => (g -> (a, g)) -> GenRWS g a+withGen f = do+ (gen, m) <- RWS.get+ let (a, gen') = f gen+ RWS.put (gen', m)+ return a++randomRM :: (Random.RandomGen g, Random.Random a) => (a, a) -> GenRWS g a+randomRM = withGen . Random.randomR++-- randomM :: (Random.RandomGen g, Random.Random a) => GenRWS g a+-- randomM = withGen Random.random++choice :: Random.RandomGen g => [a] -> GenRWS g a+choice xs = do+ i <- randomRM (0, length xs - 1)+ return $ xs !! i++putGroup :: Int -> Text.Text -> GenRWS g ()+putGroup n v = do+ (gen, m) <- RWS.get+ let m' = Map.insert n v m+ RWS.put (gen, m')++getGroup :: Int -> GenRWS g Text.Text+getGroup n = do+ m <- RWS.gets snd+ let maybeV = Map.lookup n m+ case maybeV of+ Nothing -> return ""+ Just v -> return v++size :: GenRWS g Int+size = RWS.ask++str :: Random.RandomGen g => Parser.Parsed -> GenRWS g Text.Text+str (Parser.PClass cs) = Text.singleton <$> choice cs+str (Parser.PRange s me p) = do+ e <- case me of+ Just e' -> return e'+ Nothing -> size+ n <- randomRM (s, e)+ Text.concat <$> mapM (const $ str p) [1 .. n]+str (Parser.PConcat ps) = Text.concat <$> mapM str ps+str (Parser.PSelect ps) = str =<< choice ps+str (Parser.PGrouped n p) = do+ v <- str p+ putGroup n v+ return v+str (Parser.PBackward n) = getGroup n+str (Parser.PIgnored) = return ""
+ src/Text/StringRandom/Parser.hs view
@@ -0,0 +1,161 @@+{-|+Module : Text.StringRandom.Parser+Description : Simple regular expression parser+Copyright : Copyright (C) 2016- hiratara+License : GPL-3+Maintainer : hiratara@cpan.org+Stability : experimental++Parse the regular expression so that it can be used with the+"Text.StringRandom" module.++See <https://github.com/cho45/String_random.js/blob/master/lib/String_random.js String_random.js>+-}++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Strict #-}+module Text.StringRandom.Parser+ ( Parsed(..)+ , processParse+ ) where++import qualified Data.Attoparsec.Text as Attoparsec+import Data.Attoparsec.Text+ ( char+ , anyChar+ , satisfy+ , string+ , digit+ , many1+ , endOfInput+ )+import Data.List ((\\))+import qualified Data.Text as Text+import Control.Applicative ((<|>), optional, many)+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.State.Strict (evalStateT, StateT, gets, put)++-- Int :: A sequence number of groups (X)+type RegParser a = StateT Int Attoparsec.Parser a++-- | Abstract syntax tree of parsed regular expression+data Parsed = PClass [Char] -- ^ [abc], \d, [^abc]+ | PRange Int (Maybe Int) Parsed -- ^ X*, X{1,2}, X+, X?+ | PConcat [Parsed] -- ^ XYZ+ | PSelect [Parsed] -- ^ X|Y|Z+ | PGrouped Int Parsed -- ^ (X)+ | PBackward Int -- ^ \1, \2, ..., \9+ | PIgnored -- ^ ^, $, \b+ deriving (Show, Eq)++pConcat :: [Parsed] -> Parsed+pConcat [x] = x+pConcat xs = PConcat xs++pSelect :: [Parsed] -> Parsed+pSelect [x] = x+pSelect xs = PSelect xs++{-|+'processParse' parses the regular expression string and returns an abstract+syntax tree. If there is an error in the regular expression, it returns the+'Left' value.+-}+processParse :: Text.Text -> Either String Parsed+processParse = let p = evalStateT selectParser 0+ in Attoparsec.parseOnly (p <* endOfInput)++selectParser :: RegParser Parsed+selectParser = do+ p0 <- concats+ ps <- many (lift (char '|') *> concats)+ return $ pSelect (p0:ps)+ where+ concats = pConcat <$> many rangedParser++rangedParser :: RegParser Parsed+rangedParser = do+ p <- groupingParser+ let opt = char '?' *> return (PRange 0 (Just 1) p)+ star = char '*' *> return (PRange 0 Nothing p)+ plus = char '+' *> return (PRange 1 Nothing p)+ rep = do+ char '{'+ min <- read <$> many1 digit+ max' <- optional $ char ',' *> many digit+ let max = case max' of+ Nothing -> Just min+ Just [] -> Nothing+ Just ds -> Just $ read ds+ char '}'+ return $ PRange min max p+ lift $ opt <|> star <|> plus <|> rep <|> return p++groupingParser :: RegParser Parsed+groupingParser = ngroup <|> group <|> classParser <|> escaped <|> dot <|> ignored <|> others+ where+ ngroup = lift (string "(?:") *> selectParser <* lift (char ')')+ group = do+ n <- gets (+ 1)+ put n+ p <- lift (char '(') *> selectParser <* lift (char ')')+ return $ PGrouped n p+ escaped = lift $ do+ ch <- char '\\' *> anyChar+ return $ case ch of+ _ | ch == 'b' -> PIgnored -- Don't support \b+ | ch `elem` ['1' .. '9'] -> PBackward (read [ch])+ | otherwise -> PClass (classes ch)+ dot = lift $ char '.' *> return (PClass allC)+ ignored = lift $ satisfy (`elem` ['^', '$']) *> return PIgnored+ others = lift $ PClass . (: []) <$> satisfy (`notElem` reservedChars)++classParser :: RegParser Parsed+classParser = lift $+ PClass . (allC \\) <$> (string "[^" *> p <* char ']')+ <|> PClass <$> (char '[' *> p <* char ']')+ where+ p :: Attoparsec.Parser [Char]+ p = concat <$> many p1+ p1 = do+ ch <- onechar+ r <- optional (char '-' *> onechar)+ return $ case r of+ Just rch+ | length ch == 1 && length rch == 1+ -> enumFromTo (head ch) (head rch)+ -- Handle the case of [^\w-\d]+ | otherwise+ -> ch ++ '-' : rch+ Nothing -> ch+ onechar = classes <$> (char '\\' *> anyChar)+ <|> (: []) <$> satisfy (`notElem` classReservedChars)++uppersC, lowersC, digitsC, spacesC, othersC, allC :: [Char]+uppersC = ['A'..'Z']+lowersC = ['a'..'z']+digitsC = ['0'..'9']+spacesC = " \n\t"+othersC = "!\"#$%&'()*+,-./:;<=>?@[\\]^`{|}~"+allC = concat [uppersC, lowersC, digitsC, " ", othersC, "_"]++classes :: Char -> [Char]+classes 'd' = digitsC+classes 'D' = concat [uppersC, lowersC, spacesC, othersC, "_"]+classes 'w' = concat [uppersC, lowersC, digitsC, "_"]+classes 'W' = concat [spacesC, othersC]+classes 't' = "\t"+classes 'n' = "\n"+classes 'v' = "\x000b"+classes 'f' = "\x000c"+classes 'r' = "\r"+classes 's' = spacesC+classes 'S' = concat [uppersC, lowersC, digitsC, othersC, "_"]+classes '0' = "\0"+classes c = [c]++reservedChars :: [Char]+reservedChars = "\\()|^$*+{?[." -- ]++classReservedChars :: [Char]+classReservedChars = "\\]" -- -^
+ string-random.cabal view
@@ -0,0 +1,60 @@+name: string-random+version: 0.1.0.0+synopsis: A library for generating random string from a regular experession+description: With this package you can generate random strings from+ regular expressions. If you are using QuickCheck, you can+ also check the quickcheck-string-random package.+homepage: https://github.com/hiratara/hs-string-random#readme+license: BSD3+license-file: LICENSE+author: Masahiro Honma+maintainer: hiratara@cpan.org+copyright: Copyright (C) 2016- hiratara+category: Text+build-type: Simple+cabal-version: >=1.10+tested-with: GHC ==8.0.1++library+ hs-source-dirs: src+ exposed-modules: Text.StringRandom+ , Text.StringRandom.Parser+ build-depends: base >= 4.9 && < 5+ , attoparsec >=0.13.1 && <0.14+ , containers >=0.5.7.1 && <0.6+ , random >=1.1 && <1.2+ , text >=1.2.2.1 && <1.3+ , transformers >=0.5.2.0 && <0.6+ default-language: Haskell2010++test-suite string-random-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: string-random-test.hs+ build-depends: base+ , bytestring+ , pcre-heavy+ , string-random+ , tasty+ , tasty-hunit+ , text+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010++test-suite string-random-quickcheck+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: string-random-quickcheck.hs+ build-depends: base+ , pcre-heavy+ , QuickCheck+ , string-random+ , tasty+ , tasty-quickcheck+ , text+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/hiratara/hs-string-random
+ test/string-random-quickcheck.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Strict #-}+import Data.Monoid ((<>))+import qualified Data.Text as Text+import Data.Text.Encoding (encodeUtf8)+import qualified Test.QuickCheck as QC+import qualified Test.QuickCheck.Gen as QC+import qualified Test.QuickCheck.Random as QC+import qualified Text.StringRandom as StringRandom+import qualified Test.Tasty as Tasty+import qualified Test.Tasty.QuickCheck as TastyQC+import Text.Regex.PCRE.Heavy (compileM, (=~))++regexp :: QC.Gen Text.Text+regexp = QC.MkGen $ \(QC.QCGen g) _ -> StringRandom.stringRandom g regregexp+ where regregexp = "((\\w|" <> classes <> "|\\(\\w+\\))(\\{[0-4],[5-9]\\}|\\*|\\+|))*"+ classes = "\\[^?(\\w|" <> escaped <> "|a-z)+-?\\]"+ escaped = "\\\\[dDwWsSnr\\[\\]|.(){}^$-]"++main :: IO ()+main = Tasty.defaultMain (TastyQC.testProperty+ "by quickcheck" prop_stringRandom)++prop_stringRandom :: QC.Property+prop_stringRandom = QC.forAll regexp $ \pat -> QC.ioProperty $ do+ let pat' = "^" <> fixBS pat <> "$"+ (Right reg) = compileM pat' []+ randbs <- fixBS <$> StringRandom.stringRandomIO pat+ return $ randbs =~ reg++ where+ -- Seems that PCRE can't handle strings generated by encodeUtf8+ fixBS = (<> "") . encodeUtf8
+ test/string-random-test.hs view
@@ -0,0 +1,107 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE FlexibleContexts #-}+import Data.Monoid ((<>))+import qualified Data.ByteString as ByteString+import qualified Data.Text.Encoding as Encoding+import Control.Monad (forM_)+import qualified Text.StringRandom as StringRandom+import qualified Text.StringRandom.Parser as Parser+import qualified Test.Tasty as Tasty+import qualified Test.Tasty.HUnit as HUnit+import Test.Tasty.HUnit ((@?=), (@?))+import qualified Text.Regex.PCRE.Heavy as PCRE++main :: IO ()+main = Tasty.defaultMain allTests++allTests :: Tasty.TestTree+allTests = Tasty.testGroup "All tests of random-string"+ [ testParser+ , testStringRandom+ ]++testParser :: Tasty.TestTree+testParser = HUnit.testCase "Test parsers" $ do+ Parser.processParse "" @?= Right (Parser.PConcat [])+ Parser.processParse "a" @?= Right (Parser.PClass "a")+ Parser.processParse "[a-c]" @?= Right (Parser.PClass "abc")+ Parser.processParse "\\d" @?= Right (Parser.PClass "0123456789")+ Parser.processParse "[^\\w\\W]" @?= Right (Parser.PClass "")++ Parser.processParse "a*" @?= Right (Parser.PRange+ 0 Nothing (Parser.PClass "a"))+ Parser.processParse "a+" @?= Right (Parser.PRange+ 1 Nothing (Parser.PClass "a"))+ Parser.processParse "a{3}" @?= Right (Parser.PRange+ 3 (Just 3) (Parser.PClass "a"))+ Parser.processParse "a{1,}" @?= Right (Parser.PRange+ 1 Nothing (Parser.PClass "a"))+ Parser.processParse "a{1,3}" @?= Right (Parser.PRange+ 1 (Just 3) (Parser.PClass "a"))++ Parser.processParse "abc" @?= Right (Parser.PConcat+ [ Parser.PClass "a"+ , Parser.PClass "b"+ , Parser.PClass "c"+ ])++ Parser.processParse "a|b|c" @?= Right (Parser.PSelect+ [ Parser.PClass "a"+ , Parser.PClass "b"+ , Parser.PClass "c"+ ])++ Parser.processParse "((a)(?:b)(c))" @?=+ Right (Parser.PGrouped 1+ ( Parser.PConcat+ [ Parser.PGrouped 2 (Parser.PClass "a")+ , Parser.PClass "b"+ , Parser.PGrouped 3 (Parser.PClass "c")+ ]+ )+ )++ Parser.processParse "\\5" @?= Right (Parser.PBackward 5)++ Parser.processParse "^a\\b$" @?= Right (Parser.PConcat+ [ Parser.PIgnored+ , Parser.PClass "a"+ , Parser.PIgnored+ , Parser.PIgnored+ ])++testStringRandom :: Tasty.TestTree+testStringRandom = HUnit.testCase "Test stringRandomIO" $ do+ e <- StringRandom.stringRandomIO ""+ e @?= ""++ e' <- StringRandom.stringRandomIO "a{0}"+ e' @?= ""++ let patterns =+ [ ""+ , "a"+ , "[a-c]"+ , "\\d"+ , "[^\\W]"+ , "a*"+ , "a+"+ , "a{4}"+ , "a{2,}"+ , "a{2,4}"+ , "abc"+ , "a|b|c"+ , "((a)(?:b)(c))"+ , "(.*)\\1"+ ]+ forM_ patterns $ \pat -> do+ let pat' = "^" <> fixBS pat <> "$"+ (Right reg) = PCRE.compileM pat' []+ randbs <- fixBS <$> StringRandom.stringRandomIO pat+ randbs PCRE.=~ reg @? ("check regexp: " ++ show pat'+ ++ ", string: " ++ show randbs)++ where+ -- Seems that PCRE can't handle strings generated by encodeUtf8+ fixBS = (<> "") . Encoding.encodeUtf8