]> Git — Sourcephile - doclang.git/blob - Language/TCT/Read/Elem.hs
Fix Token reading.
[doclang.git] / 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 Data.Bool
9 import Data.Char (Char)
10 import Data.Eq (Eq(..))
11 import Data.Function (($))
12 import Data.Functor ((<$>))
13 import Data.Semigroup (Semigroup(..))
14 import Data.String (String)
15 import Data.Text (Text)
16 import Text.Show (Show(..))
17 import qualified Data.Char as Char
18 import qualified Data.Text as Text
19 import qualified Text.Megaparsec as P
20
21 import Language.TCT.Elem
22
23 -- * Type 'Parser'
24 -- | Convenient alias.
25 type Parser e s a =
26 ( P.ErrorComponent e
27 , P.ShowErrorComponent e
28 , P.Stream s
29 , P.Token s ~ Char
30 ) => P.Parsec e s a
31
32 pdbg :: ( Show a
33 , P.ErrorComponent e
34 , P.ShowErrorComponent e
35 , P.Stream s
36 , P.Token s ~ Char
37 , P.ShowToken (P.Token s)
38 , P.Stream s
39 ) => String -> P.ParsecT e s m a -> P.ParsecT e s m a
40 -- pdbg m p = P.dbg m p
41 pdbg _m p = p
42
43 p_Attrs :: Parser e s [(Text,Attr)]
44 p_Attrs = P.many $ P.try $ (,) <$> p_Spaces <*> p_Attr
45 p_Attr :: Parser e s Attr
46 p_Attr = P.try p_Attr_Eq <|> p_Attr_Word
47 p_Spaces :: Parser e s Text
48 p_Spaces = Text.pack <$> P.some (P.satisfy Char.isSpace)
49 p_Attr_Eq :: Parser e s Attr
50 p_Attr_Eq =
51 (\n (o,v,c) -> Attr n ("="<>o) v c)
52 <$> p_Word
53 <* P.char '='
54 <*> p_Attr_Value
55 p_Attr_Word :: Parser e s Attr
56 p_Attr_Word =
57 (\(o,v,c) -> Attr "" o v c)
58 <$> p_Attr_Value_Word
59 p_Attr_Value :: Parser e s (Text,Text,Text)
60 p_Attr_Value =
61 p_Attr_Value_Quote '\'' <|>
62 p_Attr_Value_Quote '"' <|>
63 p_Attr_Value_Word
64 p_Attr_Value_Quote :: Char -> Parser e s (Text,Text,Text)
65 p_Attr_Value_Quote q =
66 (\o v c -> (Text.singleton o, Text.pack v, Text.singleton c))
67 <$> P.char q
68 <*> P.many (P.satisfy $ \c ->
69 Char.isPrint c && c/='/' && c/='>' && c/=q)
70 <*> P.char q
71 p_Attr_Value_Word :: Parser e s (Text,Text,Text)
72 p_Attr_Value_Word =
73 (\v -> ("", Text.pack v, ""))
74 <$> P.many (P.satisfy Char.isAlphaNum)
75
76 p_Word :: Parser e s Text
77 p_Word = pdbg "Word" $
78 (<>)
79 <$> p_plain
80 <*> P.option "" (p_plain <|> p_link)
81 where
82 p_link = P.try $
83 (<>)
84 <$> (Text.pack <$> P.some (P.satisfy (\c -> c=='_' || c=='-')))
85 <*> p_plain
86 p_plain =
87 Text.pack
88 <$> P.some (P.satisfy $ \c ->
89 Char.isLetter c ||
90 Char.isNumber c
91 )