1 {-# LANGUAGE OverloadedStrings #-}
2 {-# LANGUAGE TypeFamilies #-}
3 {-# LANGUAGE ViewPatterns #-}
4 module Language.TCT.Token where
6 import Data.Char (Char)
7 import Data.Eq (Eq(..))
9 import Data.Ord (Ord(..))
10 import Data.Sequence (Seq)
11 import Data.Text (Text)
12 -- import Data.TreeSeq.Strict (Tree(..))
13 import Text.Show (Show(..))
14 import System.FilePath (FilePath)
15 import qualified Data.Text.Lazy as TL
17 import Language.TCT.Cell
18 import Language.TCT.Elem
27 type TCT = Tree (Padded Key) Tokens
31 = KeyColon !Name !White -- ^ @name: @
32 | KeyEqual !Name !White -- ^ @name=@
33 | KeyBar !Name !White -- ^ @name|@
34 | KeyGreat !Name !White -- ^ @name>@
35 | KeyLower !Name !ElemAttrs -- ^ @<name a=b@
36 | KeyDot !Name -- ^ @1. @
38 | KeyDashDash -- ^ @-- @
39 | KeySection !LevelSection -- ^ @# @
40 | KeyBrackets !Name -- ^ @[name]@
41 | KeyDotSlash !PathFile -- ^ @./file @
43 deriving (Eq, Ord, Show)
52 type PathFile = FP.FilePath
54 -- ** Type 'LevelSection'
55 type LevelSection = Int
58 -- | NOTE: the 'Cell' spans the opening, the content and the closing.
59 type Token = Tree (Padded TokenKey) TokenValue
62 type Tokens = Seq Token
67 = PairElem !ElemName !ElemAttrs -- ^ @<elem n0=v0 n1=v1>value</elem>@
68 | PairHash -- ^ @#value#@
69 | PairStar -- ^ @*value*@
70 | PairSlash -- ^ @/value/@
71 | PairUnderscore -- ^ @_value_@
72 | PairDash -- ^ @-value-@
73 | PairBackquote -- ^ @`value`@
74 | PairSinglequote -- ^ @'value'@
75 | PairDoublequote -- ^ @"value"@
76 | PairFrenchquote -- ^ @«value»@
77 | PairParen -- ^ @(value)@
78 | PairBrace -- ^ @{value}@
79 | PairBracket -- ^ @[value]@
80 deriving (Eq,Ord,Show)
82 -- ** Type 'TokenValue'
84 = TokenPhrases !Phrases
93 type Phrases = Seq (Padded Phrase)
100 deriving (Eq,Ord,Show)
104 -- newtype Tag = Tag Text
106 type family Sourced a :: *
107 type instance Sourced (Padded a) = Padded (Sourced a)
108 type instance Sourced [a] = [Sourced a]
109 type instance Sourced (Seq a) = Seq (Sourced a)
110 type instance Sourced (Tree k a) = Tree (Sourced k) (Sourced a)
111 type instance Sourced Key = Cell Key
112 type instance Sourced Value = Cell Value
113 type instance Sourced TokenKey = Cell TokenKey
114 type instance Sourced TokenValue = TokenValue
115 type instance Sourced Phrase = Cell Phrase
118 class Sourcify a where
119 sourcify :: a -> Sourced a
120 instance Sourced a => Sourced [a] where
121 type Sourced = [At a]
122 sourcify = (sourcify <$>)
126 instance Buildable Token where
127 build (TokenPlain t) = build t
128 build (TokenTag t) = "#"<>build t
129 build (TokenLink lnk) = build lnk
130 build (TokenEscape c) = "\\"<>build c
131 build (TokenPair p ts) = build c<>buildTokens ts<>build o
132 where (o,c) = pairBorders p ts
134 buildTokens :: Tokens -> Builder
135 buildTokens = foldr (\a -> (<> build (unCell a))) ""
137 instance Semigroup Tokens where
138 Tokens (Seq.viewr -> xs:>TokenPlain x) <>
139 Tokens (Seq.viewl -> TokenPlain y:<ys) =
140 Tokens (xs<>(TokenPlain (x<>y)<|ys))
141 Tokens x <> Tokens y = Tokens (x<>y)
142 instance Monoid Tokens where
143 mempty = Tokens mempty
145 instance Buildable Tokens where
146 build (Tokens ts) = foldr (\a -> (<> build a)) "" ts
147 instance IsList Tokens where
148 type Item Tokens = Token
149 fromList = Tokens . fromList
150 toList (Tokens ts) = toList ts
152 unTokens :: Tokens -> Seq Token
153 unTokens (Tokens ts) = ts