module Parse
where
import Prelude hiding (maybe, fail)
import qualified Char
import qualified List

data Match = Ungroup String | Group String deriving (Show)
type Parser = String -> [([Match], String)]
-- newtype Parser a = String -> [(a, String)]

no_match = []
fail input = no_match
zero_match input = [([], input)]

match_if pred "" = no_match
match_if pred (c:cs) = if pred c then [([Ungroup (c:"")], cs)] else no_match

any_char = match_if (\_ -> True)
any_of chars = match_if (`elem` chars)
whitespace = match_if Char.isSpace
letter = match_if (\c -> 'a' <= c && c <= 'z')
digit = match_if Char.isDigit

literal s input =
  if s `List.isPrefixOf` input then [([Ungroup s], drop (length s) input)]
    else no_match

p1 <|> p2 = \input -> p1 input ++ p2 input
p1 <+> p2 = \input -> [(match1 ++ match2, rest2)
  | (match1, rest1) <- p1 input, (match2, rest2) <- p2 rest1]

maybe p = p <|> zero_match

many p = maybe (p <+> many p)
many1 p = p <+> many p

degroup gs = concatMap to_s gs
  where
  to_s (Group s) = s
  to_s (Ungroup s) = s
group :: Parser -> Parser
group p input = [([Group (degroup matches)], rest) | (matches, rest) <- p input]

-- extract groups
get_groups :: [([Match], String)] -> ([String], String)
get_groups [] = ([], "")
get_groups results = ([s | (Group s) <- matches], rest)
  where (matches, rest) = head results


-- extra stuff!
separated_with sep p = p <+> many (sep <+> p)

number_in_range low high input =
    if not (null matches) && val >= low && val <= high
    then [(matches, rest)]
    else no_match
  where
  (matches, rest) = head (many digit input)
  val = read (degroup matches) :: Int

ipaddr = num <+> dot <+> num <+> dot <+> num <+> dot <+> num
  where
  num = group (number_in_range 0 255)
  dot = literal "."

parse = ($)

tp0 = literal "h" <+> literal "e"

tp1 = maybe (literal "h")

tp2 = any_of "abc"

tp3 = many1 (literal "h")

tp4 = literal "(" <+> many any_char <+> literal ")"

tp5 = many whitespace <+> group tp3 <+> many1 whitespace <+> group tp3

tp6 = separated_with (literal "," <+> many whitespace) (group (many1 letter))

comma_list = get_groups . tp6