Language/TCT/Read/Elem.hs

   1 {-# LANGUAGE FlexibleContexts #-}
   2 {-# LANGUAGE OverloadedStrings #-}
   3 {-# LANGUAGE Rank2Types #-}
   4 {-# LANGUAGE TypeFamilies #-}
   5 module Language.TCT.Read.Elem where
   6
   7 import Control.Applicative (Applicative(..), Alternative(..))
   8 import Control.Monad ((>>))
   9 import Data.Bool
  10 import Data.Char (Char)
  11 import Data.Eq (Eq(..))
  12 import Data.Function (($))
  13 import Data.Functor ((<$>))
  14 import Data.Semigroup (Semigroup(..))
  15 import Data.Text (Text)
  16 import qualified Data.Char as Char
  17 import qualified Data.Text as Text
  18 import qualified Text.Megaparsec as P
  19 import qualified Text.Megaparsec.Char as P
  20
  21 import Language.TCT.Elem
  22 import Language.TCT.Read.Cell
  23
  24 p_Attrs :: Parser e s [(Text,Attr)]
  25 p_Attrs = P.many $ P.try $ (,) <$> p_Spaces <*> p_Attr
  26 p_Attr :: Parser e s Attr
  27 p_Attr = P.try p_Attr_Eq <|> p_Attr_Word
  28 p_Spaces :: Parser e s Text
  29 p_Spaces = Text.pack <$> P.some (P.satisfy Char.isSpace)
  30 p_Attr_Eq :: Parser e s Attr
  31 p_Attr_Eq =
  32         (\n (o,v,c) -> Attr n ("="<>o) v c)
  33          <$> p_Word
  34          <*  P.char '='
  35          <*> p_Attr_Value
  36 p_Attr_Word :: Parser e s Attr
  37 p_Attr_Word =
  38         (\(o,v,c) -> Attr "" o v c)
  39          <$> p_Attr_Value_Word
  40 p_Attr_Value :: Parser e s (Text,Text,Text)
  41 p_Attr_Value =
  42         p_Attr_Value_Quote '\'' <|>
  43         p_Attr_Value_Quote '"'  <|>
  44         p_Attr_Value_Word
  45 p_Attr_Value_Quote :: Char -> Parser e s (Text,Text,Text)
  46 p_Attr_Value_Quote q =
  47         (\o v c -> (Text.singleton o, Text.pack v, Text.singleton c))
  48          <$> P.char q
  49          <*> P.many (
  50                 P.notFollowedBy (P.string "/>") >>
  51                 P.satisfy (\c -> Char.isPrint c && c /= '>' && c/=q))
  52          <*> P.char q
  53 p_Attr_Value_Word :: Parser e s (Text,Text,Text)
  54 p_Attr_Value_Word =
  55         (\v -> ("", Text.pack v, ""))
  56          <$> P.many (P.satisfy Char.isAlphaNum)
  57
  58 p_Word :: Parser e s Text
  59 p_Word = pdbg "Word" $
  60         (<>)
  61          <$> p_plain
  62          <*> P.option "" (p_plain <|> p_link)
  63         where
  64         p_link = P.try $
  65                 (<>)
  66                  <$> (Text.pack <$> P.some (P.satisfy (\c -> c=='_' || c=='-')))
  67                  <*> p_plain
  68         p_plain =
  69                 Text.pack
  70                  <$> P.some (P.satisfy $ \c ->
  71                         Char.isLetter c ||
  72                         Char.isNumber c
  73                  )