module Fun.Parser where

import           Data.Char
import           Fun.Tree

type Parser a = String -> Maybe (a, String)

char :: Parser Char
char []       = Nothing
char (x : xs) = Just (x, xs)

digit :: Parser Char
digit = char <=> isDigit

digits :: Parser String
digits = iter digit

number :: Parser Integer
number =
  literal '-'
    <-+> digits
    >>>  (\n -> -1 * (read n :: Integer))
    <|>  digits
    >>>  (\n -> read n :: Integer)

space :: Parser Char
space = char <=> isSpace

newline :: Parser Char
newline = char <=> (== '\n')

notSpace :: Parser Char
notSpace = char <=> (not . isSpace)

letter :: Parser Char
letter = char <=> isAlpha

letters :: Parser String
letters = iter letter

alphanum :: Parser Char
alphanum = digit <|> letter

literal :: Char -> Parser Char
literal c = char <=> (== c)

result :: a -> Parser a
result a cs = Just (a, cs)

iter :: Parser Char -> Parser String
iter m = (iterS m) <=> (/= "")

iterS :: Parser a -> Parser [a]
iterS m = m <+> iterS m >>> (\(x, y) -> x : y) <|> result []

token :: Parser a -> Parser a
token = (<+-> iterS space)

-- A parser that will accept a given alpha string
acceptWord :: String -> Parser String
acceptWord w = token (letters <=> (== w))

-- A parser that will accept a given string
accept :: String -> Parser String
accept w = token ((iter notSpace) <=> (== w))

-- Given a parser and a predicate return the parser only if it satisfies the predicate
infix 7 <=>
(<=>) :: Parser a -> (a -> Bool) -> Parser a
(parser <=> predicate) input = case parser input of
  Nothing        -> Nothing
  Just (a, rest) -> if (predicate a) then Just (a, rest) else Nothing


-- Combine two parser together pairing their results up in a tuple
infixl 6 <+>
(<+>) :: Parser a -> Parser b -> Parser (a, b)
(parserA <+> parserB) input = case parserA input of
  Nothing                   -> Nothing
  Just (resultA, remainder) -> case parserB remainder of
    Nothing            -> Nothing
    Just (resultB, cs) -> Just ((resultA, resultB), cs)

-- Sequence operator that discards the second result
infixl 6 <+->
(<+->) :: Parser a -> Parser b -> Parser a
(parserA <+-> parserB) input = case parserA input of
  Nothing                   -> Nothing
  Just (resultA, remainder) -> case parserB remainder of
    Nothing      -> Nothing
    Just (_, cs) -> Just (resultA, cs)

-- Sequence operator that discards the first result
infixl 6 <-+>
(<-+>) :: Parser a -> Parser b -> Parser b
(parserA <-+> parserB) input = case parserA input of
  Nothing                   -> Nothing
  Just (resultA, remainder) -> case parserB remainder of
    Nothing            -> Nothing
    Just (resultB, cs) -> Just (resultB, cs)

-- Transform a parsers result
infixl 5 >>>
(>>>) :: Parser a -> (a -> b) -> Parser b
(parser >>> transformer) input = case parser input of
  Nothing                   -> Nothing
  Just (resultA, remainder) -> Just ((transformer resultA), remainder)

-- Extract a parsers result	
infix 4 +>
(+>) :: Parser a -> (a -> Parser b) -> Parser b
(parser +> function) input = case parser input of
  Nothing      -> Nothing
  Just (a, cs) -> function a cs

-- Combine two parsers using a 'or' type operation
infixl 3 <|>
(<|>) :: Parser a -> Parser a -> Parser a
(parserA <|> parserB) input = case parserA input of
  Nothing -> parserB input
  result  -> result

----

tree :: Parser Tree
tree = iterS program >>> Tree

program :: Parser Program
program = iterS block >>> Program

block :: Parser Block
block = functionBlock <+-> newline >>> Block

visibility :: Parser Char
visibility = literal '+' <|> literal '-'

functionBlock :: Parser FunctionBlock
functionBlock =
  functionDeclaration
    <+> iterS functionDefinition
    >>> (\(a, b) -> FunctionBlock a b)

functionDeclaration :: Parser FunctionDeclaration
functionDeclaration =
  functionDeclarationWithoutFlags <|> functionDeclarationWithFlags

functionDeclarationWithoutFlags :: Parser FunctionDeclaration
functionDeclarationWithoutFlags =
  functionName
    <+>  functionDeclarationDelimiter
    <+>  iterS functionType
    <+-> newline
    >>>  (\((a, b), c) -> FunctionDeclarationWithoutFlags a b c)

functionDeclarationWithFlags :: Parser FunctionDeclaration
functionDeclarationWithFlags =
  functionName
    <+>  functionDeclarationDelimiter
    <+>  functionTypeList
    <+-> space
    <+-> literal '%'
    <+-> space
    <+>  iterS functionFlag
    <+-> newline
    >>>  (\(((a, b), c), d) -> FunctionDeclarationWithFlags a b c d)

functionDeclarationDelimiter :: Parser Char
functionDeclarationDelimiter =
  space <-+> literal ':' <-+> visibility <+-> literal ':' <+-> space

functionName :: Parser String
functionName = letter <+> iterS alphanum >>> (\(a, b) -> a : b)

functionTypeList :: Parser [String]
functionTypeList =
  iterS ((functionType <+-> space <+-> literal ':' <+-> space) <|> functionType)

functionType :: Parser String
functionType = letter <+> iterS alphanum >>> (\(a, b) -> a : b)

functionFlag :: Parser String
functionFlag = letters

functionDefinition :: Parser FunctionDefinition
functionDefinition =
  letters
    <+-> space
    <+-> literal ':'
    <+-> space
    <+>  letters
    <+-> newline
    >>>  (\(a, b) -> FunctionDefinition a b)