0 | module Text.WebIDL.Parser.Attributes
 1 |
 2 | import Text.WebIDL.Parser.Util
 3 | import Text.Parse.Syntax
 4 |
 5 | %default total
 6 |
 7 | --------------------------------------------------------------------------------
 8 | --          Extended Attributes
 9 | --------------------------------------------------------------------------------
10 |
11 | toOther : IdlToken -> Maybe Other
12 | toOther (SLit x)         = Just $ inject x
13 | toOther (ILit x)         = Just $ inject x
14 | toOther (FLit x)         = Just $ inject x
15 | toOther (Ident x)        = Just $ inject x
16 | toOther (Key x)          = Just $ inject x
17 | toOther (Other Ellipsis) = Just $ inject Ellipsis
18 | toOther (Other (Symb c)) =
19 |   if isCommaOrParenOrQuote c then Nothing else Just $ inject (Symb c)
20 | toOther _                = Nothing
21 |
22 | innerOrOther : AccRule True InnerOrOther
23 |
24 | -- ExtendedAttributeInner ::
25 | --     ( ExtendedAttributeInner ) ExtendedAttributeInner
26 | --     [ ExtendedAttributeInner ] ExtendedAttributeInner
27 | --     { ExtendedAttributeInner } ExtendedAttributeInner
28 | --     OtherOrComma ExtendedAttributeInner
29 | --     ε
30 | eaInner : SnocList InnerOrOther -> AccRule False EAInner
31 | eaInner sx (B ',' b :: xs) (SA r) =
32 |   succF $ eaInner (sx :< Right (inject (Symb ','))) xs r
33 | eaInner sx xs acc@(SA r) = case innerOrOther xs acc of
34 |   Succ0 io ys => succF $ eaInner (sx :< io) ys r
35 |   Fail0 _     => Succ0 (innerAttribute sx []) xs
36 |
37 | innerOrOther (B t b :: xs) (SA r) =
38 |   if isOpen t then case succT $ eaInner [<] xs r of
39 |     Succ0 v (B c b2 :: ys) =>
40 |       if c `closes` t then Succ0 (Left v) ys else unexpected (B c b2)
41 |     res => failInParen b t res
42 |   else case toOther t of
43 |     Just o  => Succ0 (Right o) xs
44 |     Nothing => unexpected (B t b)
45 | innerOrOther [] _ = eoi
46 |
47 | -- ExtendedAttributeRest ::
48 | --     ExtendedAttribute
49 | --     ε
50 | eaRest : SnocList InnerOrOther -> InnerOrOther -> AccRule False ExtAttribute
51 | eaRest sx x ts acc@(SA r) = case innerOrOther ts acc of
52 |   Succ0 e ys => succF $ eaRest (sx :< x) e ys r
53 |   _          => Succ0 (extAttribute sx $ Last x) ts
54 |
55 | -- ExtendedAttribute ::
56 | --     ( ExtendedAttributeInner ) ExtendedAttributeRest
57 | --     [ ExtendedAttributeInner ] ExtendedAttributeRest
58 | --     { ExtendedAttributeInner } ExtendedAttributeRest
59 | --     Other ExtendedAttributeRest
60 | export
61 | extAttribute : Rule True ExtAttribute
62 | extAttribute xs = case innerOrOther xs suffixAcc of
63 |   Succ0 e ys => succT $ eaRest [<] e ys suffixAcc
64 |   Fail0 err  => Fail0 err
65 |
66 | -- ExtendedAttributes ::
67 | --     , ExtendedAttribute ExtendedAttributes
68 | --     ε
69 | export
70 | eas : SnocList ExtAttribute -> Bounds -> AccRule True ExtAttributeList
71 | eas sa b ts (SA r) = case extAttribute ts of
72 |   Succ0 v (B ']' _ :: xs) => Succ0 (sa <>> [v]) xs
73 |   Succ0 v (B ',' _ :: xs) => succT $ eas (sa :< v) b xs r
74 |   res                     => failInParen b '[' res
75 |
76 | -- ExtendedAttributeList ::
77 | --     [ ExtendedAttribute ExtendedAttributes ]
78 | --     ε
79 | export
80 | attributes : Rule False ExtAttributeList
81 | attributes (B '[' b :: xs) = succF $ eas [<] b xs suffixAcc
82 | attributes xs              = Succ0 [] xs
83 |
84 | export
85 | attributed : Rule True a -> Rule True (Attributed a)
86 | attributed f = Syntax.[| MkPair attributes f |]
87 |