0 | module Text.WebIDL.Parser.Members
  1 |
  2 | import Text.Parse.Syntax
  3 | import Text.WebIDL.Parser.Arguments
  4 | import Text.WebIDL.Parser.Attributes
  5 | import Text.WebIDL.Parser.Type
  6 | import Text.WebIDL.Parser.Util
  7 |
  8 | %default total
  9 |
 10 | %hide Prelude.(<*>)
 11 | %hide Prelude.(*>)
 12 | %hide Prelude.(<*)
 13 | %hide Prelude.pure
 14 |
 15 | --------------------------------------------------------------------------------
 16 | --          Member
 17 | --------------------------------------------------------------------------------
 18 |
 19 | const : Rule True Const
 20 | const = [| MkConst constType ident (exact '=' *> constValue) |]
 21 |
 22 | opName : Rule False (Maybe OperationName)
 23 | opName  (B "includes" _ :: xs) = Succ0 (Just $ MkOpName "includes") xs
 24 | opName  (B (Ident i) _ :: xs)  = Succ0 (Just $ MkOpName i.value) xs
 25 | opName  xs                     = Succ0 Nothing xs
 26 |
 27 | regularOperation : Rule True RegularOperation
 28 | regularOperation =
 29 |   [| MkOp (pure ()) idlType opName argumentList |]
 30 |
 31 | specialOperation : Special -> Rule True Operation
 32 | specialOperation s =
 33 |   [| MkOp (pure $ Just s) idlType opName argumentList |]
 34 |
 35 | export
 36 | operation : Rule True Operation
 37 | operation (B "getter" _ :: xs)  = succT $ specialOperation Getter xs
 38 | operation (B "setter" _ :: xs)  = succT $ specialOperation Setter xs
 39 | operation (B "deleter" _ :: xs) = succT $ specialOperation Deleter xs
 40 | operation xs                    = regToOp <$> regularOperation xs
 41 |
 42 | -- callbackInterfaceMemeber
 43 | export
 44 | cbIfaceM : Rule True CallbackInterfaceMember
 45 | cbIfaceM (B "const" _ :: xs ) =  inj (succT $ const xs)
 46 | cbIfaceM xs                   =  inj $ regularOperation xs
 47 |
 48 | export
 49 | dictM : Rule True DictionaryMemberRest
 50 | dictM (B "required" _ :: xs) =
 51 |   succT ([| Required attributes idlType ident |] xs)
 52 | dictM xs                     =
 53 |   [| Optional idlType ident defaultV |] xs
 54 |
 55 | attributeName : Rule True AttributeName
 56 | attributeName = terminal $ \case
 57 |   Key s   => MkAttributeName . value <$> refineAttributeNameKeyword s.value
 58 |   Ident s => Just (MkAttributeName s.value)
 59 |   _       => Nothing
 60 |
 61 | attribute : Rule True Attribute
 62 | attribute = [| MkAttribute attributes idlType attributeName |]
 63 |
 64 | stringifier : Rule True Stringifier
 65 | stringifier (B "attribute" _ :: xs) = succT (inj $ attribute xs)
 66 | stringifier (B "readonly" _ :: B "attribute" _ :: xs) =
 67 |   succT (inj $ MkRO <$> attribute xs)
 68 | stringifier xs = inj $ regularOperation xs
 69 |
 70 | static : Rule True StaticMember
 71 | static (B "attribute" _ :: xs) = succT (inj $ attribute xs)
 72 | static (B "readonly" _ :: B "attribute" _ :: xs) =
 73 |   succT (inj $ MkRO <$> attribute xs)
 74 | static xs = inj $ regularOperation xs
 75 |
 76 | maplike : Rule True Maplike
 77 | maplike = between '<' '>'
 78 |   [| MkMaplike (attributed idlType) (exact ',' *> attributed idlType) |]
 79 |
 80 | setlike : Rule True Setlike
 81 | setlike = between '<' '>' [| MkSetlike (attributed idlType) |]
 82 |
 83 | export
 84 | namespaceM : Rule True NamespaceMember
 85 | namespaceM (B "readonly" _ :: B t b :: xs) = case t of
 86 |   "attribute" => inj $ succT (MkRO <$> attribute xs)
 87 |   _           => expected b "attribute" "\{t}"
 88 | namespaceM xs = inj $ regularOperation xs
 89 |
 90 | iterable : Rule True PartialInterfaceMember
 91 | iterable = between '<' '>' [| IIterable (attributed idlType) optionalType|]
 92 |
 93 | async : Rule True PartialInterfaceMember
 94 | async = [| IAsync (attributed idlType) (optionalType <* exact '>') optArgList |]
 95 |
 96 | export
 97 | pIfaceM : Rule True PartialInterfaceMember
 98 | pIfaceM (B "const" _     :: xs) = IConst <$> succT (const xs)
 99 | pIfaceM (B "attribute" _ :: xs) = IAttr <$> succT (attribute xs)
