
  0 | module Text.WebIDL.Parser.Arguments
  1 | 
  2 | import Text.WebIDL.Parser.Attributes
  3 | import Text.WebIDL.Parser.Type
  4 | import Text.WebIDL.Parser.Util
  5 | import Text.Parse.Syntax
  6 | 
  7 | %hide Prelude.(<*>)
  8 | %hide Prelude.(*>)
  9 | %hide Prelude.(<*)
 10 | %hide Prelude.pure
 11 | 
 12 | %default total
 13 | 
 14 | export
 15 | constValue : Rule True ConstValue
 16 | constValue (B (FLit x) _ :: xs) = Succ0 (F x) xs
 17 | constValue (B (ILit x) _ :: xs) = Succ0 (I x) xs
 18 | constValue (B "true"   _ :: xs) = Succ0 (B True) xs
 19 | constValue (B "false"  _ :: xs) = Succ0 (B False) xs
 20 | constValue xs                   = fail xs
 21 | 
 22 | export
 23 | defaultV : Rule False Default
 24 | defaultV (B '=' _ :: B '[' _ :: B ']' _ :: xs) = Succ0 EmptyList xs
 25 | defaultV (B '=' _ :: B '{' _ :: B '}' _ :: xs) = Succ0 EmptySet xs
 26 | defaultV (B '=' _ :: B "null" _         :: xs) = Succ0 Null xs
 27 | defaultV (B '=' _ :: B (SLit x) _       :: xs) = Succ0 (S x) xs
 28 | defaultV (B '=' _                       :: xs) = succF $ C <$> constValue xs
 29 | defaultV xs                                    = Succ0 None xs
 30 | 
 31 | argName : Rule True ArgumentName
 32 | argName (B (Key s) b :: xs) = case refineArgumentNameKeyword s.value of
 33 |   Just nm => Succ0 (MkArgName nm.value) xs
 34 |   Nothing => custom b (InvalidArgName s.value)
 35 | argName (B (Ident s) b :: xs) = Succ0 (MkArgName s.value) xs
 36 | argName xs = fail xs
 37 | 
 38 | ellipsis : Rule False Bool
 39 | ellipsis (B (Other Ellipsis) _ :: xs) = Succ0 True xs
 40 | ellipsis xs                           = Succ0 False xs
 41 | 
 42 | export
 43 | arg : ExtAttributeList -> Rule True (Bool,Arg)
 44 | arg as = [| toArg idlType ellipsis argName |]
 45 | 
 46 |   where
 47 |     toArg : IdlType -> Bool -> ArgumentName -> (Bool,Arg)
 48 |     toArg t b a = (b, MkArg as t a)
 49 | 
 50 | optArg : ExtAttributeList -> Rule True OptArg
 51 | optArg as = [| MkOptArg (pure as) attributes idlType argName defaultV |]
 52 | 
 53 | -- this comes after we checked for empty arg lists or the presence of
 54 | -- a comma, so it must consume at least one more argument
 55 | args : SnocList Arg -> SnocList OptArg -> AccRule True ArgumentList
 56 | args sa so xs (SA r) = case attributes xs of
 57 |   Succ0 as1 (B "optional" _ :: r1) => case succT $ optArg as1 r1 of
 58 |     Succ0 o (B ',' _ :: r2) => succT (args sa (so :< o) r2 r)
 59 |     Succ0 o r2              => Succ0 (NoVarArg (sa <>> []) (so <>> [o])) r2
 60 |     Fail0 err               => Fail0 err
 61 | 
 62 |   Succ0 as1 r1 @{p} => case so of
 63 |     -- interleaving of optional and regular args makes no sense
 64 |     (_ :< _) => case r1 of
 65 |       []   => eoi
 66 |       x::_ => expected x.bounds "optional" "\{x.val}"
 67 | 
 68 |     -- no optional args so far, so regular arg is fine
 69 |     [<] => case trans (arg as1 r1) p of
 70 |       Succ0 (True,a) r2           => Succ0 (VarArg (sa <>> []) a) r2
 71 |       Succ0 (_,a) (B ',' _ :: r2) => succT (args (sa :< a) so r2 r)
 72 |       Succ0 (_,a) r2              => Succ0 (NoVarArg (sa <>> [a]) []) r2
 73 |       Fail0 err                   => Fail0 err
 74 |   Fail0 err => Fail0 err
 75 |               
 76 | export
 77 | argumentList : Rule True ArgumentList
 78 | argumentList (B '(' _ :: B ')' _ :: xs) = Succ0 (NoVarArg Nil Nil) xs
 79 | argumentList xs = between '(' ')' (acc $ args [<] [<]) xs
 80 |               
 81 | export
 82 | optArgList : Rule False ArgumentList
 83 | optArgList (B '(' b :: xs) =
 84 |   weaken $ argumentList (B (Other $ Symb '(') b :: xs)
 85 | optArgList xs = Succ0 (NoVarArg Nil Nil) xs
 86 |