fork download 
  1. {-# LANGUAGE LambdaCase #-}
  2.  
  3. import           Prelude                      hiding (any)
  4. import           System.Random
  5. import           Text.ParserCombinators.ReadP hiding (option)
  6.  
  7. data Entity
  8.   = Single Char
  9.   | Any
  10.   | Range Char Char
  11.   | Option [CountedEntity]
  12.   deriving Show
  13.  
  14. data CountedEntity
  15.   = One Entity
  16.   | OneOrMore Entity
  17.   | Many Entity
  18.   deriving Show
  19.  
  20. type Regex = [CountedEntity]
  21.  
  22. main :: IO ()
  23. main = do
  24.   g <- getStdGen
  25.   interact
  26.     $ unlines
  27.     . zipWith genRegex (gens g)
  28.     . map parseRegex
  29.     . lines
  30.  
  31. gens :: RandomGen g => g -> [g]
  32. gens g = let ~(g0, g1) = split g in g0 : gens g1
  33.  
  34. parseRegex :: String -> Regex
  35. parseRegex = fst . head . readP_to_S regex
  36.  
  37. regex :: ReadP Regex
  38. regex = manyTill countedEntity eof
  39.  
  40. countedEntity :: ReadP CountedEntity
  41. countedEntity = do
  42.   e <- entity
  43.   choice
  44.     [ OneOrMore e <$ char '+'
  45.     , Many e <$ char '*'
  46.     , return $ One e
  47.     ]
  48.  
  49. entity :: ReadP Entity
  50. entity = choice [option, range, any, single]
  51.  
  52. option :: ReadP Entity
  53. option = Option <$> between (char '[') (char ']') (many countedEntity)
  54.  
  55. range :: ReadP Entity
  56. range = do
  57.   a <- simpleChar
  58.   char '-'
  59.   b <- simpleChar
  60.   return $ Range a b
  61.  
  62. any :: ReadP Entity
  63. any = Any <$ char '.'
  64.  
  65. single :: ReadP Entity
  66. single = Single <$> simpleChar
  67.  
  68. simpleChar :: ReadP Char
  69. simpleChar = choice
  70.   [ char '\\' *> get
  71.   , satisfy (`notElem` ".+*[]-")
  72.   ]
  73.  
  74. genRegex :: RandomGen g => g -> Regex -> String
  75. genRegex g = concat . zipWith genCountedEntity (gens g)
  76.  
  77. genCountedEntity :: RandomGen g => g -> CountedEntity -> String
  78. genCountedEntity g = \case
  79.   One e       -> genEntity g e
  80.   OneOrMore e -> more (n + 1) e
  81.   Many e      -> more n e
  82.   where
  83.     (n, g') = randomR (0, 10) g -- arbitrary limit of 10
  84.     more x  = concat
  85.             . zipWith genEntity (gens g')
  86.             . replicate x
  87.  
  88. genEntity :: RandomGen g => g -> Entity -> String
  89. genEntity g = \case
  90.   Single c  -> [c]
  91.   Any       -> [fst $ random g]
  92.   Range a b -> [fst $ randomR (a, b) g]
  93.   Option es ->
  94.     let (n, g') = randomR (0, length es - 1) g
  95.     in  genCountedEntity g' (es !! n)
Success #stdin #stdout 0s 8388607KB
comments ()
stdin 
a+b
abc*d
[A-Za-z0-9$.+!*'(){},~:;=@#%_\-]*
ab[c-l]+jkm9*10+
iqb[beoqob-q]872+0qbq*
stdout 
aab
abccccd
:,~#
abcgjfjcgfgdjkm9999910000000000
iqbe87220qbqqq
https://ideone.com/jBhqgS
language:
Haskell (ghc 8.4.4)
created:
8 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!