{-# LANGUAGE OverloadedStrings, RecordWildCards #-}

module Data.NML.Parse (NMLPair(..), NMLElem(..), parseNML) where

import           Control.Applicative
import           Data.Attoparsec.Text
import           Data.Char (isAlpha,isNumber)
import           Data.Text (Text)
import qualified Data.Text as T
import           Data.Text.Encoding (decodeUtf8)
import           Data.Word (Word8)
import           Prelude hiding (takeWhile)

data NMLPair = NMLPair
  { pName :: Text
  , pAttrs :: [NMLPair]
  , pElems :: [NMLElem]
  } deriving (Eq, Show)

data NMLElem
  = EEntity Text
  | EPair   NMLPair
  | EText   Text
    deriving (Eq, Show)

parseNML :: Text -> Either String NMLPair
parseNML = parseOnly prElement

----

isNameStartChar :: Char -> Bool
isNameStartChar = inClass ":_A-Za-z"

isNameChar :: Char -> Bool
isNameChar = inClass "-:_A-Za-z.0-9"

prName :: Parser Text
prName = do
  c  <- satisfy isNameStartChar
  cs <- many (satisfy isNameChar)
  return (T.pack (c:cs))

----

prElement :: Parser NMLPair
prElement = do
  string "<"
  pName  <- prName
  skipSpace
  pAttrs <- many (prElement <* skipSpace)
  prFinish pName pAttrs <|> prElems pName pAttrs

prEElement :: Parser NMLElem
prEElement = fmap EPair prElement

prFinish :: Text -> [NMLPair] -> Parser NMLPair
prFinish pName pAttrs = do
  string ">"
  return (NMLPair { .. })
    where pElems = []

prElems :: Text -> [NMLPair] -> Parser NMLPair
prElems pName pAttrs = do
  string "|"
  pElems <- many (prEElement <|> prEntity <|> prText)
  string ">"
  return (NMLPair { .. })

prEntity :: Parser NMLElem
prEntity = do
  string "["
  en <- takeWhile1 (not . (== ']'))
  string "]"
  return (EEntity en)

prText :: Parser NMLElem
prText = do
  t <- takeWhile1 (not . (inClass "<>|"))
  return (EText t)