Language/TCT/Token.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 {-# LANGUAGE TypeFamilies #-}
   3 {-# LANGUAGE ViewPatterns #-}
   4 module Language.TCT.Token where
   5
   6 {-
   7 import Data.Bool
   8 import Data.Char (Char)
   9 import Data.Eq (Eq(..))
  10 import Data.Function (($), (.))
  11 import Data.Foldable (foldMap, foldr)
  12 import Data.Maybe (Maybe(..))
  13 import Data.Semigroup (Semigroup(..))
  14 import Data.Sequence (Seq)
  15 import Data.Ord (Ord)
  16 import Data.Text (Text)
  17 import Data.Text.Buildable (Buildable(..))
  18 import Data.Text.Lazy.Builder (Builder)
  19 import Data.TreeSeq.Strict (Tree(..), Trees)
  20 import GHC.Exts (IsList(..))
  21 import Text.Show (Show(..))
  22 import qualified Data.Char as Char
  23 import qualified Data.Sequence as Seq
  24 import qualified Data.Text as Text
  25
  26 import Language.TCT.Cell
  27 import Language.TCT.Elem
  28
  29
  30 instance Buildable Token where
  31         build (TokenPlain t)   = build t
  32         build (TokenTag t)     = "#"<>build t
  33         build (TokenLink lnk)  = build lnk
  34         build (TokenEscape c)  = "\\"<>build c
  35         build (TokenPair p ts) = build c<>buildTokens ts<>build o
  36                 where (o,c) = pairBorders p ts
  37
  38 buildTokens :: Tokens -> Builder
  39 buildTokens = foldr (\a -> (<> build (unCell a))) ""
  40
  41 instance Semigroup Tokens where
  42         Tokens (Seq.viewr -> xs:>TokenPlain x) <>
  43          Tokens (Seq.viewl -> TokenPlain y:<ys) =
  44                 Tokens (xs<>(TokenPlain (x<>y)<|ys))
  45         Tokens x <> Tokens y = Tokens (x<>y)
  46 instance Monoid Tokens where
  47         mempty  = Tokens mempty
  48         mappend = (<>)
  49 instance Buildable Tokens where
  50         build (Tokens ts) = foldr (\a -> (<> build a)) "" ts
  51 instance IsList Tokens where
  52         type Item Tokens = Token
  53         fromList = Tokens . fromList
  54         toList (Tokens ts) = toList ts
  55
  56 unTokens :: Tokens -> Seq Token
  57 unTokens (Tokens ts) = ts
  58 -}
  59
  60