diff --git a/CHANGELOG b/CHANGELOG new file mode 100644 --- /dev/null +++ b/CHANGELOG @@ -0,0 +1,2 @@ + + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2016, Michael Hatfield + +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 Michael Hatfield 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. diff --git a/README.markdown b/README.markdown new file mode 100644 --- /dev/null +++ b/README.markdown @@ -0,0 +1,32 @@ + + +## Package `random-strings`. + +A simple way to generate random strings for testing and benchmarking. + +A purely random character string is not always the best test case for testing +and benchmarking. These modules help generate random strings with preferences +for character sets and character properties. + +Example: + + module Main ( main ) where + + import Test.RandomStrings + + iso_alpha = onlyAlpha randomChar8 + ascii_alphanum = onlyAlphaNum randomASCII + + -- print a list of 30 random alphanumeric strings between 5 and 25 + -- chars long. + + main = do + words <- randomStringsLen (randomString ascii_alphanum) (5,25) 30 + mapM_ putStrLn words + + +Build the example with `cabal build readme-example`. + +Functions allow tuning strings for character class and toying with the +distribution of alphabetic and upper/lower-case characters. + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/random-strings.cabal b/random-strings.cabal new file mode 100644 --- /dev/null +++ b/random-strings.cabal @@ -0,0 +1,93 @@ + +name: random-strings +version: 0.1.0.0 + +license: BSD3 +license-file: LICENSE +copyright: (c) 2016 Michael Hatfield + +author: Michael Hatfield +maintainer: github@michael-hatfield.com +homepage: https://github.com/mikehat/random-strings +stability: experimental +bug-reports: https://github.com/mikehat/random-strings + +synopsis: Generate random strings with specific qualities +description: + + Useful for generating test/benchmark data, the 'Test.RandomStrings' module + provides functions for generating random character strings in the ASCII + range. You can specify probabilities for the alphabet-range chars and + capital case characters. + + +category: Text , Test +build-type: Simple +cabal-version: >=1.10 + +extra-source-files: README.markdown + , CHANGELOG + +source-repository head + type: git + location: git://github.com/mikehat/random-strings.git + branch: master + +source-repository this + type: git + location: git://github.com/mikehat/random-strings.git + branch: master + tag: 0.1 + +library + + exposed-modules: Test.RandomStrings + , Test.RandomStrings.FlipCase + + other-modules: Test.RandomStrings.Internal + + build-depends: base >=4 && <5 + , random >=1.0 && <2.0 + + hs-source-dirs: src + default-language: Haskell2010 + + +test-suite test-basics + + type: exitcode-stdio-1.0 + main-is: test-basics.hs + + build-depends: base >=4 && <5 + , random-strings + , QuickCheck + , mtl + + hs-source-dirs: tests + default-language: Haskell2010 + + +test-suite test-randomness + + type: exitcode-stdio-1.0 + main-is: test-randomness.hs + + build-depends: base >=4 && <5 + , random-strings + , QuickCheck + , mtl + , containers + + hs-source-dirs: tests + default-language: Haskell2010 + + +executable readme-example + + main-is: readme-example.hs + + build-depends: base >=4 && <5 + , random-strings + + hs-source-dirs: tests + default-language: Haskell2010 diff --git a/src/Test/RandomStrings.hs b/src/Test/RandomStrings.hs new file mode 100644 --- /dev/null +++ b/src/Test/RandomStrings.hs @@ -0,0 +1,207 @@ + +{- | + +Module : Test.RandomStrings +Description : Generate random strings for testing + +A way to generate random character strings for testing. Functions allow +tuning of strings, setting the probability of alphabetic and upper-case +characters in the resulting strings. + +Hopefully this is useful for building test and benchmark cases that are +more meaningful than the overly random strings generated by libraries like +'Test.QuickCheck'. + +Note: /Please don't use this to generate passwords!/ + +Examples: + + Generate a 10-letter word with 1 in 10 upper-case characters + + > word <- randomWord' randomASCII (1%10) 10 + + Generate a list of 500 strings from the printable ISO-8859-1 characters + with random lengths beween 5 and 20 characters. + + > let iso_printable = randomString $ onlyPrintable randomChar8 + > strings <- randomStringsLen iso_printable (5,20) 500 + > + > -- benchmarks ... + > + + +-} + +module Test.RandomStrings + ( + -- * Character generators + randomChar + , randomASCII + , randomChar8 + + -- * Specific character generators + , onlyWith + , onlyPrintable + , onlyAlpha + , onlyAlpha' + , onlyAlphaNum + , onlyUpper + , onlyLower + , randomClass + + -- * String generators + , randomWord + , randomWord' + , randomString + , randomString' + + -- * Sets of randomly generated strings + , randomStrings + , randomStringsLen + ) +where + + +import Data.Bool ( bool ) +import Data.Char +import Data.Ratio +import Control.Monad +import System.Random + +import Test.RandomStrings.Internal + + + +-- | Generate a random Char +randomChar :: IO Char +randomChar = getStdRandom $ random + + +-- | Generate a random ASCII (7-bit) char in the printable range. +randomASCII :: IO Char +randomASCII = getStdRandom $ randomR (chr 0,chr 127) + + +-- | Generate a random ISO-8859-1 (8-bit) char +randomChar8 :: IO Char +randomChar8 = getStdRandom $ randomR (chr 0,chr 255) + + +-- | Random character passing a test +onlyWith + :: (Char -> Bool) -- ^ predicate, like 'isAlpha' + -> IO Char -- ^ random char generator, like 'randomChar' or 'randomASCII' or 'randomChar8' + -> IO Char +onlyWith p gen = gen >>= \c -> if p c then return c else onlyWith p gen + + +-- | Supply a random printable character. +onlyPrintable :: IO Char -> IO Char +onlyPrintable = onlyWith isPrint + + +-- | Generate a random printable non-alphabet char. +onlyNonAlpha :: IO Char -> IO Char +onlyNonAlpha = onlyWith (not . isAlpha) . onlyPrintable + + +-- | Generate a random alphabetic char. +onlyAlpha :: IO Char -> IO Char +onlyAlpha = onlyWith isAlpha + + +-- | Generate a random alphabetic char with a probability of being upper-case. +onlyAlpha' + :: Rational -- ^ range 0 to 1; chance of being an upper + -> IO Char -- ^ random char generator; 'randomChar', 'randomASCII', 'randomChar8' + -> IO Char +onlyAlpha' r gen = randomClass r (onlyUpper gen) (onlyLower gen) + + +-- | Generate an alphanumeric char. +onlyAlphaNum :: IO Char -> IO Char +onlyAlphaNum = onlyWith isAlphaNum + +-- | Randomly generate one of two character types +randomClass + :: Rational -- ^ range 0 to 1; chance of using the first generator + -> IO Char -- ^ first generator; used if the random value is @True@ + -> IO Char -- ^ second generator; used if the random value is @False@ + -> IO Char +randomClass r t f = randomBool r >>= bool f t + + +-- | Generate a random upper-case letter. +onlyUpper :: IO Char -> IO Char +onlyUpper = onlyWith isUpper + + +-- | Generate a random lower-case letter. +onlyLower :: IO Char -> IO Char +onlyLower = onlyWith isLower + + + +-- | Generate a random string of alphabetic characters. +randomWord + :: IO Char -- ^ random char generator; 'randomChar' or 'randomASCII' or 'randomChar8' + -> Int -- ^ length + -> IO String +randomWord gen len = replicateM len $ onlyAlpha gen + +randomWord' + :: IO Char -- ^ random char generator; 'randomChar' or 'randomASCII' or 'randomChar8' + -> Rational -- ^ range 0 to 1; fraction of upper-case letters + -> Int -- ^ length + -> IO String +randomWord' gen r len = replicateM len $ onlyAlpha' r gen + + +-- | Generate a random string +randomString + :: IO Char -- ^ random char generator; eg. 'randomChar8' or @onlyAlpha randomASCII@ + -> Int -- ^ length + -> IO String +randomString = flip replicateM + +-- | Generate a random string of printable characters with a balance of +-- alphabetic and upper-case characters. +randomString' + :: IO Char -- ^ random char generator; 'randomChar' or 'randomASCII' or 'randomChar8' + -> Rational -- ^ range 0 to 1; fraction of alphabetic characters + -> Rational -- ^ range 0 to 1; fraction of upper-case letters + -> Int -- ^ length + -> IO String +randomString' gen ra ru len = replicateM len $ randomClass ra (randomClass ru (onlyUpper gen) (onlyLower gen)) (onlyNonAlpha gen) + + +-- | Generate a list of strings of uniform length. +-- +-- > randomStrings (randomString (onlyAlpha randomChar8) 20) 50 +-- +-- will build a list of 50 alphabetical strings, each 20 characters long. +-- +randomStrings + :: IO String -- ^ random string generator, eg. 'randomString randomAlpha 20' + -> Int -- ^ list length + -> IO [String] +randomStrings = flip replicateM + + +-- | Generate a list of strings of variable length. +-- +-- Similar to 'randomStrings', but generates strings with random length. +-- Example: +-- +-- > randomStringsLen (randomString' randomASCII (3%4) (1%8)) (10,30) 100 +-- +-- Returns a list of 100 strings that are between 10 and 30 characters, +-- with 3/4 of them being alphabetical and 1/8 of those being upper-case. +-- +randomStringsLen + :: (Int -> IO String) -- ^ random string generator, eg. @randomString randomAlpha@ + -> (Int,Int) -- ^ range for string length + -> Int -- ^ list length + -> IO [String] +randomStringsLen gen range len = replicateM len $ getStdRandom (randomR range) >>= gen + diff --git a/src/Test/RandomStrings/FlipCase.hs b/src/Test/RandomStrings/FlipCase.hs new file mode 100644 --- /dev/null +++ b/src/Test/RandomStrings/FlipCase.hs @@ -0,0 +1,60 @@ + + + +{- | + +module : Test.RandomStrings.FlipCase +description : Randomly flip case of strings + +A helper for randomly changing the case in strings. Useful for generating +test-cases for case-insensitive matching. + +-} + +module Test.RandomStrings.FlipCase + ( flipCase + , flipCaseString + , randomFlipCase + , randomFlipCaseString + ) +where + + +import Data.Bool ( bool ) +import Data.Char +import Data.Ratio +import Control.Monad +import System.Random + +import Test.RandomStrings.Internal + + + +-- | Toggle the case of a @Char@. +flipCase :: Char -> Char +flipCase c + | isUpper c = toLower c + | isLower c = toUpper c + | otherwise = c + + +-- | Toggle character case for a @String@. +flipCaseString :: String -> String +flipCaseString = map flipCase + + +-- | Randomly flip the case of a @Char@. +randomFlipCase + :: Rational -- ^ range 0 to 1; chance of flipping case + -> Char -- ^ @Char@ to flip + -> IO Char +randomFlipCase r c = randomBool r >>= bool (return c) (return $ flipCase c) + + +-- | Randomly flip the case of a @String@. +randomFlipCaseString + :: Rational -- ^ range 0 to 1; chance of flipping case + -> String -- ^ original @String@ + -> IO String +randomFlipCaseString r = mapM (randomFlipCase r) + diff --git a/src/Test/RandomStrings/Internal.hs b/src/Test/RandomStrings/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Test/RandomStrings/Internal.hs @@ -0,0 +1,22 @@ + +{- | + module: Test.RandomStrings.Internal + +-} + +module Test.RandomStrings.Internal +where + + +import Data.Ratio +import System.Random + + + +-- | Flip a 'loaded' coin with a certain chance of being True +randomBool + :: Rational -- ^ range 0 to 1; chance of being true + -> IO Bool +randomBool r = do + roll <- getStdRandom $ randomR (1,denominator r) + return $ roll <= numerator r diff --git a/tests/readme-example.hs b/tests/readme-example.hs new file mode 100644 --- /dev/null +++ b/tests/readme-example.hs @@ -0,0 +1,13 @@ + + +module Main ( main ) where + +import Test.RandomStrings + +iso_alpha = onlyAlpha randomChar8 +ascii_alphanum = onlyAlphaNum randomASCII + +main = do + words <- randomStringsLen (randomString ascii_alphanum) (5,25) 30 + mapM_ putStrLn words + diff --git a/tests/test-basics.hs b/tests/test-basics.hs new file mode 100644 --- /dev/null +++ b/tests/test-basics.hs @@ -0,0 +1,112 @@ + +{- + +These are some simple tests that may seem so obvious they shouldn't be +necessary. There is nothing here to verify proper randomness, just that the +mechanics like string lengths and character classes are working properly. + +-} + +module Main ( main ) where + +import Test.QuickCheck +import Test.QuickCheck.Monadic + +import Control.Monad.State +import System.IO +import System.Exit + +import Data.Char + +import Test.RandomStrings + + + +extraTests = stdArgs { maxSuccess = 1000 } + +main = do + success <- flip execStateT True $ do + liftTest "randomASCII" extraTests prop_randomASCII + liftTest "randomChar8" extraTests prop_randomChar8 + liftTest "randomAlphaChar" extraTests prop_randomAlphaChar + liftTest "randomAlphaChar8" extraTests prop_randomAlphaChar8 + liftTest "randomAlphaASCII" extraTests prop_randomAlphaASCII + liftTest "randomUpperASCII" extraTests prop_randomUpperASCII + liftTest "randomWord" stdArgs prop_randomWord + liftTest "randomStrings" stdArgs prop_randomStrings + liftTest "randomStringsLen" stdArgs prop_randomStringsLen + + if success then exitSuccess else exitFailure + + +indent = replicate 4 ' ' + +liftTest :: (Testable prop) => String -> Args -> prop -> StateT Bool IO () +liftTest name args prop = do + liftIO $ putStr $ take 25 $ concat [ indent , name , ":" , repeat ' ' ] + r <- liftIO $ quickCheckWithResult args prop + case r of Success {} -> return () + _ -> put False + + + + +in_range :: (Ord a) => (a,a) -> a -> Bool +in_range (lbound,ubound) a = a >= lbound && a <= ubound + +is_ascii :: Char -> Bool +is_ascii = in_range (0,127) . fromEnum + +is_char8 :: Char -> Bool +is_char8 = in_range (0,255) . fromEnum + + +prop_randomASCII :: Property +prop_randomASCII = monadicIO $ run randomASCII >>= assert . is_ascii + +prop_randomChar8 :: Property +prop_randomChar8 = monadicIO $ run randomChar8 >>= assert . is_char8 + +prop_randomAlphaChar :: Property +prop_randomAlphaChar = monadicIO $ run (onlyAlpha randomChar) >>= assert . isAlpha + +prop_randomAlphaChar8 :: Property +prop_randomAlphaChar8 = monadicIO $ run (onlyAlpha randomChar8) >>= assert . isAlpha + +prop_randomAlphaASCII :: Property +prop_randomAlphaASCII = monadicIO $ run (onlyAlpha randomASCII) >>= assert . isAlpha + +prop_randomUpperASCII :: Property +prop_randomUpperASCII = monadicIO $ run (onlyUpper randomASCII) >>= assert . isUpper + +prop_randomWord :: Int -> Property +prop_randomWord len = monadicIO $ run (randomWord randomChar8 $ len') >>= assert . (== len') . length + where len' = len `mod` 500 -- max string length in 0 to 499, please + +prop_randomStrings :: Int -> Int -> Property +prop_randomStrings str_len list_len = monadicIO $ do + let str_len' = str_len `mod` 100 + list_len' = list_len `mod` 200 + strings <- run $ randomStrings (randomString randomChar str_len') list_len' + + -- all strings are the right length + assert $ all (== str_len') $ map length strings + + -- the list is the right length + assert $ length strings == list_len' + +prop_randomStringsLen :: (Int,Int) -> Int -> Property +prop_randomStringsLen (min_len,max_len) list_len = monadicIO $ do + let min_len' = min_len `mod` 100 + max_len' = max_len `mod` 100 + list_len' = list_len `mod` 200 + limits' = (min_len',max_len') + pre $ min_len' <= max_len' + strings <- run $ randomStringsLen (randomString randomChar) limits' list_len' + + -- all strings length are within the range + assert $ all (in_range limits') $ map length strings + + -- the list is the right length + assert $ length strings == list_len' + diff --git a/tests/test-randomness.hs b/tests/test-randomness.hs new file mode 100644 --- /dev/null +++ b/tests/test-randomness.hs @@ -0,0 +1,119 @@ + + +{- + +These tests are not the most correct tests of randomness and are not intended +to put the random number generator in the spotlight. The hope is that any gross +coding error in this library will be caught. + +If there are some more rigorous tests that are easy to implement without adding +too many dependencies, please send suggestions. Even a more mathematical +approach to static numbers for test repetitions and failure limits would be a +welcome improvement. I'm not about to drag out my moldy old textbooks and do +it myself. I'd certainly rather do that than my day job ... + +-} + +module Main ( main ) where + +import Test.QuickCheck +import Test.QuickCheck.Monadic + +import Control.Monad +import Control.Monad.State +import System.IO +import System.Exit + +import Data.Char +import Data.Ord ( max ) +import Data.Ratio ( (%) ) +import qualified Data.Map.Strict as M + +import Test.RandomStrings +import Test.RandomStrings.FlipCase + + +extraTests = stdArgs { maxSuccess = 1000 } + + +main = do + success <- flip execStateT True $ do + liftTest "randomAlpha'" stdArgs prop_randomAlpha' + liftTest "randomString'" stdArgs prop_randomString' + liftTest "randomStringsLen" stdArgs prop_randomStringsLen + liftTest "randomFlipCase" stdArgs prop_randomFlipCase + if success then exitSuccess else exitFailure + +indent = replicate 4 ' ' + +liftTest :: (Testable prop) => String -> Args -> prop -> StateT Bool IO () +liftTest name args prop = do + liftIO $ putStr $ take 25 $ concat [ indent , name , ":" , repeat ' ' ] + r <- liftIO $ quickCheckWithResult args prop + case r of Success {} -> return () + _ -> put False + + +in_range :: (Ord a) => (a,a) -> a -> Bool +in_range (lbound,ubound) a = a >= lbound && a <= ubound + + + +prop_randomAlpha' :: Property +prop_randomAlpha' = monadicIO $ do + sample <- liftIO $ replicateM 1000 $ onlyAlpha' (1%10) randomChar8 + + -- all characters are alphabetic + assert $ all isAlpha sample + + -- there are not too many upper-case chars + assert $ (length $ filter isUpper sample) < 200 -- should be around 100 + + -- to single char is too frequent + let freq = foldr (\c -> M.insertWith (+) c 1) M.empty sample + max_freq = M.foldl max 0 freq + assert $ max_freq < 60 -- why? made it up. Average max is around 30 + + +prop_randomString' :: Property +prop_randomString' = monadicIO $ do + sample <- liftIO $ randomString' randomASCII (9%10) (1%10) 1000 + + -- there are about the right number of alphabetic chars + assert $ (length $ filter isAlpha sample) > 800 -- should be around 900 + + -- there are the right number of upper-case chars + assert $ (length $ filter isUpper sample) < 180 -- should be around 90 + + -- no single char appears too often + let freq = foldr (\c -> M.insertWith (+) c 1) M.empty sample + max_freq = M.foldl max 0 freq + assert $ max_freq < 80 -- why? made it up. Average max around 40 + + +prop_randomStringsLen :: Property +prop_randomStringsLen = monadicIO $ do + samples <- liftIO $ randomStringsLen (randomWord randomChar) (5,95) 1000 + + -- strings are the right length + assert $ all (in_range (5,95) . length ) samples + + -- string lengths have a nice distribution + let freq = foldr (\c -> M.insertWith (+) c 1) M.empty $ map length samples + max_freq = M.foldl max 0 freq + assert $ max_freq < 40 -- why? made it up. Average max around 20 + +prop_randomFlipCase :: Property +prop_randomFlipCase = monadicIO $ do + original <- run $ randomWord (onlyUpper randomASCII) 100 + sample <- run $ randomFlipCaseString (1%2) original + + -- correct length + assert $ length sample == 100 + + -- only case-flipping happened + assert $ (map toLower original) == (map toLower sample) + + -- about the right number of chars are flipped + -- liftIO $ putStrLn $ show $ length $ filter isLower sample + assert $ in_range (30,70) $ length $ filter isLower sample