{-# LANGUAGE OverloadedStrings #-}
module Language.TCT.Elem where

import Data.Bool
import Control.Monad (Monad(..), mapM)
import Data.Eq (Eq)
import Data.Function (($), (.))
import Data.Foldable (toList, null)
import Data.Int (Int)
import Data.Ord (Ord)
import Data.Maybe (Maybe(..))
import Prelude ((+))
import Data.Semigroup (Semigroup(..))
import Data.String (String)
import Data.Sequence (Seq)
import Text.Show (Show(..))
import Data.TreeSeq.Strict (Tree(..))
import qualified Control.Monad.Trans.Reader as R
import qualified Data.List as List
import qualified Data.Text.Lazy as TL

import Debug.Trace (trace)

trac :: String -> a -> a
-- trac _m x = x
trac = trace
{-# INLINE trac #-}

debug :: Pretty a => String -> String -> a -> b -> b
debug f n a = trac (f <> ": " <> n <> " = " <> R.runReader (pretty a) 2)

dbg :: Pretty a => String -> a -> a
dbg m x = trac (m <> ": " <> R.runReader (pretty x) 2) x
{-# INLINE dbg #-}

-- * Class 'Pretty'
class Pretty a where
	pretty :: a -> R.Reader Int String
instance Pretty Int where
	pretty = return . show
instance Pretty TL.Text where
	pretty = return . show
instance (Pretty a, Pretty b) => Pretty (a,b) where
	pretty (a,b) = do
		i <- R.ask
		a' <- R.local (+2) $ pretty a
		b' <- R.local (+2) $ pretty b
		return $
			"\n" <> List.replicate i ' ' <> "( " <> a' <>
			"\n" <> List.replicate i ' ' <> ", " <> b' <>
			"\n" <> List.replicate i ' ' <> ") "
instance Pretty a => Pretty [a] where
	pretty [] = return "[]"
	pretty as = do
		i <- R.ask
		s <- R.local (+2) $ mapM pretty as
		return $
			"\n" <> List.replicate i ' ' <> "[ " <>
			List.intercalate ("\n" <> List.replicate i ' ' <> ", ") s <>
			"\n" <> List.replicate i ' ' <> "] "
instance Pretty a => Pretty (Seq a) where
	pretty ss
	 | null ss = return "[]"
	 | otherwise = do
		let as = toList ss
		i <- R.ask
		s <- R.local (+2) $ mapM pretty as
		return $
			"\n" <> List.replicate i ' ' <> "[ " <>
			List.intercalate ("\n" <> List.replicate i ' ' <> ", ") s <>
			"\n" <> List.replicate i ' ' <> "] "
instance Pretty a => Pretty (Maybe a) where
	pretty Nothing = return "Nothing"
	pretty (Just m) = do
		s <- pretty m
		return $ "Just "<>s
instance Show a => Pretty (Tree a) where
	pretty (Tree n ts) = do
		s <- R.local (+2) (pretty ts)
		return $ "Tree "<>showsPrec 11 n ""<>" "<>s

-- * Type 'ElemName'
type ElemName = TL.Text

-- ** Type 'ElemAttr'
data ElemAttr
 =   ElemAttr
 {   elemAttr_name  :: !TL.Text
 ,   elemAttr_open  :: !TL.Text
 ,   elemAttr_value :: !TL.Text
 ,   elemAttr_close :: !TL.Text
 }
 deriving (Eq,Ord,Show)

-- ** Type 'White'
type White = TL.Text

-- ** Type 'ElemAttrs'
type ElemAttrs = [(White,ElemAttr)]