Language/TCT/Elem.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 module Language.TCT.Elem where
   3
   4 import Data.Bool
   5 import Control.Monad (Monad(..), mapM)
   6 import Data.Eq (Eq)
   7 import Data.Function (($), (.))
   8 import Data.Foldable (toList, null)
   9 import Data.Int (Int)
  10 import Data.Ord (Ord)
  11 import Data.Maybe (Maybe(..))
  12 import Prelude ((+))
  13 import Data.Semigroup (Semigroup(..))
  14 import Data.String (String)
  15 import Data.Sequence (Seq)
  16 import Text.Show (Show(..))
  17 import Data.TreeSeq.Strict (Tree(..))
  18 import qualified Control.Monad.Trans.Reader as R
  19 import qualified Data.List as List
  20 import qualified Data.Text.Lazy as TL
  21
  22 import Debug.Trace (trace)
  23
  24 trac :: String -> a -> a
  25 -- trac _m x = x
  26 trac = trace
  27 {-# INLINE trac #-}
  28
  29 debug :: Pretty a => String -> String -> a -> b -> b
  30 debug f n a = trac (f <> ": " <> n <> " = " <> R.runReader (pretty a) 2)
  31
  32 dbg :: Pretty a => String -> a -> a
  33 dbg m x = trac (m <> ": " <> R.runReader (pretty x) 2) x
  34 {-# INLINE dbg #-}
  35
  36 -- * Class 'Pretty'
  37 class Pretty a where
  38         pretty :: a -> R.Reader Int String
  39 instance Pretty Int where
  40         pretty = return . show
  41 instance Pretty TL.Text where
  42         pretty = return . show
  43 instance (Pretty a, Pretty b) => Pretty (a,b) where
  44         pretty (a,b) = do
  45                 i <- R.ask
  46                 a' <- R.local (+2) $ pretty a
  47                 b' <- R.local (+2) $ pretty b
  48                 return $
  49                         "\n" <> List.replicate i ' ' <> "( " <> a' <>
  50                         "\n" <> List.replicate i ' ' <> ", " <> b' <>
  51                         "\n" <> List.replicate i ' ' <> ") "
  52 instance Pretty a => Pretty [a] where
  53         pretty [] = return "[]"
  54         pretty as = do
  55                 i <- R.ask
  56                 s <- R.local (+2) $ mapM pretty as
  57                 return $
  58                         "\n" <> List.replicate i ' ' <> "[ " <>
  59                         List.intercalate ("\n" <> List.replicate i ' ' <> ", ") s <>
  60                         "\n" <> List.replicate i ' ' <> "] "
  61 instance Pretty a => Pretty (Seq a) where
  62         pretty ss
  63          | null ss = return "[]"
  64          | otherwise = do
  65                 let as = toList ss
  66                 i <- R.ask
  67                 s <- R.local (+2) $ mapM pretty as
  68                 return $
  69                         "\n" <> List.replicate i ' ' <> "[ " <>
  70                         List.intercalate ("\n" <> List.replicate i ' ' <> ", ") s <>
  71                         "\n" <> List.replicate i ' ' <> "] "
  72 instance Pretty a => Pretty (Maybe a) where
  73         pretty Nothing = return "Nothing"
  74         pretty (Just m) = do
  75                 s <- pretty m
  76                 return $ "Just "<>s
  77 instance Show a => Pretty (Tree a) where
  78         pretty (Tree n ts) = do
  79                 s <- R.local (+2) (pretty ts)
  80                 return $ "Tree "<>showsPrec 11 n ""<>" "<>s
  81
  82 -- * Type 'ElemName'
  83 type ElemName = TL.Text
  84
  85 -- ** Type 'ElemAttr'
  86 data ElemAttr
  87  =   ElemAttr
  88  {   elemAttr_name  :: !TL.Text
  89  ,   elemAttr_open  :: !TL.Text
  90  ,   elemAttr_value :: !TL.Text
  91  ,   elemAttr_close :: !TL.Text
  92  }
  93  deriving (Eq,Ord,Show)
  94
  95 -- ** Type 'White'
  96 type White = TL.Text
  97
  98 -- ** Type 'ElemAttrs'
  99 type ElemAttrs = [(White,ElemAttr)]