0 | module Text.WebIDL.Types.Type
2 | import Data.Bitraversable
3 | import Data.Traversable
4 | import Derive.Prelude
5 | import Text.WebIDL.Types.Attribute
6 | import Text.WebIDL.Types.Identifier
8 | %language ElabReflection
23 | data BufferRelatedType =
36 | %runElab derive "BufferRelatedType" [Eq,Show,HasAttributes]
43 | data StringType = ByteString | DOMString | USVString
45 | %runElab derive "Type.StringType" [Eq,Show,HasAttributes]
48 | data IntType = Short | Long | LongLong
50 | %runElab derive "Type.IntType" [Eq,Show,HasAttributes]
53 | data FloatType = Float | Dbl
55 | %runElab derive "Type.FloatType" [Eq,Show,HasAttributes]
85 | data PrimitiveType : Type where
86 | Unsigned : IntType -> PrimitiveType
87 | Signed : IntType -> PrimitiveType
88 | Unrestricted : FloatType -> PrimitiveType
89 | Restricted : FloatType -> PrimitiveType
90 | Undefined : PrimitiveType
91 | Boolean : PrimitiveType
92 | Byte : PrimitiveType
93 | Octet : PrimitiveType
94 | BigInt : PrimitiveType
96 | %runElab derive "PrimitiveType" [Eq,Show,HasAttributes]
99 | data ConstTypeF a = CP PrimitiveType | CI a
101 | %runElab derive "ConstTypeF" [Eq,Show,HasAttributes]
107 | data Nullable a = MaybeNull a | NotNull a
109 | %runElab derive "Nullable" [Eq,Show,HasAttributes]
112 | val : Nullable a -> a
113 | val (MaybeNull x) = x
114 | val (NotNull x) = x
117 | zipWith : (a -> b -> c) -> Nullable a -> Nullable b -> Nullable c
118 | zipWith f (NotNull x) (NotNull y) = NotNull $
f x y
119 | zipWith f x y = MaybeNull $
f (val x) (val y)
122 | Functor Nullable where
123 | map f (MaybeNull x) = MaybeNull $
f x
124 | map f (NotNull x) = NotNull $
f x
127 | Foldable Nullable where
128 | foldr f acc v = f (val v) acc
131 | Traversable Nullable where
132 | traverse f (MaybeNull x) = MaybeNull <$> f x
133 | traverse f (NotNull x) = NotNull <$> f x
136 | nullVal : Nullable a -> a
137 | nullVal (MaybeNull x) = x
138 | nullVal (NotNull x) = x
141 | nullable : Nullable a -> Nullable a
142 | nullable = MaybeNull . nullVal
145 | notNullable : Nullable a -> Nullable a
146 | notNullable = NotNull . nullVal
149 | isNullable : Nullable a -> Bool
150 | isNullable (MaybeNull _) = True
151 | isNullable (NotNull _) = False
166 | data IdlTypeF : (a : Type) -> (b : Type) -> Type where
168 | D : Nullable (DistinguishableF a b) -> IdlTypeF a b
169 | U : Nullable (UnionTypeF a b) -> IdlTypeF a b
170 | Promise : IdlTypeF a b -> IdlTypeF a b
179 | record UnionTypeF (a : Type) (b : Type) where
181 | fst : UnionMemberTypeF a b
182 | snd : UnionMemberTypeF a b
183 | rest : List (UnionMemberTypeF a b)
189 | record UnionMemberTypeF (a : Type) (b : Type) where
190 | constructor MkUnionMember
192 | type : DistinguishableF a b
209 | data DistinguishableF : (a : Type) -> (b : Type) -> Type where
210 | P : PrimitiveType -> DistinguishableF a b
211 | S : StringType -> DistinguishableF a b
212 | I : b -> DistinguishableF a b
213 | B : BufferRelatedType -> DistinguishableF a b
214 | Sequence : a -> IdlTypeF a b -> DistinguishableF a b
215 | FrozenArray : a -> IdlTypeF a b -> DistinguishableF a b
216 | ObservableArray : a -> IdlTypeF a b -> DistinguishableF a b
217 | Record : StringType -> a -> IdlTypeF a b -> DistinguishableF a b
218 | Object : DistinguishableF a b
219 | Symbol : DistinguishableF a b
221 | %runElab deriveMutual
222 | [ "DistinguishableF"
223 | , "UnionMemberTypeF"
230 | IdlType = IdlTypeF ExtAttributeList Identifier
234 | UnionType = UnionTypeF ExtAttributeList Identifier
237 | UnionMemberType : Type
238 | UnionMemberType = UnionMemberTypeF ExtAttributeList Identifier
241 | Distinguishable : Type
242 | Distinguishable = DistinguishableF ExtAttributeList Identifier
246 | ConstType = ConstTypeF Identifier
252 | 0 OptionalType : Type
253 | OptionalType = Maybe (Attributed IdlType)
257 | identToType : b -> IdlTypeF a b
258 | identToType = D . NotNull . I
262 | undefined : IdlTypeF a b
263 | undefined = D $
NotNull $
P Undefined
266 | isUndefined : IdlTypeF a b -> Bool
267 | isUndefined (D $
NotNull $
P Undefined) = True
268 | isUndefined _ = False
271 | domString : IdlTypeF a b
272 | domString = D $
NotNull $
S DOMString
275 | ulong : IdlTypeF a b
276 | ulong = D $
NotNull $
P $
Unsigned Long
279 | isIndex : IdlTypeF a b -> Bool
280 | isIndex (D $
NotNull $
S DOMString) = True
281 | isIndex (D $
NotNull $
P $
Unsigned Long) = True
290 | Functor ConstTypeF where map = mapDefault
293 | Foldable ConstTypeF where foldr = foldrDefault
296 | Traversable ConstTypeF where
297 | traverse _ (CP x) = pure (CP x)
298 | traverse f (CI x) = CI <$> f x
302 | Bifunctor DistinguishableF where bimap = assert_total bimapDefault
305 | Bifoldable DistinguishableF where bifoldr = bifoldrDefault
308 | Bitraversable DistinguishableF where
309 | bitraverse _ _ (P x) = pure (P x)
310 | bitraverse _ _ (S x) = pure (S x)
311 | bitraverse _ g (I x) = I <$> g x
312 | bitraverse _ _ (B x) = pure (B x)
313 | bitraverse f g (Sequence x y) = [| Sequence (f x) (bitraverse f g y) |]
314 | bitraverse f g (FrozenArray x y) = [| FrozenArray (f x) (bitraverse f g y) |]
315 | bitraverse f g (ObservableArray x y) = [| ObservableArray (f x) (bitraverse f g y) |]
316 | bitraverse f g (Record x y z) = [| Record (pure x) (f y) (bitraverse f g z) |]
317 | bitraverse _ _ Object = pure Object
318 | bitraverse _ _ Symbol = pure Symbol
321 | Functor (DistinguishableF a) where map = bimap id
324 | Foldable (DistinguishableF a) where foldr = bifoldr (const id)
327 | Traversable (DistinguishableF a) where traverse = bitraverse pure
330 | Bifunctor UnionMemberTypeF where bimap = assert_total bimapDefault
333 | Bifoldable UnionMemberTypeF where bifoldr = bifoldrDefault
336 | Bitraversable UnionMemberTypeF where
337 | bitraverse f g (MkUnionMember a t) =
338 | [| MkUnionMember (f a) (bitraverse f g t) |]
341 | Functor (UnionMemberTypeF a) where map = bimap id
344 | Foldable (UnionMemberTypeF a) where foldr = bifoldr (const id)
347 | Traversable (UnionMemberTypeF a) where traverse = bitraverse pure
350 | Bifunctor UnionTypeF where bimap = assert_total bimapDefault
353 | Bifoldable UnionTypeF where bifoldr = bifoldrDefault
356 | Bitraversable UnionTypeF where
357 | bitraverse f g (UT a b ts) =
358 | [| UT (bitraverse f g a) (bitraverse f g b)
359 | (traverse (bitraverse f g) ts) |]
362 | Functor (UnionTypeF a) where map = bimap id
365 | Foldable (UnionTypeF a) where foldr = bifoldr (const id)
368 | Traversable (UnionTypeF a) where traverse = bitraverse pure
371 | Bifunctor IdlTypeF where bimap = assert_total bimapDefault
374 | Bifoldable IdlTypeF where bifoldr = bifoldrDefault
377 | Bitraversable IdlTypeF where
378 | bitraverse f g Any = pure Any
379 | bitraverse f g (D x) = D <$> traverse (bitraverse f g) x
380 | bitraverse f g (U x) = U <$> traverse (bitraverse f g) x
381 | bitraverse f g (Promise x) = Promise <$> bitraverse f g x
384 | Functor (IdlTypeF a) where map = bimap id
387 | Foldable (IdlTypeF a) where foldr = bifoldr (const id)
390 | Traversable (IdlTypeF a) where traverse = bitraverse pure
393 | HasAttributes a => HasAttributes (IdlTypeF a b) where
394 | attributes = bifoldMap attributes (const Nil)