Language/TCT/Markup.hs

   1 module Language.TCT.Markup where
   2
   3 import Data.Bool (Bool(..))
   4 import Data.Eq (Eq(..))
   5 import Data.Monoid (Monoid(..))
   6 import Data.Semigroup (Semigroup(..))
   7 import Data.Sequence (Seq, ViewL(..), ViewR(..), (<|), (|>))
   8 import Data.Text (Text)
   9 import Text.Show (Show(..))
  10 import qualified Data.Sequence as Seq
  11 import qualified Data.Text as Text
  12
  13 -- * Type 'Markup'
  14 data Markup
  15  =   MarkupPlain Text
  16  |   MarkupGroup Group Markup
  17  |   MarkupTag Tag
  18  |   Markups (Seq Markup)
  19  deriving (Eq, Show)
  20 instance Semigroup Markup where
  21         MarkupPlain (Text.null -> True) <> y = y
  22         x <> MarkupPlain (Text.null -> True) = x
  23
  24         MarkupPlain x <> MarkupPlain y = MarkupPlain (x<>y)
  25         Markups (Seq.viewr -> xs:>x@MarkupPlain{}) <> y@MarkupPlain{} = Markups (xs|>(x<>y))
  26         x@MarkupPlain{} <> Markups (Seq.viewl -> y@MarkupPlain{}:<ys) = Markups ((x<>y)<|ys)
  27
  28         Markups x <> Markups y = Markups (x<>y)
  29         Markups x <> y = Markups (x|>y)
  30         x <> Markups y = Markups (x<|y)
  31
  32         x <> y = Markups (Seq.fromList [x,y])
  33 instance Monoid Markup where
  34         mempty  = MarkupPlain mempty
  35         mappend = (<>)
  36
  37 -- ** Type 'Tag'
  38 type Tag = Text
  39
  40 -- ** Type 'Group'
  41 data Group
  42  =   GroupStar        -- ^ @*value*@
  43  |   GroupSlash       -- ^ @/value/@
  44  |   GroupUnderscore  -- ^ @_value_@
  45  |   GroupDash        -- ^ @-value-@
  46  |   GroupBackquote   -- ^ @`value`@
  47  |   GroupSinglequote -- ^ @'value'@
  48  |   GroupDoublequote -- ^ @"value"@
  49  |   GroupFrenchquote -- ^ @«value»@
  50  |   GroupParen       -- ^ @(value)@
  51  |   GroupBrace       -- ^ @{value}@
  52  |   GroupBracket     -- ^ @[value]@
  53  deriving (Eq, Show)