
  0 | module Text.WebIDL.Parser.Definitions
  1 | 
  2 | import Text.Parse.Syntax
  3 | import Text.WebIDL.Parser.Arguments
  4 | import Text.WebIDL.Parser.Attributes
  5 | import Text.WebIDL.Parser.Members
  6 | import Text.WebIDL.Parser.Type
  7 | import Text.WebIDL.Parser.Util
  8 | 
  9 | %default total
 10 | 
 11 | %hide Prelude.(<*>)
 12 | %hide Prelude.(*>)
 13 | %hide Prelude.(<*)
 14 | %hide Prelude.pure
 15 | 
 16 | %default total
 17 | 
 18 | inherits : Rule False Inheritance
 19 | inherits (B ':' _ :: B (Ident i) _ :: xs) = Succ0 (Just i) xs
 20 | inherits xs                               = Succ0 Nothing xs
 21 | 
 22 | def :
 23 |      {0 ts : List Type}
 24 |   -> Rule True a
 25 |   -> {auto p : Elem a ts}
 26 |   -> Rule True (NS I ts)
 27 | def f xs = inj $ (f <* exact ';') xs
 28 | 
 29 | -- optional trailing comma
 30 | enumRest: Bounds -> SnocList StringLit -> Rule False (List StringLit)
 31 | enumRest b ss (B ',' _ :: B '}' _ :: xs)      = Succ0 (ss <>> []) xs
 32 | enumRest b ss (B ',' _ :: B (SLit s) _ :: xs) = succF $ enumRest b (ss :< s) xs
 33 | enumRest b ss (B ',' _ :: x  :: xs)           = custom x.bounds ExpectedStringLit
 34 | enumRest b ss (B '}' _ :: xs)                 = Succ0 (ss <>> []) xs
 35 | enumRest b ss (x :: xs)                       = expected x.bounds "," "\{x.val}"
 36 | enumRest b ss []                              = unclosed b '{'
 37 | 
 38 | -- optional trailing comma
 39 | enumList : Rule True (List1 StringLit)
 40 | enumList (B '{' b :: B (SLit s) _ :: xs) = (s :::) <$> succT (enumRest b [<] xs)
 41 | enumList (B '{' b :: x :: xs) = custom x.bounds ExpectedStringLit               
 42 | enumList (x :: xs)            = expected x.bounds "{" "\{x.val}"
 43 | enumList []                   = eoi
 44 | 
 45 | defn : Rule False ExtAttributeList -> Rule True Definition
 46 | defn as (B "enum" _ :: xs) = 
 47 |   succT $ def [| MkEnum as ident enumList |] xs
 48 | defn as (B "typedef" _ :: xs) = 
 49 |   succT $ def [| MkTypedef as attributes idlType ident |] xs
 50 | defn as (B "namespace" _ :: xs) = 
 51 |   succT $ def [| MkNamespace as ident (members namespaceM) |] xs
 52 | defn as (B "interface" _ :: B "mixin" _ :: xs) = 
 53 |   succT $ def [| MkMixin as ident (members mixinM) |] xs
 54 | defn as (B "interface" _ :: xs) = 
 55 |   succT $ def [| MkInterface as ident inherits (members ifaceM) |] xs
 56 | defn as (B "dictionary" _ :: xs) = 
 57 |   succT $ def [| MkDictionary as ident inherits (members dictM) |] xs
 58 | defn as (B "callback" _ :: B "interface" _ :: xs) = 
 59 |   succT $ def [| MkCallbackInterface as ident (members cbIfaceM) |] xs
 60 | defn as (B "callback" _ :: xs) = 
 61 |   succT $ def [| MkCallback as ident (exact '=' *> idlType) argumentList |] xs
 62 | defn as xs =
 63 |   def [| MkIncludes as ident (exact "includes" *> ident) |] xs
 64 | 
 65 | prt : Rule False ExtAttributeList -> Rule True Part
 66 | prt as (B "namespace" _ :: xs) = 
 67 |   succT $ def [| MkPNamespace as ident (members namespaceM) |] xs
 68 | prt as (B "interface" _ :: B "mixin" _ :: xs) = 
 69 |   succT $ def [| MkPMixin as ident (members mixinM) |] xs
 70 | prt as (B "interface" _ :: xs) = 
 71 |   succT $ def [| MkPInterface as ident (members pIfaceM) |] xs
 72 | prt as (B "dictionary" _ :: xs) = 
 73 |   succT $ def [| MkPDictionary as ident (members dictM) |] xs
 74 | prt as xs = fail xs
 75 | 
 76 | export
 77 | partOrDef : Rule True PartOrDef
 78 | partOrDef xs = case attributes xs of
 79 |   Succ0 as (B "partial" _ :: ys) => succT (inj $ prt (pure as) ys)
 80 |   Succ0 as ys @{p}               => trans (inj $ defn (pure as) ys) p
 81 |   Fail0 err => Fail0 err
 82 | 
 83 | export
 84 | partsAndDefs : Rule True PartsAndDefs
 85 | partsAndDefs xs = accumNs . forget <$> some partOrDef xs
 86 |