{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeFamilies #-}
module Language.TCT.Read.Elem where

import Control.Applicative (Applicative(..), Alternative(..))
import Control.Monad ((>>))
import Data.Bool
import Data.Char (Char)
import Data.Eq (Eq(..))
import Data.Function (($))
import Data.Functor ((<$>))
import Data.Semigroup (Semigroup(..))
import Data.String (String)
import Data.Text (Text)
import Text.Show (Show(..))
import qualified Data.Char as Char
import qualified Data.Text as Text
import qualified Text.Megaparsec as P

import Language.TCT.Elem

-- * Type 'Parser'
-- | Convenient alias.
type Parser e s a =
 ( P.ErrorComponent e
 , P.ShowErrorComponent e
 , P.Stream s
 , P.Token s ~ Char
 ) => P.Parsec e s a

pdbg :: ( Show a
        , P.ErrorComponent e
        , P.ShowErrorComponent e
        , P.Stream s
        , P.Token s ~ Char
        , P.ShowToken (P.Token s)
        , P.Stream s
        ) => String -> P.ParsecT e s m a -> P.ParsecT e s m a
-- pdbg m p = P.dbg m p
pdbg _m p = p
{-# INLINE pdbg #-}

p_Attrs :: Parser e s [(Text,Attr)]
p_Attrs = P.many $ P.try $ (,) <$> p_Spaces <*> p_Attr
p_Attr :: Parser e s Attr
p_Attr = P.try p_Attr_Eq <|> p_Attr_Word
p_Spaces :: Parser e s Text
p_Spaces = Text.pack <$> P.some (P.satisfy Char.isSpace)
p_Attr_Eq :: Parser e s Attr
p_Attr_Eq =
	(\n (o,v,c) -> Attr n ("="<>o) v c)
	 <$> p_Word
	 <*  P.char '='
	 <*> p_Attr_Value
p_Attr_Word :: Parser e s Attr
p_Attr_Word =
	(\(o,v,c) -> Attr "" o v c)
	 <$> p_Attr_Value_Word
p_Attr_Value :: Parser e s (Text,Text,Text)
p_Attr_Value =
	p_Attr_Value_Quote '\'' <|>
	p_Attr_Value_Quote '"'  <|>
	p_Attr_Value_Word
p_Attr_Value_Quote :: Char -> Parser e s (Text,Text,Text)
p_Attr_Value_Quote q =
	(\o v c -> (Text.singleton o, Text.pack v, Text.singleton c))
	 <$> P.char q
	 <*> P.many (
		P.notFollowedBy (P.string "/>") >>
		P.satisfy (\c -> Char.isPrint c && c /= '>' && c/=q))
	 <*> P.char q
p_Attr_Value_Word :: Parser e s (Text,Text,Text)
p_Attr_Value_Word =
	(\v -> ("", Text.pack v, ""))
	 <$> P.many (P.satisfy Char.isAlphaNum)

p_Word :: Parser e s Text
p_Word = pdbg "Word" $
	(<>)
	 <$> p_plain
	 <*> P.option "" (p_plain <|> p_link)
	where
	p_link = P.try $
		(<>)
		 <$> (Text.pack <$> P.some (P.satisfy (\c -> c=='_' || c=='-')))
		 <*> p_plain
	p_plain =
		Text.pack
		 <$> P.some (P.satisfy $ \c ->
			Char.isLetter c ||
			Char.isNumber c
		 )