module PrintRegExp(sym,intP,regexp,whiteSp,parseRegExp,short) where

import RegExp 

-- These are for defining parsers
import Text.ParserCombinators.Parsec  
import Text.ParserCombinators.Parsec.Language(javaStyle,haskellStyle)
import Text.ParserCombinators.Parsec.Expr(Operator(..),Assoc(..),buildExpressionParser)
import Text.ParserCombinators.Parsec.Token
import Text.ParserCombinators.Parsec.Prim(getInput)
import Data.Char(isUpper,isAlpha,isDigit)

-------------------------------------------------------------

instance Show a => Show (RegExp a) where
  show (One x) = "(One "++show x++")"
  show Lambda = "lam"
  show Empty = "empty"
  show (Union x y) = "("++show x++"+"++show y++")"
  show (Cat x y) = "("++show x++"."++show y++")"
  show (Star x) = show x++"*"

cats (Cat x y) = cats x ++ cats y
cats x = [x]

short (One x) = show x
short Lambda = "\"\""
short Empty = "#"
short (Union x y) = "("++short x++"+"++short y++")"
short (w@(Cat x y)) = concat(map short (cats w))
short (Star x) = short x++"*"

------------------------------------------------------  
-- Parsers for RegExp

reglang  = makeTokenParser haskellStyle 

lexemE p    = lexeme reglang p
parenS p    = between (symboL "(") (symboL ")") p
symboL      = symbol reglang
ident       = identifier reglang
sym         = symbol reglang
intP:: Parser Int
intP     = fmap fromInteger (integer reglang)
whiteSp     = whiteSpace reglang

-------------------------------------------------------------

catList f [] = Lambda
catList f [x] = f x
catList f (x:xs) = Cat (f x) (catList f xs)

unionList [] = Empty
unionList [x] = x
unionList (x:xs) = Union x (unionList xs)

simpleRE:: Parser (RegExp Char)
simpleRE = empty <|> one <|> more <|> alphanum <|> parenS regexp
  where empty = symboL "{}" >> return Empty
        one = do{ c <- charLiteral reglang; return(One c)}
        more = do { s <- stringLiteral reglang; return(catList One s)}
        alphanum = do { s <- lexemE(satisfy alphanumeric); return (One s)}
        alphanumeric x = isAlpha x || isDigit x
                                     
starRE:: Parser (RegExp Char)
starRE = do { x <- simpleRE; f <- post; return(f x)}
  where post = (symboL "*" >> return Star) <|> (return id)

catRE:: Parser (RegExp Char)
catRE =    (do {ts <- sepBy1 starRE ((symboL ".")<|> return "");return(catList id ts)})
    
regexp:: Parser (RegExp Char)
regexp = do { xs <- sepBy1 catRE (symboL "+"); return(unionList xs)}


-------------------------------------------------
-- Running parsers
              
parse2 p s = case parse p "Keyboard input" s of
                Left s -> error (show s)
                Right x -> x

              
observeSuffix x = 
  (do { a <- x; left <- getInput; return(a,take 20 left)})

ps x s = parse2 (observeSuffix x) s

-------------------------------------------------------------
parseRegExp s = parse2 (whiteSp >> regexp) s