Language/TCT/Token.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 {-# LANGUAGE TypeFamilies #-}
   3 {-# LANGUAGE ViewPatterns #-}
   4 module Language.TCT.Token where
   5
   6 import Data.Char (Char)
   7 import Data.Eq (Eq(..))
   8 import Data.Int (Int)
   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
  16
  17 import Language.TCT.Cell
  18 import Language.TCT.Elem
  19
  20
  21
  22
  23
  24
  25 {-
  26 -- * Type 'TCT'
  27 type TCT = Tree (Padded Key) Tokens
  28
  29 -- * Type 'Key'
  30 data Key
  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. @
  37  |   KeyDash                   -- ^ @- @
  38  |   KeyDashDash               -- ^ @-- @
  39  |   KeySection  !LevelSection -- ^ @# @
  40  |   KeyBrackets !Name         -- ^ @[name]@
  41  |   KeyDotSlash !PathFile     -- ^ @./file @
  42  |   KeyPara
  43  deriving (Eq, Ord, Show)
  44
  45 -- ** Type 'Name'
  46 type Name = Text
  47
  48 -- ** Type 'Value'
  49 type Value = Text
  50
  51 -- ** Type 'PathFile'
  52 type PathFile = FP.FilePath
  53
  54 -- ** Type 'LevelSection'
  55 type LevelSection = Int
  56
  57 -- * Type 'Token'
  58 -- | NOTE: the 'Cell' spans the opening, the content and the closing.
  59 type Token = Tree (Padded TokenKey) TokenValue
  60
  61 -- ** Type 'Tokens'
  62 type Tokens = Seq Token
  63
  64 -- ** Type 'TokenKey'
  65 type TokenKey = Pair
  66 data Pair
  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)
  81
  82 -- ** Type 'TokenValue'
  83 data TokenValue
  84  =   TokenPhrases !Phrases
  85  |   TokenEscape  !Char
  86  |   TokenTag     !Tag
  87  |   TokenLink    !Link
  88  |   TokenTree    !TCT
  89  |   TokenRaw     !TL.Text
  90  deriving (Eq,Show)
  91
  92 -- * Type 'Phrases'
  93 type Phrases = Seq (Padded Phrase)
  94
  95 -- ** Type 'Phrase'
  96 data Phrase
  97  =   PhraseWord  !Text
  98  |   PhraseWhite !Text
  99  |   PhraseOther !Text
 100  deriving (Eq,Ord,Show)
 101
 102 -- * Type 'Tag'
 103 type Tag = TL.Text
 104 -- newtype Tag = Tag Text
 105
 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
 116
 117 -- * Type Pos
 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 <$>)
 123 -}
 124
 125 {-
 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
 133
 134 buildTokens :: Tokens -> Builder
 135 buildTokens = foldr (\a -> (<> build (unCell a))) ""
 136
 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
 144         mappend = (<>)
 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
 151
 152 unTokens :: Tokens -> Seq Token
 153 unTokens (Tokens ts) = ts
 154 -}