content: {-# LANGUAGE RecordWildCards, NamedFieldPuns #-}
  module Regex.Genex.Pure (genexPure) where
  import qualified Data.Text as T
  import qualified Data.IntSet as IntSet
  import qualified Data.Set as Set
  import Data.List (intersect, (\\))
  import Control.Monad
  import Control.Monad.Stream
  import qualified Control.Monad.Stream as Stream
  import Regex.Genex.Normalize (normalize)
  import Debug.Trace
  import Text.Regex.TDFA.Pattern
  import Text.Regex.TDFA.ReadRegex (parseRegex)
  import Control.Monad.State
  import Control.Applicative
  
  parse :: String -> Pattern
  parse r = case parseRegex r of
      Right (pattern, _) -> pattern
      Left x -> error $ show x
  
  genexPure :: [String] -> [String]
  genexPure = map T.unpack . foldl1 intersect . map (Stream.runStream . run . normalize IntSet.empty . parse)
  
  maxRepeat :: Int
  maxRepeat = 10
  
  each = foldl1 (<|>) . map return
  
  run :: Pattern -> Stream T.Text
  run p = case p of
      PEmpty -> pure T.empty
      PChar{..} -> isChar getPatternChar
      PAny {getPatternSet = PatternSet (Just cset) _ _ _} -> each $ map T.singleton $ Set.toList cset
      PAnyNot {getPatternSet = PatternSet (Just cset) _ _ _} -> chars $ notChars $ concatMap expandEscape $ Set.toList cset
      PQuest p -> pure T.empty <|> run p
      PPlus p -> run $ PBound 1 Nothing p
      PStar _ p -> run $ PBound 0 Nothing p
      PBound low high p -> do
          n <- each [low..maybe (low+maxRepeat) id high]
          fmap T.concat . sequence $ replicate n (run p) 
      PConcat ps -> fmap T.concat . suspended . sequence $ map run ps
      POr xs -> foldl1 mplus $ map run xs
      PDot{} -> chars $ notChars []
      PEscape {..} -> chars $ expandEscape getPatternChar
      _      -> error $ show p
      where
      isChar = return . T.singleton
      chars = each . map T.singleton
      notChars = ([' '..'~'] \\)
      expandEscape ch = case ch of
          'n' -> "\n"
          't' -> "\t"
          'r' -> "\r"
          'f' -> "\f"
          'a' -> "\a"
          'e' -> "\ESC"
          'd' -> ['0'..'9']
          'w' -> ['0'..'9'] ++ '_' : ['a'..'z'] ++ ['A'..'Z']
          's' -> "\9\32"
          'D' -> notChars $ ['0'..'9']
          'W' -> notChars $ ['0'..'9'] ++ '_' : ['a'..'z'] ++ ['A'..'Z']
          'S' -> notChars "\9\32"
          ch  -> [ch]
  