module Pattern (PatternElem(..),
	        seekPattern,
	        findPattern)
    where

import Char

type Pattern = [PatternElem]
data PatternElem = PatChar Char 
		 | PatCase Char
		 | PatNum 
		 | PatAlpha
		 | PatAlphaNum
		 | PatAny
		 | PatFn (Char -> Bool)
		 | PatStr String
		 | PatOr Pattern Pattern
		 | PatWS
		 | PatKleene Pattern
		 | PatPlus Pattern
		 | PatNot Pattern

isNum x = isAlphaNum x && (not (isAlpha x))

cannonPattern [] = []
cannonPattern ((PatChar c)  :xs) = (PatFn (== c)) : cannonPattern xs
cannonPattern ((PatCase c)  :xs) = (PatFn (\x -> toLower x == toLower c)) : cannonPattern xs
cannonPattern ( PatNum      :xs) = (PatFn isNum) : cannonPattern xs
cannonPattern ( PatAlpha    :xs) = (PatFn isAlpha) : cannonPattern xs
cannonPattern ( PatAlphaNum :xs) = cannonPattern ((PatOr [PatAlpha] [PatNum]):xs)
cannonPattern ( PatAny      :xs) = (PatFn (\_ -> True)) : cannonPattern xs
cannonPattern ((PatFn f)    :xs) = (PatFn f) : cannonPattern xs
cannonPattern ((PatStr s)   :xs) = cannonPattern ((map (\c -> PatChar c) s) ++ xs)
cannonPattern ((PatOr a b)  :xs) = (PatOr (cannonPattern a) (cannonPattern b)) : cannonPattern xs
cannonPattern ( PatWS       :xs) = (PatFn isSpace) : cannonPattern xs
cannonPattern ((PatKleene p):xs) = (PatKleene (cannonPattern p)) : cannonPattern xs
cannonPattern ((PatPlus p)  :xs) = 
    let p' = cannonPattern p 
    in  p' ++ (PatKleene p'):(cannonPattern xs)
cannonPattern ((PatNot p)   :xs) = (PatNot (cannonPattern p)) : cannonPattern xs

findPattern p = findPattern' (cannonPattern p) 
    where findPattern' _ []     = Nothing
	  findPattern' p s@(_:cs) = case seekCannonPattern p s of
				      Just s' -> Just s'
				      Nothing -> findPattern' p cs

seekPattern pattern s = seekCannonPattern (cannonPattern pattern) s

seekCannonPattern [] s = Just s
seekCannonPattern x@((PatFn f):z) (c:cs) | f c = seekCannonPattern z cs
                                         | otherwise = Nothing
seekCannonPattern x@((PatOr a b):z) s@(_:cs) =
    case seekCannonPattern a s of
      Nothing -> seekCannonPattern b s
      justs   -> justs
seekCannonPattern x@((PatKleene p):z) [] = Just []
seekCannonPattern x@((PatKleene p):z) s  =
    case seekCannonPattern p s of
        Nothing -> seekCannonPattern z s
	Just s' -> seekCannonPattern x s'
seekCannonPattern x@((PatNot p):z) [] = Nothing
seekCannonPattern x@((PatNot p):z) s@(_:cs) =
    case seekCannonPattern p s of
        Nothing -> seekCannonPattern z cs
	Just _  -> Nothing