100 | pIfaceM (B "readonly" _ :: B t b :: xs) = case t of
101 |   "maplike"   => IMapRO . MkRO <$> succT (maplike xs)
102 |   "setlike"   => ISetRO . MkRO <$> succT (setlike xs)
103 |   "attribute" => IAttrRO . MkRO <$> succT (attribute xs)
104 |   _          => unexpected (B t b)
105 | pIfaceM (B "inherit" _ :: B "attribute" _ :: xs) =
106 |   IAttrInh . MkI <$> succT (attribute xs)
107 | pIfaceM (B "maplike" _ :: xs) = IMap <$> succT (maplike xs)
108 | pIfaceM (B "setlike" _ :: xs) = ISet <$> succT (setlike xs)
109 | pIfaceM (B "stringifier" _ :: xs) = case xs of
110 |   B ';' b :: ys => Succ0 (IStr $ inject ()) (B (Other $ Symb ';') b :: ys)
111 |   _             => IStr <$> succT (stringifier xs)
112 | pIfaceM (B "static" _ :: xs) = IStatic <$> succT (static xs)
113 | pIfaceM (B "iterable" _ :: xs) = succT $ iterable xs
114 | pIfaceM (B "async" _ :: B "iterable" _ :: B '<' _ :: xs) = succT $ async xs
115 | pIfaceM xs = IOp <$> operation xs
116 |
117 | export
118 | mixinM : Rule True MixinMember
119 | mixinM (B "const" _     :: xs) = MConst <$> succT (const xs)
120 | mixinM (B "attribute" _ :: xs) = MAttr <$> succT (attribute xs)
121 | mixinM (B "readonly" _ :: B t b :: xs) = case t of
122 |   "attribute" => MAttrRO . MkRO <$> succT (attribute xs)
123 |   _           => expected b "attribute" "\{t}"
124 | mixinM (B "stringifier" _ :: xs) = case xs of
125 |   B ';' b :: ys => Succ0 (MStr $ inject ()) (B (Other $ Symb ';') b :: ys)
126 |   _             => MStr <$> succT (stringifier xs)
127 | mixinM xs = MOp <$> regularOperation xs
128 |
129 | export
130 | ifaceM : Rule True InterfaceMember
131 | ifaceM (B "constructor" _ :: xs) =
132 |   succT $ inj (MkConstructor <$> argumentList xs)
133 | ifaceM xs = inj $ pIfaceM xs
134 |
135 | mems :
136 |      SnocList (Attributed a)
137 |   -> Bounds
138 |   -> Rule True a
139 |   -> AccRule True (List $ Attributed a)
140 | mems sx b f ts (SA r) = case attributed f ts of
141 |   Succ0 p (B ';' _ :: B '}' _ :: ys) => Succ0 (sx <>> [p]) ys
142 |   Succ0 p (B ';' _ :: ys)            => succT $ mems (sx :< p) b f ys r
143 |   Succ0 p (x::xs)                    => expected x.bounds ";" "\{x.val}"
144 |   res                                => failInParen b '{' res
145 |
146 | export
147 | members : Rule True a -> Rule True (List $ Attributed a)
148 | members g (B '{' _ :: B '}' _ :: xs) = Succ0 [] xs
149 | members g (B '{' b :: xs) = succT $ acc (mems [<] b g) xs
150 | members g (x::xs) = expected x.bounds "{" "\{x.val}"
151 | members g [] = eoi
152 |