{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
module Language.TCT.Token where

import Data.Char (Char)
import Data.Eq (Eq(..))
import Data.Int (Int)
import Data.Ord (Ord(..))
import Data.Sequence (Seq)
import Data.Text (Text)
-- import Data.TreeSeq.Strict (Tree(..))
import Text.Show (Show(..))
import System.FilePath (FilePath)
import qualified Data.Text.Lazy as TL

import Language.TCT.Cell
import Language.TCT.Elem






{-
-- * Type 'TCT'
type TCT = Tree (Padded Key) Tokens

-- * Type 'Key'
data Key
 =   KeyColon !Name !White     -- ^ @name: @
 |   KeyEqual !Name !White     -- ^ @name=@
 |   KeyBar   !Name !White     -- ^ @name|@
 |   KeyGreat !Name !White     -- ^ @name>@
 |   KeyLower !Name !ElemAttrs -- ^ @<name a=b@
 |   KeyDot   !Name            -- ^ @1. @
 |   KeyDash                   -- ^ @- @
 |   KeyDashDash               -- ^ @-- @
 |   KeySection  !LevelSection -- ^ @# @
 |   KeyBrackets !Name         -- ^ @[name]@
 |   KeyDotSlash !PathFile     -- ^ @./file @
 |   KeyPara
 deriving (Eq, Ord, Show)

-- ** Type 'Name'
type Name = Text

-- ** Type 'Value'
type Value = Text

-- ** Type 'PathFile'
type PathFile = FP.FilePath

-- ** Type 'LevelSection'
type LevelSection = Int

-- * Type 'Token'
-- | NOTE: the 'Cell' spans the opening, the content and the closing.
type Token = Tree (Padded TokenKey) TokenValue

-- ** Type 'Tokens'
type Tokens = Seq Token

-- ** Type 'TokenKey'
type TokenKey = Pair
data Pair
 =   PairElem !ElemName !ElemAttrs -- ^ @<elem n0=v0 n1=v1>value</elem>@
 |   PairHash        -- ^ @#value#@
 |   PairStar        -- ^ @*value*@
 |   PairSlash       -- ^ @/value/@
 |   PairUnderscore  -- ^ @_value_@
 |   PairDash        -- ^ @-value-@
 |   PairBackquote   -- ^ @`value`@
 |   PairSinglequote -- ^ @'value'@
 |   PairDoublequote -- ^ @"value"@
 |   PairFrenchquote -- ^ @«value»@
 |   PairParen       -- ^ @(value)@
 |   PairBrace       -- ^ @{value}@
 |   PairBracket     -- ^ @[value]@
 deriving (Eq,Ord,Show)

-- ** Type 'TokenValue'
data TokenValue
 =   TokenPhrases !Phrases
 |   TokenEscape  !Char
 |   TokenTag     !Tag
 |   TokenLink    !Link
 |   TokenTree    !TCT
 |   TokenRaw     !TL.Text
 deriving (Eq,Show)

-- * Type 'Phrases'
type Phrases = Seq (Padded Phrase)

-- ** Type 'Phrase'
data Phrase
 =   PhraseWord  !Text
 |   PhraseWhite !Text
 |   PhraseOther !Text
 deriving (Eq,Ord,Show)

-- * Type 'Tag'
type Tag = TL.Text
-- newtype Tag = Tag Text

type family Sourced a :: *
type instance Sourced (Padded a) = Padded (Sourced a)
type instance Sourced [a]        = [Sourced a]
type instance Sourced (Seq a)    = Seq (Sourced a)
type instance Sourced (Tree k a) = Tree (Sourced k) (Sourced a)
type instance Sourced Key        = Cell Key
type instance Sourced Value      = Cell Value
type instance Sourced TokenKey   = Cell TokenKey
type instance Sourced TokenValue = TokenValue
type instance Sourced Phrase     = Cell Phrase

-- * Type Pos
class Sourcify a where
	sourcify :: a -> Sourced a
instance Sourced a => Sourced [a] where
	type Sourced = [At a]
	sourcify = (sourcify <$>)
-}

{-
instance Buildable Token where
	build (TokenPlain t)   = build t
	build (TokenTag t)     = "#"<>build t
	build (TokenLink lnk)  = build lnk
	build (TokenEscape c)  = "\\"<>build c
	build (TokenPair p ts) = build c<>buildTokens ts<>build o
		where (o,c) = pairBorders p ts

buildTokens :: Tokens -> Builder
buildTokens = foldr (\a -> (<> build (unCell a))) ""

instance Semigroup Tokens where
	Tokens (Seq.viewr -> xs:>TokenPlain x) <>
	 Tokens (Seq.viewl -> TokenPlain y:<ys) =
		Tokens (xs<>(TokenPlain (x<>y)<|ys))
	Tokens x <> Tokens y = Tokens (x<>y)
instance Monoid Tokens where
	mempty  = Tokens mempty
	mappend = (<>)
instance Buildable Tokens where
	build (Tokens ts) = foldr (\a -> (<> build a)) "" ts
instance IsList Tokens where
	type Item Tokens = Token
	fromList = Tokens . fromList
	toList (Tokens ts) = toList ts

unTokens :: Tokens -> Seq Token
unTokens (Tokens ts) = ts
-}