module Flamethrower.Parser where

import qualified Flamethrower.Lexer as L
import Flamethrower.Lexer (StringPart)
import Language.Haskell.TH (Exp, stringE)

data Node =
	  ElementNode String [Node]
	| StringNode StringNode
	| AttributeNode String (Maybe Node)
	| ClassNode String
	deriving Show

data StringNode = String [StringPart] | Raw [StringPart]
	deriving Show

mapFst :: (a -> b) -> (a, c) -> (b, c)
mapFst f (a, b) = (f a, b)

isIndent :: L.Token -> Bool
isIndent L.Indent = True
isIndent _ = False

parseInside :: Int -> [L.Token] -> ([Node], [L.Token])
parseInside _ [] = ([], [])
parseInside parentIndent tokens =
	case mapFst length $ span isIndent tokens of
		(_, L.Newline:rest) -> parseInside parentIndent rest
		(indent, rest)
			| indent == parentIndent + 1 ->
				let
					(content, rest2) = parseContent indent rest
					(continuedParse, rest3) = parseInside parentIndent rest2
				in (content ++ continuedParse, rest3)
			| indent <= parentIndent -> ([], tokens)
			| otherwise -> error "Excessive indentation."

parseContent :: Int -> [L.Token] -> ([Node], [L.Token])
parseContent indent tokens =
	let
		continueParse = parseContent indent
		addToParse node = mapFst (node:) . continueParse
	in case tokens of
		[] -> ([], [])
		L.Newline : rest -> parseInside indent rest
		L.Element name : rest -> mapFst (replicate 1 . ElementNode name) $ continueParse rest
		L.Attribute name : L.String parts : rest -> addToParse (AttributeNode name . Just . StringNode . String $ parts) rest
		L.Attribute name : rest -> addToParse (AttributeNode name Nothing) rest
		L.Raw : L.String parts : rest -> addToParse (StringNode (Raw parts)) rest
		L.String parts : rest -> addToParse (StringNode (String parts)) rest
		L.Class name : rest -> addToParse (ClassNode name) rest

parseRoot :: [L.Token] -> ([Node], [L.Token])
parseRoot tokens = case parseInside (-1) tokens of
	x@(_, []) -> x
	(tree, rest) -> mapFst (tree++) $ parseRoot rest

parse :: [L.Token] -> [Node]
parse = fst . parseRoot